packages feed

hydra 0.8.0 → 0.12.0

raw patch · 425 files changed

+53721/−56535 lines, 425 filesdep ~aesondep ~basedep ~bytestring

Dependency ranges changed: aeson, base, bytestring, containers, filepath, text

Files

README.md view
@@ -1,28 +1,28 @@ # Hydra-Haskell -Hydra is a type-aware data transformation toolkit which aims to be highly flexible and portable.-It has its roots in graph databases and type theory, and provides APIs in Haskell and Java.+Hydra is a functional programming language which aims to be highly flexible and portable.+It has its roots in graph databases and type theory, and provides APIs in Haskell, Java, and Python. See the main Hydra [README](https://github.com/CategoricalData/hydra) for more details. This Haskell package contains Hydra's Haskell API and Haskell sources specifically. Releases are available [on Hackage](https://hackage.haskell.org/package/hydra).  ## Build -Haskell is the current source-of-truth language for Hydra, which means that most of the Hydra implementation is written either in "raw" Haskell or in a Haskell-based DSL.-You can find the DSL-based sources [here](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/main/haskell/Hydra/Impl/Haskell/Sources);-anything written in the DSL is also mapped into the generated Java and Scala sources.+Haskell is Hydra's bootstrapping language, which means that,+while the entire Hydra kernel is written in the Hydra language itself,+the sources are written in a Haskell-based domain-specific language (DSL).+You can find the DSL-based sources [here](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/main/haskell/Hydra/Sources);+anything written in the DSL is also mapped into the generated Java and Python sources. You can find the generated Haskell sources [here](https://github.com/CategoricalData/hydra/tree/main/hydra-haskell/src/gen-main/haskell).-To build Hydra-Haskell and enter the GHCi REPL, use:+To build Hydra-Haskell and enter the GHCi REPL,+first install the [Haskell Tool Stack](https://docs.haskellstack.org/en/stable) ("Stack"),+and then use:  ```bash stack ghci ``` -Or to enter the test environment:--```bash-stack ghci hydra:hydra-test-```+## Test  To run all tests at the command line, use: @@ -30,78 +30,66 @@ stack test ``` -## Code generation--It is a long-term goal for Hydra to generate its own source code into various languages,-producing nearly-complete Hydra implementations in those languages.-Both Haskell and Java are fully supported as target languages,-which means that all of Hydra's types and programs currently specified in the Haskell DSL are mapped correctly to both Haskell and Java.-Scala support, on the other hand, is partial and experimental at this time.--You can generate Hydra's Haskell sources by first entering the GHCi REPL as above, then:--```haskell-import Hydra.Codegen+If you are familiar with Hydra-Haskell internals and you want to enter the test environment interactively: -writeHaskell "src/gen-main/haskell" mainModules+```bash+stack ghci hydra:lib hydra:hydra-test ``` -The first argument to `writeHaskell` is the base directory to which the generated files are to be written,-and the second is the list of modules you want to generate (in this case, a special list containing all built-in modules).-For individual modules, use list syntax, e.g.+Or just `stack ghci hydra:hydra-test` if you want to treat the library as an external dependency.+Now in the REPL, you can access test resources,  ```haskell-writeHaskell "src/gen-main/haskell" [rdfSyntaxModule, shaclModelModule]+:t Hydra.TestUtils.termTestContext ``` -To generate test modules, use:+or run individual Hspec test cases.  ```haskell-writeHaskell "src/gen-test/haskell" testModules+Test.Hspec.hspec Hydra.TestSuiteSpec.spec ``` -Java generation is similar, e.g.--```haskell-writeJava "../hydra-java/src/gen-main/java" mainModules-```+## Code generation -For Java tests, use:+Hydra is a self-hosting compiler in Haskell, which means that it can generate+all of its own Haskell source code, with the exception of a few built-in+artifacts such as Haskell-specific implementations of Hydra's primitive+functions. -```haskell-writeJava "../hydra-java/src/gen-test/java" testModules-```+We are currently working on "closing the loop" in Java and Python, as well,+but that code is currently in `hydra-ext`; see the [Hydra-Ext README](https://github.com/CategoricalData/hydra/blob/main/hydra-ext/README.md)+for details on Java and Python code generation, as well as many other coders+including property graphs and their formats, RDF and their formats, Avro,+Protobuf, C++, Scala, and others. -Scala generation has known bugs, but you can try it out with:+You can generate Hydra's Haskell sources by first entering the GHCi REPL as above, then:  ```haskell-writeScala "../hydra-scala/src/gen-main/scala" kernelModules+import Hydra.Generation++writeHaskell "src/gen-main/haskell" mainModules ``` -There is schema-only support for GraphQL:+The first argument to `writeHaskell` is the base directory to which the generated files are to be written,+and the second is the list of modules you want to generate (in this case, a special list containing all built-in modules).+To generate only the Hydra kernel, use:  ```haskell-import Hydra.Sources.Langs.Graphql.Syntax-import Hydra.Sources.Langs.Json.Model-writeGraphql "/tmp/graphql" [graphqlSyntaxModule, jsonModelModule]+writeHaskell "src/gen-main/haskell" kernelModules ``` -Because GraphQL does not support imports, the GraphQL coder will gather all of the dependencies of a given module together,-and map them to a single `.graphql` file.-Hydra has a similar level of schema-only support for [Protobuf](https://protobuf.dev/):+For individual modules, use list syntax, e.g.  ```haskell-writeProtobuf "/tmp/proto" [jsonModelModule]+writeHaskell "src/gen-main/haskell" [haskellLanguageModule, haskellCoderModule] ``` -...and similarly for [PDL](https://linkedin.github.io/rest.li/pdl_schema):+To generate test modules, use:  ```haskell-writePdl "/tmp/pdl" [jsonModelModule]+writeHaskell "src/gen-test/haskell" testModules ``` -Note that neither the Protobuf nor PDL coder currently supports polymorphic models.- ### JSON and YAML generation  JSON and YAML are slightly different than the languages above, in that they are pure data languages, without accompanying syntax for schemas (types).@@ -115,7 +103,7 @@ import Hydra.Dsl.Terms as Terms  -- Choose a graph in which to execute flows; we will use the Hydra kernel graph.-g = hydraKernel+g = hydraCoreGraph flow = fromFlowIo g  -- Choose a type for terms to encode. In this case, we will be encoding numeric precision values.
hydra.cabal view
@@ -5,9 +5,9 @@ -- see: https://github.com/sol/hpack  name:           hydra-version:        0.8.0-synopsis:       Type-aware transformations for data and programs-description:    Hydra is a domain-specific language for data models and data transformations. It is based on a typed lambda calculus, and transforms data and schemas between languages in a way which maintains type conformance. Hydra will even transform functional programs between selected languages, including much of its own source code.+version:        0.12.0+synopsis:       Graph programming language+description:    Hydra is an implementation of the LambdaGraph data model, which takes advantage of an isomorphism between labeled hypergraphs and typed lambda calculus: in Hydra, "graphs are programs, and programs are graphs". The language is designed to be embedded in other programming languages, transforming data, schemas, and functional programs into multiple other languages in a way which maintains type safety, Hydra is self-hosting in Haskell, i.e. it generates its own executable source code from Hydra sources. category:       Data homepage:       https://github.com/CategoricalData/hydra#readme bug-reports:    https://github.com/CategoricalData/hydra/issues@@ -28,21 +28,21 @@  library   exposed-modules:-      Hydra.Adapters-      Hydra.AdapterUtils-      Hydra.Annotations-      Hydra.Codegen-      Hydra.CoreDecoding+      Hydra.Dsl.Accessors       Hydra.Dsl.Annotations-      Hydra.Dsl.Base+      Hydra.Dsl.Ast       Hydra.Dsl.Bootstrap+      Hydra.Dsl.Coders+      Hydra.Dsl.Common+      Hydra.Dsl.Compute       Hydra.Dsl.Core-      Hydra.Dsl.Expect+      Hydra.Dsl.Grammar       Hydra.Dsl.Grammars       Hydra.Dsl.Graph+      Hydra.Dsl.Json+      Hydra.Dsl.Lib.Chars       Hydra.Dsl.Lib.Equality       Hydra.Dsl.Lib.Flows-      Hydra.Dsl.Lib.Io       Hydra.Dsl.Lib.Lists       Hydra.Dsl.Lib.Literals       Hydra.Dsl.Lib.Logic@@ -56,64 +56,24 @@       Hydra.Dsl.Mantle       Hydra.Dsl.Module       Hydra.Dsl.PhantomLiterals+      Hydra.Dsl.Phantoms       Hydra.Dsl.Prims       Hydra.Dsl.ShorthandTypes+      Hydra.Dsl.Tabular+      Hydra.Dsl.TBase       Hydra.Dsl.Terms+      Hydra.Dsl.Testing       Hydra.Dsl.Tests+      Hydra.Dsl.Topology+      Hydra.Dsl.TTerms+      Hydra.Dsl.TTypes       Hydra.Dsl.Types-      Hydra.Ext.Avro.Coder-      Hydra.Ext.Avro.Language-      Hydra.Ext.Avro.SchemaJson-      Hydra.Ext.Graphql.Coder-      Hydra.Ext.Graphql.Language-      Hydra.Ext.Graphql.Serde-      Hydra.Ext.Haskell.Coder-      Hydra.Ext.Haskell.Language-      Hydra.Ext.Haskell.Operators-      Hydra.Ext.Haskell.Serde-      Hydra.Ext.Haskell.Settings-      Hydra.Ext.Haskell.Utils-      Hydra.Ext.Java.Coder-      Hydra.Ext.Java.Names-      Hydra.Ext.Java.Serde-      Hydra.Ext.Java.Settings-      Hydra.Ext.Java.Utils-      Hydra.Ext.Json.Coder-      Hydra.Ext.Json.Eliminate-      Hydra.Ext.Json.Language-      Hydra.Ext.Json.Serde-      Hydra.Ext.Pegasus.Coder-      Hydra.Ext.Pegasus.Language-      Hydra.Ext.Pegasus.Serde-      Hydra.Ext.Pg.Coder-      Hydra.Ext.Pg.TermsToElements-      Hydra.Ext.Protobuf.Coder-      Hydra.Ext.Protobuf.Serde-      Hydra.Ext.Rdf.Serde-      Hydra.Ext.Rdf.Utils-      Hydra.Ext.Scala.Coder-      Hydra.Ext.Scala.Language-      Hydra.Ext.Scala.Prepare-      Hydra.Ext.Scala.Serde-      Hydra.Ext.Scala.Utils-      Hydra.Ext.Shacl.Coder-      Hydra.Ext.Shacl.Language-      Hydra.Ext.Yaml.Coder-      Hydra.Ext.Yaml.Language-      Hydra.Ext.Yaml.Modules-      Hydra.Ext.Yaml.Serde-      Hydra.Flows-      Hydra.Inference.AlgorithmW-      Hydra.Inference.AlgorithmWBridge-      Hydra.Inference.AltInference-      Hydra.Inference.Inference-      Hydra.Inference.Rules-      Hydra.Inference.Substitution+      Hydra.Dsl.Typing+      Hydra.Generation       Hydra.Kernel-      Hydra.Lexical+      Hydra.Lib.Chars       Hydra.Lib.Equality       Hydra.Lib.Flows-      Hydra.Lib.Io       Hydra.Lib.Lists       Hydra.Lib.Literals       Hydra.Lib.Logic@@ -122,130 +82,168 @@       Hydra.Lib.Optionals       Hydra.Lib.Sets       Hydra.Lib.Strings-      Hydra.LiteralAdapters       Hydra.Minimal-      Hydra.Reduction-      Hydra.Rewriting-      Hydra.Schemas-      Hydra.Sources.Core+      Hydra.Settings+      Hydra.Sources.All+      Hydra.Sources.Haskell.Ast+      Hydra.Sources.Haskell.Coder+      Hydra.Sources.Haskell.Language+      Hydra.Sources.Haskell.Operators+      Hydra.Sources.Haskell.Serde+      Hydra.Sources.Haskell.Utils+      Hydra.Sources.Json.Coder+      Hydra.Sources.Json.Decoding+      Hydra.Sources.Json.Extract+      Hydra.Sources.Json.Language+      Hydra.Sources.Kernel.Terms.Adapt.Literals+      Hydra.Sources.Kernel.Terms.Adapt.Modules+      Hydra.Sources.Kernel.Terms.Adapt.Simple+      Hydra.Sources.Kernel.Terms.Adapt.Terms+      Hydra.Sources.Kernel.Terms.Adapt.Utils+      Hydra.Sources.Kernel.Terms.All+      Hydra.Sources.Kernel.Terms.Annotations+      Hydra.Sources.Kernel.Terms.Arity+      Hydra.Sources.Kernel.Terms.Constants+      Hydra.Sources.Kernel.Terms.Decode.Core+      Hydra.Sources.Kernel.Terms.Decoding+      Hydra.Sources.Kernel.Terms.Describe.Core+      Hydra.Sources.Kernel.Terms.Describe.Mantle+      Hydra.Sources.Kernel.Terms.Encode.Core+      Hydra.Sources.Kernel.Terms.Extract.Core+      Hydra.Sources.Kernel.Terms.Extract.Mantle+      Hydra.Sources.Kernel.Terms.Formatting+      Hydra.Sources.Kernel.Terms.Grammars+      Hydra.Sources.Kernel.Terms.Inference+      Hydra.Sources.Kernel.Terms.Languages+      Hydra.Sources.Kernel.Terms.Lexical+      Hydra.Sources.Kernel.Terms.Literals+      Hydra.Sources.Kernel.Terms.Monads+      Hydra.Sources.Kernel.Terms.Names+      Hydra.Sources.Kernel.Terms.Reduction+      Hydra.Sources.Kernel.Terms.Rewriting+      Hydra.Sources.Kernel.Terms.Schemas+      Hydra.Sources.Kernel.Terms.Serialization+      Hydra.Sources.Kernel.Terms.Show.Accessors+      Hydra.Sources.Kernel.Terms.Show.Core+      Hydra.Sources.Kernel.Terms.Show.Graph+      Hydra.Sources.Kernel.Terms.Show.Mantle+      Hydra.Sources.Kernel.Terms.Show.Typing+      Hydra.Sources.Kernel.Terms.Sorting+      Hydra.Sources.Kernel.Terms.Substitution+      Hydra.Sources.Kernel.Terms.Tarjan+      Hydra.Sources.Kernel.Terms.Templates+      Hydra.Sources.Kernel.Terms.Unification+      Hydra.Sources.Kernel.Terms.Variants+      Hydra.Sources.Kernel.Types.Accessors+      Hydra.Sources.Kernel.Types.All+      Hydra.Sources.Kernel.Types.Ast+      Hydra.Sources.Kernel.Types.Coders+      Hydra.Sources.Kernel.Types.Compute+      Hydra.Sources.Kernel.Types.Constraints+      Hydra.Sources.Kernel.Types.Core+      Hydra.Sources.Kernel.Types.Grammar+      Hydra.Sources.Kernel.Types.Graph+      Hydra.Sources.Kernel.Types.Json+      Hydra.Sources.Kernel.Types.Mantle+      Hydra.Sources.Kernel.Types.Module+      Hydra.Sources.Kernel.Types.Phantoms+      Hydra.Sources.Kernel.Types.Query+      Hydra.Sources.Kernel.Types.Relational+      Hydra.Sources.Kernel.Types.Tabular+      Hydra.Sources.Kernel.Types.Testing+      Hydra.Sources.Kernel.Types.Topology+      Hydra.Sources.Kernel.Types.Typing+      Hydra.Sources.Kernel.Types.Workflow       Hydra.Sources.Libraries-      Hydra.Sources.Tier0.All-      Hydra.Sources.Tier0.Ast-      Hydra.Sources.Tier0.Coders-      Hydra.Sources.Tier0.Compute-      Hydra.Sources.Tier0.Constraints-      Hydra.Sources.Tier0.Grammar-      Hydra.Sources.Tier0.Graph-      Hydra.Sources.Tier0.Json-      Hydra.Sources.Tier0.Mantle-      Hydra.Sources.Tier0.Module-      Hydra.Sources.Tier0.Phantoms-      Hydra.Sources.Tier0.Query-      Hydra.Sources.Tier0.Testing-      Hydra.Sources.Tier0.Workflow-      Hydra.Sources.Tier1.All-      Hydra.Sources.Tier1.Constants-      Hydra.Sources.Tier1.CoreEncoding-      Hydra.Sources.Tier1.Decode-      Hydra.Sources.Tier1.Messages-      Hydra.Sources.Tier1.Strip-      Hydra.Sources.Tier1.Tier1-      Hydra.Sources.Tier2.All-      Hydra.Sources.Tier2.Basics-      Hydra.Sources.Tier2.CoreLanguage-      Hydra.Sources.Tier2.Extras-      Hydra.Sources.Tier2.Printing-      Hydra.Sources.Tier2.Tier2-      Hydra.Sources.Tier3.All-      Hydra.Sources.Tier3.Tier3-      Hydra.Sources.Tier4.All-      Hydra.Sources.Tier4.Ext.Avro.Schema-      Hydra.Sources.Tier4.Ext.Csharp.Syntax-      Hydra.Sources.Tier4.Ext.Cypher.Features-      Hydra.Sources.Tier4.Ext.Cypher.Functions-      Hydra.Sources.Tier4.Ext.Cypher.OpenCypher-      Hydra.Sources.Tier4.Ext.Graphql.Syntax-      Hydra.Sources.Tier4.Ext.Haskell.Ast-      Hydra.Sources.Tier4.Ext.Java.Language-      Hydra.Sources.Tier4.Ext.Java.Syntax-      Hydra.Sources.Tier4.Ext.Json.Decoding-      Hydra.Sources.Tier4.Ext.Pegasus.Pdl-      Hydra.Sources.Tier4.Ext.Pg.Mapping-      Hydra.Sources.Tier4.Ext.Pg.Model-      Hydra.Sources.Tier4.Ext.Pg.Query-      Hydra.Sources.Tier4.Ext.Pg.Validation-      Hydra.Sources.Tier4.Ext.Protobuf.Any-      Hydra.Sources.Tier4.Ext.Protobuf.Language-      Hydra.Sources.Tier4.Ext.Protobuf.Proto3-      Hydra.Sources.Tier4.Ext.Protobuf.SourceContext-      Hydra.Sources.Tier4.Ext.Rdf.Syntax-      Hydra.Sources.Tier4.Ext.RelationalModel-      Hydra.Sources.Tier4.Ext.Scala.Meta-      Hydra.Sources.Tier4.Ext.Shacl.Model-      Hydra.Sources.Tier4.Ext.Tabular-      Hydra.Sources.Tier4.Ext.Yaml.Model-      Hydra.Sources.Tier4.Test.Lib.Lists-      Hydra.Sources.Tier4.Test.Lib.Strings-      Hydra.Sources.Tier4.Test.TestSuite-      Hydra.TermAdapters-      Hydra.Tools.Accessors+      Hydra.Sources.Test.Formatting+      Hydra.Sources.Test.Inference.AlgebraicTypes+      Hydra.Sources.Test.Inference.AlgorithmW+      Hydra.Sources.Test.Inference.Failures+      Hydra.Sources.Test.Inference.Fundamentals+      Hydra.Sources.Test.Inference.InferenceSuite+      Hydra.Sources.Test.Inference.KernelExamples+      Hydra.Sources.Test.Inference.NominalTypes+      Hydra.Sources.Test.Inference.Simple+      Hydra.Sources.Test.Lib.Lists+      Hydra.Sources.Test.Lib.Strings+      Hydra.Sources.Test.TestGraph+      Hydra.Sources.Test.TestSuite+      Hydra.Sources.Yaml.Model+      Hydra.Staging.Json.Serde+      Hydra.Staging.Yaml.Coder+      Hydra.Staging.Yaml.Language+      Hydra.Staging.Yaml.Modules+      Hydra.Staging.Yaml.Serde       Hydra.Tools.Bytestrings       Hydra.Tools.Debug-      Hydra.Tools.Formatting-      Hydra.Tools.GrammarToModule-      Hydra.Tools.Serialization-      Hydra.Tools.Sorting-      Hydra.Tools.Templating-      Hydra.Unification+      Hydra.Tools.Monads+      Hydra.Accessors+      Hydra.Adapt.Literals+      Hydra.Adapt.Modules+      Hydra.Adapt.Simple+      Hydra.Adapt.Terms+      Hydra.Adapt.Utils+      Hydra.Annotations+      Hydra.Arity       Hydra.Ast-      Hydra.Basics       Hydra.Coders       Hydra.Compute       Hydra.Constants       Hydra.Constraints       Hydra.Core-      Hydra.CoreEncoding-      Hydra.CoreLanguage-      Hydra.Decode-      Hydra.Ext.Csharp.Syntax-      Hydra.Ext.Cypher.Features-      Hydra.Ext.Cypher.OpenCypher+      Hydra.Decode.Core+      Hydra.Decoding+      Hydra.Describe.Core+      Hydra.Describe.Mantle+      Hydra.Encode.Core       Hydra.Ext.Haskell.Ast-      Hydra.Ext.Java.Language-      Hydra.Ext.Java.Syntax-      Hydra.Ext.Org.Apache.Avro.Schema-      Hydra.Ext.Org.Graphql.Syntax+      Hydra.Ext.Haskell.Coder+      Hydra.Ext.Haskell.Language+      Hydra.Ext.Haskell.Operators+      Hydra.Ext.Haskell.Serde+      Hydra.Ext.Haskell.Utils+      Hydra.Ext.Org.Json.Coder       Hydra.Ext.Org.Json.Decoding-      Hydra.Ext.Org.W3.Rdf.Syntax-      Hydra.Ext.Org.W3.Shacl.Model+      Hydra.Ext.Org.Json.Language       Hydra.Ext.Org.Yaml.Model-      Hydra.Ext.Pegasus.Pdl-      Hydra.Ext.Protobuf.Any-      Hydra.Ext.Protobuf.Language-      Hydra.Ext.Protobuf.Proto3-      Hydra.Ext.Protobuf.SourceContext-      Hydra.Ext.RelationalModel-      Hydra.Ext.Scala.Meta-      Hydra.Ext.Tabular-      Hydra.Extras+      Hydra.Extract.Core+      Hydra.Extract.Json+      Hydra.Extract.Mantle+      Hydra.Formatting       Hydra.Grammar+      Hydra.Grammars       Hydra.Graph+      Hydra.Inference       Hydra.Json+      Hydra.Languages+      Hydra.Lexical+      Hydra.Literals       Hydra.Mantle-      Hydra.Messages       Hydra.Module-      Hydra.Pg.Mapping-      Hydra.Pg.Model-      Hydra.Pg.Query-      Hydra.Pg.Validation+      Hydra.Monads+      Hydra.Names       Hydra.Phantoms-      Hydra.Printing       Hydra.Query-      Hydra.Strip+      Hydra.Reduction+      Hydra.Relational+      Hydra.Rewriting+      Hydra.Schemas+      Hydra.Serialization+      Hydra.Show.Accessors+      Hydra.Show.Core+      Hydra.Show.Graph+      Hydra.Show.Mantle+      Hydra.Show.Typing+      Hydra.Sorting+      Hydra.Substitution+      Hydra.Tabular+      Hydra.Tarjan+      Hydra.Templates       Hydra.Testing-      Hydra.Tier1-      Hydra.Tier2-      Hydra.Tier3+      Hydra.Topology+      Hydra.Typing+      Hydra.Unification+      Hydra.Variants       Hydra.Workflow   other-modules:       Paths_hydra@@ -254,17 +252,16 @@       src/gen-main/haskell   build-depends:       HsYAML >=0.2.1 && <0.3-    , aeson >=2.0.0 && <2.2+    , aeson >=2.2.0 && <2.3     , aeson-pretty >=0.8.9 && <0.9-    , base >=4.18.0 && <4.19-    , bytestring >=0.11.3 && <0.12-    , containers >=0.6.5 && <0.7+    , base >=4.20.0 && <4.21+    , bytestring >=0.12.0 && <0.13+    , containers ==0.7.*     , directory >=1.3.6 && <1.4-    , filepath >=1.4.2 && <1.5-    , mtl+    , filepath >=1.5.0 && <1.6     , scientific >=0.3.7 && <0.4     , split >=0.2.3 && <0.3-    , text >=2.0.2 && <2.1+    , text >=2.1.0 && <2.2     , vector >=0.12.0 && <0.14   default-language: Haskell2010 @@ -272,37 +269,30 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      Hydra.Adapt.LiteralsSpec+      Hydra.Adapt.TermsSpec       Hydra.AnnotationsSpec       Hydra.ArbitraryCore       Hydra.CoreCodersSpec       Hydra.Dsl.TypesSpec-      Hydra.Ext.Json.CoderSpec-      Hydra.Ext.Json.SerdeSpec-      Hydra.Ext.Yaml.CoderSpec-      Hydra.Ext.Yaml.SerdeSpec-      Hydra.FlowsSpec-      Hydra.Inference.AlgebraicTypesSpec-      Hydra.Inference.AlgorithmWSpec-      Hydra.Inference.AltInferenceSpec-      Hydra.Inference.FundamentalsSpec-      Hydra.Inference.InferenceSpec-      Hydra.Inference.InferenceTestUtils-      Hydra.Inference.NominalTypesSpec-      Hydra.Inference.SubstitutionSpec-      Hydra.Inference.TypeAnnotationsSpec-      Hydra.LiteralAdaptersSpec+      Hydra.InferenceSpec+      Hydra.MonadsSpec       Hydra.ReductionSpec+      Hydra.Reference.AlgorithmW+      Hydra.Reference.AlgorithmWBridge+      Hydra.Reference.AlgorithmWSpec       Hydra.RewritingSpec-      Hydra.StripSpec-      Hydra.TermAdaptersSpec+      Hydra.SerializationSpec+      Hydra.SortingSpec+      Hydra.Staging.Json.CoderSpec+      Hydra.Staging.Json.SerdeSpec+      Hydra.Staging.TestGraph+      Hydra.Staging.Yaml.CoderSpec+      Hydra.Staging.Yaml.SerdeSpec       Hydra.TestData-      Hydra.TestGraph       Hydra.TestSuiteSpec       Hydra.TestUtils-      Hydra.Tier1Spec-      Hydra.Tools.SerializationSpec-      Hydra.Tools.SortingSpec-      Hydra.UnificationSpec+      Hydra.Test.TestGraph       Hydra.Test.TestSuite       Paths_hydra   hs-source-dirs:@@ -312,19 +302,19 @@       HUnit     , HsYAML >=0.2.1 && <0.3     , QuickCheck-    , aeson >=2.0.0 && <2.2+    , aeson >=2.2.0 && <2.3     , aeson-pretty >=0.8.9 && <0.9-    , base >=4.18.0 && <4.19-    , bytestring >=0.11.3 && <0.12-    , containers >=0.6.5 && <0.7+    , base >=4.20.0 && <4.21+    , bytestring >=0.12.0 && <0.13+    , containers ==0.7.*     , directory >=1.3.6 && <1.4-    , filepath >=1.4.2 && <1.5+    , filepath >=1.5.0 && <1.6     , hspec     , hspec-discover     , hydra     , mtl     , scientific >=0.3.7 && <0.4     , split >=0.2.3 && <0.3-    , text >=2.0.2 && <2.1+    , text >=2.1.0 && <2.2     , vector >=0.12.0 && <0.14   default-language: Haskell2010
+ src/gen-main/haskell/Hydra/Accessors.hs view
@@ -0,0 +1,125 @@+-- | A model for term access patterns++module Hydra.Accessors where++import qualified Hydra.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++data AccessorEdge = +  AccessorEdge {+    accessorEdgeSource :: AccessorNode,+    accessorEdgePath :: AccessorPath,+    accessorEdgeTarget :: AccessorNode}+  deriving (Eq, Ord, Read, Show)++_AccessorEdge = (Core.Name "hydra.accessors.AccessorEdge")++_AccessorEdge_source = (Core.Name "source")++_AccessorEdge_path = (Core.Name "path")++_AccessorEdge_target = (Core.Name "target")++data AccessorGraph = +  AccessorGraph {+    accessorGraphNodes :: [AccessorNode],+    accessorGraphEdges :: [AccessorEdge]}+  deriving (Eq, Ord, Read, Show)++_AccessorGraph = (Core.Name "hydra.accessors.AccessorGraph")++_AccessorGraph_nodes = (Core.Name "nodes")++_AccessorGraph_edges = (Core.Name "edges")++data AccessorNode = +  AccessorNode {+    accessorNodeName :: Core.Name,+    accessorNodeLabel :: String,+    accessorNodeId :: String}+  deriving (Eq, Ord, Read, Show)++_AccessorNode = (Core.Name "hydra.accessors.AccessorNode")++_AccessorNode_name = (Core.Name "name")++_AccessorNode_label = (Core.Name "label")++_AccessorNode_id = (Core.Name "id")++newtype AccessorPath = +  AccessorPath {+    unAccessorPath :: [TermAccessor]}+  deriving (Eq, Ord, Read, Show)++_AccessorPath = (Core.Name "hydra.accessors.AccessorPath")++-- | A function which maps from a term to a particular immediate subterm+data TermAccessor = +  TermAccessorAnnotatedSubject  |+  TermAccessorApplicationFunction  |+  TermAccessorApplicationArgument  |+  TermAccessorLambdaBody  |+  TermAccessorUnionCasesDefault  |+  TermAccessorUnionCasesBranch Core.Name |+  TermAccessorLetEnvironment  |+  TermAccessorLetBinding Core.Name |+  TermAccessorListElement Int |+  TermAccessorMapKey Int |+  TermAccessorMapValue Int |+  TermAccessorOptionalTerm  |+  TermAccessorProductTerm Int |+  TermAccessorRecordField Core.Name |+  TermAccessorSetElement Int |+  TermAccessorSumTerm  |+  TermAccessorTypeLambdaBody  |+  TermAccessorTypeApplicationTerm  |+  TermAccessorInjectionTerm  |+  TermAccessorWrappedTerm +  deriving (Eq, Ord, Read, Show)++_TermAccessor = (Core.Name "hydra.accessors.TermAccessor")++_TermAccessor_annotatedSubject = (Core.Name "annotatedSubject")++_TermAccessor_applicationFunction = (Core.Name "applicationFunction")++_TermAccessor_applicationArgument = (Core.Name "applicationArgument")++_TermAccessor_lambdaBody = (Core.Name "lambdaBody")++_TermAccessor_unionCasesDefault = (Core.Name "unionCasesDefault")++_TermAccessor_unionCasesBranch = (Core.Name "unionCasesBranch")++_TermAccessor_letEnvironment = (Core.Name "letEnvironment")++_TermAccessor_letBinding = (Core.Name "letBinding")++_TermAccessor_listElement = (Core.Name "listElement")++_TermAccessor_mapKey = (Core.Name "mapKey")++_TermAccessor_mapValue = (Core.Name "mapValue")++_TermAccessor_optionalTerm = (Core.Name "optionalTerm")++_TermAccessor_productTerm = (Core.Name "productTerm")++_TermAccessor_recordField = (Core.Name "recordField")++_TermAccessor_setElement = (Core.Name "setElement")++_TermAccessor_sumTerm = (Core.Name "sumTerm")++_TermAccessor_typeLambdaBody = (Core.Name "typeLambdaBody")++_TermAccessor_typeApplicationTerm = (Core.Name "typeApplicationTerm")++_TermAccessor_injectionTerm = (Core.Name "injectionTerm")++_TermAccessor_wrappedTerm = (Core.Name "wrappedTerm")
+ src/gen-main/haskell/Hydra/Adapt/Literals.hs view
@@ -0,0 +1,231 @@+-- | Adapter framework for literal types and terms++module Hydra.Adapt.Literals where++import qualified Hydra.Adapt.Utils as Utils+import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Describe.Core as Core_+import qualified Hydra.Extract.Core as Core__+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Math as Math+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Monads as Monads+import qualified Hydra.Show.Core as Core___+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Compare two precision values+comparePrecision :: (Mantle.Precision -> Mantle.Precision -> Mantle.Comparison)+comparePrecision p1 p2 = ((\x -> case x of+  Mantle.PrecisionArbitrary -> ((\x -> case x of+    Mantle.PrecisionArbitrary -> Mantle.ComparisonEqualTo+    Mantle.PrecisionBits _ -> Mantle.ComparisonGreaterThan) p2)+  Mantle.PrecisionBits v1 -> ((\x -> case x of+    Mantle.PrecisionArbitrary -> Mantle.ComparisonLessThan+    Mantle.PrecisionBits v2 -> (Logic.ifElse (Equality.lt v1 v2) Mantle.ComparisonLessThan Mantle.ComparisonGreaterThan)) p2)) p1)++-- | Convert a float value to a different float type+convertFloatValue :: (Core.FloatType -> Core.FloatValue -> Core.FloatValue)+convertFloatValue target fv =  +  let decoder = (\fv -> (\x -> case x of+          Core.FloatValueBigfloat v1 -> v1+          Core.FloatValueFloat32 v1 -> (Literals.float32ToBigfloat v1)+          Core.FloatValueFloat64 v1 -> (Literals.float64ToBigfloat v1)) fv) +      encoder = (\d -> (\x -> case x of+              Core.FloatTypeBigfloat -> (Core.FloatValueBigfloat d)+              Core.FloatTypeFloat32 -> (Core.FloatValueFloat32 (Literals.bigfloatToFloat32 d))+              Core.FloatTypeFloat64 -> (Core.FloatValueFloat64 (Literals.bigfloatToFloat64 d))) target)+  in (encoder (decoder fv))++-- | Convert an integer value to a different integer type+convertIntegerValue :: (Core.IntegerType -> Core.IntegerValue -> Core.IntegerValue)+convertIntegerValue target iv =  +  let decoder = (\iv -> (\x -> case x of+          Core.IntegerValueBigint v1 -> v1+          Core.IntegerValueInt8 v1 -> (Literals.int8ToBigint v1)+          Core.IntegerValueInt16 v1 -> (Literals.int16ToBigint v1)+          Core.IntegerValueInt32 v1 -> (Literals.int32ToBigint v1)+          Core.IntegerValueInt64 v1 -> (Literals.int64ToBigint v1)+          Core.IntegerValueUint8 v1 -> (Literals.uint8ToBigint v1)+          Core.IntegerValueUint16 v1 -> (Literals.uint16ToBigint v1)+          Core.IntegerValueUint32 v1 -> (Literals.uint32ToBigint v1)+          Core.IntegerValueUint64 v1 -> (Literals.uint64ToBigint v1)) iv) +      encoder = (\d -> (\x -> case x of+              Core.IntegerTypeBigint -> (Core.IntegerValueBigint d)+              Core.IntegerTypeInt8 -> (Core.IntegerValueInt8 (Literals.bigintToInt8 d))+              Core.IntegerTypeInt16 -> (Core.IntegerValueInt16 (Literals.bigintToInt16 d))+              Core.IntegerTypeInt32 -> (Core.IntegerValueInt32 (Literals.bigintToInt32 d))+              Core.IntegerTypeInt64 -> (Core.IntegerValueInt64 (Literals.bigintToInt64 d))+              Core.IntegerTypeUint8 -> (Core.IntegerValueUint8 (Literals.bigintToUint8 d))+              Core.IntegerTypeUint16 -> (Core.IntegerValueUint16 (Literals.bigintToUint16 d))+              Core.IntegerTypeUint32 -> (Core.IntegerValueUint32 (Literals.bigintToUint32 d))+              Core.IntegerTypeUint64 -> (Core.IntegerValueUint64 (Literals.bigintToUint64 d))) target)+  in (encoder (decoder iv))++-- | Generate a disclaimer message for type conversions+disclaimer :: (Bool -> String -> String -> String)+disclaimer lossy source target = (Strings.cat [+  "replace ",+  source,+  " with ",+  target,+  (Logic.ifElse lossy " (lossy)" "")])++literalAdapter :: (Core.LiteralType -> Compute.Flow Coders.AdapterContext (Compute.Adapter t0 t0 Core.LiteralType Core.LiteralType Core.Literal Core.Literal))+literalAdapter lt =  +  let alts = (\t -> (\x -> case x of+          Core.LiteralTypeBinary ->  +            let step = Compute.Coder {+                    Compute.coderEncode = (\lit -> (\x -> case x of+                      Core.LiteralBinary v2 -> (Flows.pure (Core.LiteralString (Literals.binaryToString v2)))) lit),+                    Compute.coderDecode = (\lit -> (\x -> case x of+                      Core.LiteralString v2 -> (Flows.pure (Core.LiteralBinary (Literals.stringToBinary v2)))) lit)}+            in (Flows.pure [+              Compute.Adapter {+                Compute.adapterIsLossy = False,+                Compute.adapterSource = t,+                Compute.adapterTarget = Core.LiteralTypeString,+                Compute.adapterCoder = step}])+          Core.LiteralTypeBoolean -> (Flows.bind Monads.getState (\cx ->  +            let constraints = (Coders.languageConstraints (Coders.adapterContextLanguage cx)) +                hasIntegers = (Logic.not (Sets.null (Coders.languageConstraintsIntegerTypes constraints)))+                hasStrings = (Sets.member Mantle.LiteralVariantString (Coders.languageConstraintsLiteralVariants constraints))+            in (Logic.ifElse hasIntegers (Flows.bind (integerAdapter Core.IntegerTypeUint8) (\adapter ->  +              let step_ = (Compute.adapterCoder adapter) +                  step = Compute.Coder {+                          Compute.coderEncode = (\lit -> (\x -> case x of+                            Core.LiteralBoolean v2 -> (Flows.bind (Compute.coderEncode step_ (Core.IntegerValueUint8 (Logic.ifElse v2 1 0))) (\iv -> Flows.pure (Core.LiteralInteger iv)))) lit),+                          Compute.coderDecode = (\lit -> (\x -> case x of+                            Core.LiteralInteger v2 -> (Flows.bind (Compute.coderDecode step_ v2) (\val -> (\x -> case x of+                              Core.IntegerValueUint8 v3 -> (Flows.pure (Core.LiteralBoolean (Equality.equal v3 1)))) val))) lit)}+              in (Flows.pure [+                Compute.Adapter {+                  Compute.adapterIsLossy = False,+                  Compute.adapterSource = t,+                  Compute.adapterTarget = (Core.LiteralTypeInteger (Compute.adapterTarget adapter)),+                  Compute.adapterCoder = step}]))) (Logic.ifElse hasStrings (Flows.pure ( +              let encode = (\lit -> Flows.bind (Core__.booleanLiteral lit) (\b -> Flows.pure (Core.LiteralString (Logic.ifElse b "true" "false")))) +                  decode = (\lit -> Flows.bind (Core__.stringLiteral lit) (\s -> Logic.ifElse (Equality.equal s "true") (Flows.pure (Core.LiteralBoolean True)) (Logic.ifElse (Equality.equal s "false") (Flows.pure (Core.LiteralBoolean False)) (Monads.unexpected "boolean literal" s))))+              in [+                Compute.Adapter {+                  Compute.adapterIsLossy = False,+                  Compute.adapterSource = t,+                  Compute.adapterTarget = Core.LiteralTypeString,+                  Compute.adapterCoder = Compute.Coder {+                    Compute.coderEncode = encode,+                    Compute.coderDecode = decode}}])) (Flows.fail "no alternatives available for boolean encoding")))))+          Core.LiteralTypeFloat v1 -> (Flows.bind Monads.getState (\cx ->  +            let constraints = (Coders.languageConstraints (Coders.adapterContextLanguage cx)) +                hasFloats = (Logic.not (Sets.null (Coders.languageConstraintsFloatTypes constraints)))+            in (Logic.ifElse hasFloats (Flows.bind (floatAdapter v1) (\adapter ->  +              let step = (Utils.bidirectional (\dir -> \l -> (\x -> case x of+                      Core.LiteralFloat v2 -> (Flows.map (\x -> Core.LiteralFloat x) (Utils.encodeDecode dir (Compute.adapterCoder adapter) v2))+                      _ -> (Monads.unexpected "floating-point literal" (Core___.literal l))) l))+              in (Flows.pure [+                Compute.Adapter {+                  Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),+                  Compute.adapterSource = t,+                  Compute.adapterTarget = (Core.LiteralTypeFloat (Compute.adapterTarget adapter)),+                  Compute.adapterCoder = step}]))) (Flows.fail "no float types available"))))+          Core.LiteralTypeInteger v1 -> (Flows.bind Monads.getState (\cx ->  +            let constraints = (Coders.languageConstraints (Coders.adapterContextLanguage cx)) +                hasIntegers = (Logic.not (Sets.null (Coders.languageConstraintsIntegerTypes constraints)))+            in (Logic.ifElse hasIntegers (Flows.bind (integerAdapter v1) (\adapter ->  +              let step = (Utils.bidirectional (\dir -> \lit -> (\x -> case x of+                      Core.LiteralInteger v2 -> (Flows.map (\x -> Core.LiteralInteger x) (Utils.encodeDecode dir (Compute.adapterCoder adapter) v2))+                      _ -> (Monads.unexpected "integer literal" (Core___.literal lit))) lit))+              in (Flows.pure [+                Compute.Adapter {+                  Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),+                  Compute.adapterSource = t,+                  Compute.adapterTarget = (Core.LiteralTypeInteger (Compute.adapterTarget adapter)),+                  Compute.adapterCoder = step}]))) (Flows.fail "no integer types available"))))+          Core.LiteralTypeString -> (Flows.fail "no substitute for the literal string type")) t)+  in (Flows.bind Monads.getState (\cx ->  +    let supported = (Utils.literalTypeIsSupported (Coders.languageConstraints (Coders.adapterContextLanguage cx)))+    in (Utils.chooseAdapter alts supported Core___.literalType Core_.literalType lt)))++floatAdapter :: (Core.FloatType -> Compute.Flow Coders.AdapterContext (Compute.Adapter t0 t1 Core.FloatType Core.FloatType Core.FloatValue Core.FloatValue))+floatAdapter ft =  +  let alts = (\t -> Flows.mapList (makeAdapter t) ((\x -> case x of+          Core.FloatTypeBigfloat -> [+            Core.FloatTypeFloat64,+            Core.FloatTypeFloat32]+          Core.FloatTypeFloat32 -> [+            Core.FloatTypeFloat64,+            Core.FloatTypeBigfloat]+          Core.FloatTypeFloat64 -> [+            Core.FloatTypeBigfloat,+            Core.FloatTypeFloat32]) t)) +      makeAdapter = (\source -> \target ->  +              let lossy = (Equality.equal (comparePrecision (Variants.floatTypePrecision source) (Variants.floatTypePrecision target)) Mantle.ComparisonGreaterThan) +                  step = Compute.Coder {+                          Compute.coderEncode = (\fv -> Flows.pure (convertFloatValue target fv)),+                          Compute.coderDecode = (\fv -> Flows.pure (convertFloatValue source fv))}+                  msg = (disclaimer lossy (Core_.floatType source) (Core_.floatType target))+              in (Monads.warn msg (Flows.pure (Compute.Adapter {+                Compute.adapterIsLossy = lossy,+                Compute.adapterSource = source,+                Compute.adapterTarget = target,+                Compute.adapterCoder = step}))))+  in (Flows.bind Monads.getState (\cx ->  +    let supported = (Utils.floatTypeIsSupported (Coders.languageConstraints (Coders.adapterContextLanguage cx)))+    in (Utils.chooseAdapter alts supported Core___.floatType Core_.floatType ft)))++integerAdapter :: (Core.IntegerType -> Compute.Flow Coders.AdapterContext (Compute.Adapter t0 t1 Core.IntegerType Core.IntegerType Core.IntegerValue Core.IntegerValue))+integerAdapter it =  +  let interleave = (\xs -> \ys -> Lists.concat (Lists.transpose [+          xs,+          ys])) +      signedOrdered = (Lists.filter (\v -> Logic.and (Variants.integerTypeIsSigned v) (Logic.not (Equality.equal (Variants.integerTypePrecision v) Mantle.PrecisionArbitrary))) Variants.integerTypes)+      unsignedOrdered = (Lists.filter (\v -> Logic.and (Logic.not (Variants.integerTypeIsSigned v)) (Logic.not (Equality.equal (Variants.integerTypePrecision v) Mantle.PrecisionArbitrary))) Variants.integerTypes)+      signedPref = (interleave signedOrdered unsignedOrdered)+      unsignedPref = (interleave unsignedOrdered signedOrdered)+      signedNonPref = (Lists.reverse unsignedPref)+      unsignedNonPref = (Lists.reverse signedPref)+      signed = (\i -> Lists.concat [+              Lists.drop (Math.mul i 2) signedPref,+              [+                Core.IntegerTypeBigint],+              (Lists.drop (Math.add (Math.sub 8 (Math.mul i 2)) 1) signedNonPref)])+      unsigned = (\i -> Lists.concat [+              Lists.drop (Math.mul i 2) unsignedPref,+              [+                Core.IntegerTypeBigint],+              (Lists.drop (Math.add (Math.sub 8 (Math.mul i 2)) 1) unsignedNonPref)])+      alts = (\t -> Flows.mapList (makeAdapter t) ((\x -> case x of+              Core.IntegerTypeBigint -> (Lists.reverse unsignedPref)+              Core.IntegerTypeInt8 -> (signed 1)+              Core.IntegerTypeInt16 -> (signed 2)+              Core.IntegerTypeInt32 -> (signed 3)+              Core.IntegerTypeInt64 -> (signed 4)+              Core.IntegerTypeUint8 -> (unsigned 1)+              Core.IntegerTypeUint16 -> (unsigned 2)+              Core.IntegerTypeUint32 -> (unsigned 3)+              Core.IntegerTypeUint64 -> (unsigned 4)) t))+      makeAdapter = (\source -> \target ->  +              let lossy = (Logic.not (Equality.equal (comparePrecision (Variants.integerTypePrecision source) (Variants.integerTypePrecision target)) Mantle.ComparisonLessThan)) +                  step = Compute.Coder {+                          Compute.coderEncode = (\iv -> Flows.pure (convertIntegerValue target iv)),+                          Compute.coderDecode = (\iv -> Flows.pure (convertIntegerValue source iv))}+                  msg = (disclaimer lossy (Core_.integerType source) (Core_.integerType target))+              in (Monads.warn msg (Flows.pure (Compute.Adapter {+                Compute.adapterIsLossy = lossy,+                Compute.adapterSource = source,+                Compute.adapterTarget = target,+                Compute.adapterCoder = step}))))+  in (Flows.bind Monads.getState (\cx ->  +    let supported = (Utils.integerTypeIsSupported (Coders.languageConstraints (Coders.adapterContextLanguage cx)))+    in (Utils.chooseAdapter alts supported Core___.integerType Core_.integerType it)))
+ src/gen-main/haskell/Hydra/Adapt/Modules.hs view
@@ -0,0 +1,91 @@+-- | Entry point for Hydra's adapter (type/term rewriting) framework++module Hydra.Adapt.Modules where++import qualified Hydra.Adapt.Terms as Terms+import qualified Hydra.Adapt.Utils as Utils+import qualified Hydra.Annotations as Annotations+import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Decode.Core as Core_+import qualified Hydra.Describe.Core as Core__+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Module as Module+import qualified Hydra.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++adaptTypeToLanguageAndEncode :: (Coders.Language -> (Core.Type -> Compute.Flow Graph.Graph t0) -> Core.Type -> Compute.Flow Graph.Graph t0)+adaptTypeToLanguageAndEncode lang enc typ = ((\x -> case x of+  Core.TypeVariable _ -> (enc typ)+  _ -> (Flows.bind (adaptTypeToLanguage lang typ) (\adaptedType -> enc adaptedType))) (Rewriting.deannotateType typ))++-- | Given a target language and a source type, find the target type to which the latter will be adapted+adaptTypeToLanguage :: (Coders.Language -> Core.Type -> Compute.Flow Graph.Graph Core.Type)+adaptTypeToLanguage lang typ = (Flows.bind (languageAdapter lang typ) (\adapter -> Flows.pure (Compute.adapterTarget adapter)))++-- | Map a Hydra module to a list of type and/or term definitions which have been adapted to the target language+adaptedModuleDefinitions :: (Coders.Language -> Module.Module -> Compute.Flow Graph.Graph [Module.Definition])+adaptedModuleDefinitions lang mod =  +  let els = (Module.moduleElements mod) +      adaptersFor = (\types -> Flows.bind (Flows.mapList (languageAdapter lang) types) (\adapters -> Flows.pure (Maps.fromList (Lists.zip types adapters))))+      classify = (\adapters -> \pair ->  +              let el = (fst pair) +                  tt = (snd pair)+                  term = (Core.typedTermTerm tt)+                  typ = (Core.typedTermType tt)+                  name = (Core.bindingName el)+              in (Logic.ifElse (Annotations.isNativeType el) (Flows.bind (Flows.bind (Core_.type_ term) (\coreTyp -> adaptTypeToLanguage lang coreTyp)) (\adaptedTyp -> Flows.pure (Module.DefinitionType (Module.TypeDefinition {+                Module.typeDefinitionName = name,+                Module.typeDefinitionType = adaptedTyp})))) (Optionals.maybe (Flows.fail (Strings.cat2 "no adapter for element " (Core.unName name))) (\adapter -> Flows.bind (Compute.coderEncode (Compute.adapterCoder adapter) term) (\adapted -> Flows.pure (Module.DefinitionTerm (Module.TermDefinition {+                Module.termDefinitionName = name,+                Module.termDefinitionTerm = adapted,+                Module.termDefinitionType = (Compute.adapterTarget adapter)})))) (Maps.lookup typ adapters))))+  in (Flows.bind (Lexical.withSchemaContext (Flows.mapList Schemas.elementAsTypedTerm els)) (\tterms ->  +    let types = (Sets.toList (Sets.fromList (Lists.map (\arg_ -> Rewriting.deannotateType (Core.typedTermType arg_)) tterms)))+    in (Flows.bind (adaptersFor types) (\adapters -> Flows.mapList (classify adapters) (Lists.zip els tterms)))))++constructCoder :: (Coders.Language -> (Core.Term -> Compute.Flow t0 t1) -> Core.Type -> Compute.Flow Graph.Graph (Compute.Coder t0 t2 Core.Term t1))+constructCoder lang encodeTerm typ = (Monads.withTrace (Strings.cat2 "coder for " (Core__.type_ typ)) (Flows.bind (languageAdapter lang typ) (\adapter -> Flows.pure (Utils.composeCoders (Compute.adapterCoder adapter) (Utils.unidirectionalCoder encodeTerm)))))++languageAdapter :: (Coders.Language -> Core.Type -> Compute.Flow Graph.Graph (Compute.Adapter t0 t1 Core.Type Core.Type Core.Term Core.Term))+languageAdapter lang typ = (Flows.bind Monads.getState (\g ->  +  let cx0 = Coders.AdapterContext {+          Coders.adapterContextGraph = g,+          Coders.adapterContextLanguage = lang,+          Coders.adapterContextAdapters = Maps.empty}+  in (Flows.bind (Monads.withState cx0 (Flows.bind (Terms.termAdapter typ) (\ad -> Flows.bind Monads.getState (\cx -> Flows.pure (ad, cx))))) (\result ->  +    let adapter = (fst result) +        cx = (snd result)+        encode = (\term -> Monads.withState cx (Compute.coderEncode (Compute.adapterCoder adapter) term))+        decode = (\term -> Monads.withState cx (Compute.coderDecode (Compute.adapterCoder adapter) term))+        ac = Compute.Coder {+                Compute.coderEncode = encode,+                Compute.coderDecode = decode}+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),+      Compute.adapterSource = (Compute.adapterSource adapter),+      Compute.adapterTarget = (Compute.adapterTarget adapter),+      Compute.adapterCoder = ac}))))))++transformModule :: (Coders.Language -> (Core.Term -> Compute.Flow t0 t1) -> (Module.Module -> M.Map Core.Type (Compute.Coder t0 t2 Core.Term t1) -> [(Core.Binding, Core.TypedTerm)] -> Compute.Flow Graph.Graph t3) -> Module.Module -> Compute.Flow Graph.Graph t3)+transformModule lang encodeTerm createModule mod = (Monads.withTrace (Strings.cat2 "transform module " (Module.unNamespace (Module.moduleNamespace mod))) ( +  let els = (Module.moduleElements mod) +      codersFor = (\types -> Flows.bind (Flows.mapList (constructCoder lang encodeTerm) types) (\cdrs -> Flows.pure (Maps.fromList (Lists.zip types cdrs))))+  in (Flows.bind (Lexical.withSchemaContext (Flows.mapList Schemas.elementAsTypedTerm els)) (\tterms ->  +    let types = (Lists.nub (Lists.map Core.typedTermType tterms))+    in (Flows.bind (codersFor types) (\coders -> createModule mod coders (Lists.zip els tterms)))))))
+ src/gen-main/haskell/Hydra/Adapt/Simple.hs view
@@ -0,0 +1,272 @@+-- | Simple, one-way adapters for types and terms++module Hydra.Adapt.Simple where++import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Inference as Inference+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Literals as Literals_+import qualified Hydra.Module as Module+import qualified Hydra.Reduction as Reduction+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import qualified Hydra.Show.Core as Core_+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | 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))+  in  +    let alt = (adaptFloatType constraints)+    in (Logic.ifElse supported (Just ft) ((\x -> case x of+      Core.FloatTypeBigfloat -> Nothing+      Core.FloatTypeFloat32 -> (alt Core.FloatTypeFloat64)+      Core.FloatTypeFloat64 -> (alt Core.FloatTypeBigfloat)) ft))++-- | Adapt a graph and its schema to the given language constraints, prior to inference+adaptDataGraph :: (Coders.LanguageConstraints -> Bool -> Graph.Graph -> Compute.Flow Graph.Graph Graph.Graph)+adaptDataGraph constraints doExpand graph0 =  +  let litmap = (adaptLiteralTypesMap constraints)+  in  +    let els0 = (Graph.graphElements graph0)+    in  +      let env0 = (Graph.graphEnvironment graph0)+      in  +        let body0 = (Graph.graphBody graph0)+        in  +          let prims0 = (Graph.graphPrimitives graph0)+          in  +            let schema0 = (Graph.graphSchema graph0)+            in (Flows.bind (Optionals.maybe (Flows.pure Nothing) (\sg -> Flows.bind (Schemas.graphAsTypes sg) (\tmap0 -> Flows.bind (adaptGraphSchema constraints litmap tmap0) (\tmap1 ->  +              let emap = (Schemas.typesToElements tmap1)+              in (Flows.pure (Just (Graph.Graph {+                Graph.graphElements = emap,+                Graph.graphEnvironment = (Graph.graphEnvironment sg),+                Graph.graphTypes = (Graph.graphTypes sg),+                Graph.graphBody = (Graph.graphBody sg),+                Graph.graphPrimitives = (Graph.graphPrimitives sg),+                Graph.graphSchema = (Graph.graphSchema sg)})))))) schema0) (\schema1 ->  +              let gterm0 = (Schemas.graphAsTerm graph0)+              in  +                let gterm1 = (Logic.ifElse doExpand (Reduction.expandLambdas graph0 gterm0) gterm0)+                in (Flows.bind (adaptTerm constraints litmap gterm1) (\gterm2 ->  +                  let els1 = (Schemas.termAsGraph gterm2)+                  in (Flows.bind (Flows.mapElems (adaptPrimitive constraints litmap) prims0) (\prims1 -> Flows.pure (Graph.Graph {+                    Graph.graphElements = els1,+                    Graph.graphEnvironment = env0,+                    Graph.graphTypes = Maps.empty,+                    Graph.graphBody = Core.TermUnit,+                    Graph.graphPrimitives = prims1,+                    Graph.graphSchema = schema1})))))))++adaptGraphSchema :: (Ord t0) => (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> M.Map t0 Core.Type -> Compute.Flow t1 (M.Map t0 Core.Type))+adaptGraphSchema constraints litmap types0 =  +  let mapPair = (\pair ->  +          let name = (fst pair)+          in  +            let typ = (snd pair)+            in (Flows.bind (adaptType constraints litmap typ) (\typ1 -> Flows.pure (name, typ1))))+  in (Flows.bind (Flows.mapList mapPair (Maps.toList types0)) (\pairs -> Flows.pure (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))+  in  +    let alt = (adaptIntegerType constraints)+    in (Logic.ifElse supported (Just it) ((\x -> case x 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)) it))++-- | Convert a literal to a different type+adaptLiteral :: (Core.LiteralType -> Core.Literal -> Core.Literal)+adaptLiteral lt l = ((\x -> case x of+  Core.LiteralBinary v1 -> ((\x -> case x of+    Core.LiteralTypeString -> (Core.LiteralString (Literals.binaryToString v1))) lt)+  Core.LiteralBoolean v1 -> ((\x -> case x of+    Core.LiteralTypeInteger v2 -> (Core.LiteralInteger (Literals_.bigintToIntegerValue v2 (Logic.ifElse v1 1 0)))) lt)+  Core.LiteralFloat v1 -> ((\x -> case x of+    Core.LiteralTypeFloat v2 -> (Core.LiteralFloat (Literals_.bigfloatToFloatValue v2 (Literals_.floatValueToBigfloat v1)))) lt)+  Core.LiteralInteger v1 -> ((\x -> case x of+    Core.LiteralTypeInteger v2 -> (Core.LiteralInteger (Literals_.bigintToIntegerValue v2 (Literals_.integerValueToBigint v1)))) lt)) l)++-- | Attempt to adapt a literal type using the given language constraints+adaptLiteralType :: (Coders.LanguageConstraints -> Core.LiteralType -> Maybe Core.LiteralType)+adaptLiteralType constraints lt = (Logic.ifElse (literalTypeSupported constraints lt) Nothing ((\x -> case x of+  Core.LiteralTypeBinary -> (Just Core.LiteralTypeString)+  Core.LiteralTypeBoolean -> (Optionals.map (\x -> Core.LiteralTypeInteger x) (adaptIntegerType constraints Core.IntegerTypeInt8))+  Core.LiteralTypeFloat v1 -> (Optionals.map (\x -> Core.LiteralTypeFloat x) (adaptFloatType constraints v1))+  Core.LiteralTypeInteger v1 -> (Optionals.map (\x -> Core.LiteralTypeInteger x) (adaptIntegerType constraints v1))+  _ -> Nothing) 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.maybe Nothing (\lt2 -> Just (lt, lt2)) (adaptLiteralType constraints lt))+  in (Maps.fromList (Optionals.cat (Lists.map tryType Variants.literalTypes)))++adaptLiteralValue :: (Ord t0) => (M.Map t0 Core.LiteralType -> t0 -> Core.Literal -> Core.Literal)+adaptLiteralValue litmap lt l = (Optionals.maybe (Core.LiteralString (Core_.literal l)) (\lt2 -> adaptLiteral lt2 l) (Maps.lookup lt litmap))++adaptPrimitive :: (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Graph.Primitive -> Compute.Flow t0 Graph.Primitive)+adaptPrimitive constraints litmap prim0 =  +  let ts0 = (Graph.primitiveType prim0)+  in (Flows.bind (adaptTypeScheme constraints litmap ts0) (\ts1 -> Flows.pure (Graph.Primitive {+    Graph.primitiveName = (Graph.primitiveName prim0),+    Graph.primitiveType = ts1,+    Graph.primitiveImplementation = (Graph.primitiveImplementation prim0)})))++-- | Adapt a term using the given language constraints+adaptTerm :: (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.Term -> Compute.Flow Graph.Graph Core.Term)+adaptTerm constraints litmap term0 =  +  let rewrite = (\recurse -> \term0 -> Flows.bind (recurse term0) (\term1 ->  +          let tryTerm = (\term ->  +                  let supportedVariant = (Sets.member (Variants.termVariant term) (Coders.languageConstraintsTermVariants constraints))+                  in (Logic.ifElse supportedVariant ((\x -> case x of+                    Core.TermLiteral v1 ->  +                      let lt = (Variants.literalType v1)+                      in (Flows.pure (Just (Logic.ifElse (literalTypeSupported constraints lt) term (Core.TermLiteral (adaptLiteralValue litmap lt v1)))))+                    _ -> (Flows.pure (Just term))) term) ( +                    let tryAlts = (\alts -> Logic.ifElse (Lists.null alts) (Flows.pure Nothing) (Flows.bind (tryTerm (Lists.head alts)) (\mterm -> Optionals.maybe (tryAlts (Lists.tail alts)) (\t -> Flows.pure (Just t)) mterm)))+                    in (Flows.bind (termAlternatives term1) (\alts -> tryAlts alts)))))+          in (Flows.bind (tryTerm term1) (\mterm -> Optionals.maybe (Flows.fail (Strings.cat [+            "no alternatives for term: ",+            (Core_.term term1)])) (\term2 -> Flows.pure term2) mterm))))+  in (Rewriting.rewriteTermM rewrite term0)++adaptType :: (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.Type -> Compute.Flow t0 Core.Type)+adaptType constraints litmap type0 =  +  let rewrite = (\recurse -> \typ -> Flows.bind (recurse typ) (\type1 ->  +          let tryType = (\typ ->  +                  let supportedVariant = (Sets.member (Variants.typeVariant typ) (Coders.languageConstraintsTypeVariants constraints))+                  in (Logic.ifElse supportedVariant ((\x -> case x of+                    Core.TypeLiteral v1 -> (Logic.ifElse (literalTypeSupported constraints v1) (Just typ) (Optionals.maybe (Just (Core.TypeLiteral Core.LiteralTypeString)) (\lt2 -> Just (Core.TypeLiteral lt2)) (Maps.lookup v1 litmap)))+                    _ -> (Just typ)) typ) ( +                    let tryAlts = (\alts -> Logic.ifElse (Lists.null alts) Nothing (Optionals.maybe (tryAlts (Lists.tail alts)) (\t -> Just t) (tryType (Lists.head alts))))+                    in  +                      let alts = (typeAlternatives type1)+                      in (tryAlts alts))))+          in (Optionals.maybe (Flows.fail (Strings.cat [+            "no alternatives for type: ",+            (Core_.type_ typ)])) (\type2 -> Flows.pure type2) (tryType type1))))+  in (Rewriting.rewriteTypeM rewrite type0)++adaptTypeScheme :: (Coders.LanguageConstraints -> M.Map Core.LiteralType Core.LiteralType -> Core.TypeScheme -> Compute.Flow t0 Core.TypeScheme)+adaptTypeScheme constraints litmap ts0 =  +  let vars0 = (Core.typeSchemeVariables ts0)+  in  +    let t0 = (Core.typeSchemeType ts0)+    in (Flows.bind (adaptType constraints litmap t0) (\t1 -> Flows.pure (Core.TypeScheme {+      Core.typeSchemeVariables = vars0,+      Core.typeSchemeType = t1})))++-- | Given a data graph along with language constraints and a designated list of element names, adapt the graph to the language constraints, perform inference, then return a corresponding term definition for each element name.+dataGraphToDefinitions :: (Coders.LanguageConstraints -> Bool -> Graph.Graph -> [[Core.Name]] -> Compute.Flow Graph.Graph (Graph.Graph, [[Module.TermDefinition]]))+dataGraphToDefinitions constraints doExpand graph nameLists = (Flows.bind (adaptDataGraph constraints doExpand graph) (\graph1 -> Flows.bind (Inference.inferGraphTypes graph1) (\graph2 ->  +  let toDef = (\el ->  +          let ts = (Optionals.fromJust (Core.bindingType el))+          in Module.TermDefinition {+            Module.termDefinitionName = (Core.bindingName el),+            Module.termDefinitionTerm = (Core.bindingTerm el),+            Module.termDefinitionType = (Schemas.typeSchemeToFType ts)})+  in (Flows.pure (graph2, (Lists.map (\names -> Lists.map toDef (Lists.map (\n -> Optionals.fromJust (Maps.lookup n (Graph.graphElements graph2))) names)) nameLists))))))++-- | Check if a literal type is supported by the given language constraints+literalTypeSupported :: (Coders.LanguageConstraints -> Core.LiteralType -> Bool)+literalTypeSupported constraints lt = (Logic.ifElse (Sets.member (Variants.literalTypeVariant lt) (Coders.languageConstraintsLiteralVariants constraints)) ((\x -> case x of+  Core.LiteralTypeFloat v1 -> (Sets.member v1 (Coders.languageConstraintsFloatTypes constraints))+  Core.LiteralTypeInteger v1 -> (Sets.member v1 (Coders.languageConstraintsIntegerTypes constraints))+  _ -> True) lt) False)++-- | 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]] -> Compute.Flow Graph.Graph (M.Map Core.Name Core.Type, [[Module.TypeDefinition]]))+schemaGraphToDefinitions constraints graph nameLists =  +  let litmap = (adaptLiteralTypesMap constraints)+  in (Flows.bind (Schemas.graphAsTypes graph) (\tmap0 -> Flows.bind (adaptGraphSchema constraints litmap tmap0) (\tmap1 ->  +    let toDef = (\pair -> Module.TypeDefinition {+            Module.typeDefinitionName = (fst pair),+            Module.typeDefinitionType = (snd pair)})+    in (Flows.pure (tmap1, (Lists.map (\names -> Lists.map toDef (Lists.map (\n -> (n, (Optionals.fromJust (Maps.lookup n tmap1)))) names)) nameLists))))))++-- | Find a list of alternatives for a given term, if any+termAlternatives :: (Core.Term -> Compute.Flow Graph.Graph [Core.Term])+termAlternatives term = ((\x -> case x of+  Core.TermAnnotated v1 ->  +    let term2 = (Core.annotatedTermSubject v1)+    in (Flows.pure [+      term2])+  Core.TermOptional v1 -> (Flows.pure [+    Core.TermList (Optionals.maybe [] (\term2 -> [+      term2]) v1)])+  Core.TermUnion v1 ->  +    let tname = (Core.injectionTypeName v1)+    in  +      let field = (Core.injectionField v1)+      in  +        let fname = (Core.fieldName field)+        in  +          let fterm = (Core.fieldTerm field)+          in (Flows.bind (Schemas.requireUnionType tname) (\rt -> Flows.pure [+             +              let 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  +                let fields = (Lists.map forFieldType (Core.rowTypeFields rt))+                in (Core.TermRecord (Core.Record {+                  Core.recordTypeName = tname,+                  Core.recordFields = fields}))]))+  Core.TermUnit -> (Flows.pure [+    Core.TermLiteral (Core.LiteralBoolean True)])+  Core.TermWrap v1 ->  +    let term2 = (Core.wrappedTermObject v1)+    in (Flows.pure [+      term2])+  _ -> (Flows.pure [])) term)++-- | Find a list of alternatives for a given type, if any+typeAlternatives :: (Core.Type -> [Core.Type])+typeAlternatives type_ = ((\x -> case x of+  Core.TypeAnnotated v1 ->  +    let type2 = (Core.annotatedTypeSubject v1)+    in [+      type2]+  Core.TypeOptional v1 -> [+    Core.TypeList v1]+  Core.TypeUnion v1 ->  +    let tname = (Core.rowTypeTypeName v1)+    in  +      let fields = (Core.rowTypeFields v1)+      in [+        Core.TypeRecord (Core.RowType {+          Core.rowTypeTypeName = tname,+          Core.rowTypeFields = fields})]+  Core.TypeUnit -> [+    Core.TypeLiteral Core.LiteralTypeBoolean]+  _ -> []) type_)
+ src/gen-main/haskell/Hydra/Adapt/Terms.hs view
@@ -0,0 +1,639 @@+-- | Adapter framework for types and terms++module Hydra.Adapt.Terms where++import qualified Hydra.Adapt.Literals as Literals+import qualified Hydra.Adapt.Utils as Utils+import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Describe.Core as Core_+import qualified Hydra.Extract.Core as Core__+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import qualified Hydra.Show.Core as Core___+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Create an adapter for field types+fieldAdapter :: (Core.FieldType -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.FieldType Core.FieldType Core.Field Core.Field))+fieldAdapter ftyp = (Flows.bind (termAdapter (Core.fieldTypeType ftyp)) (\ad -> Flows.pure (Compute.Adapter {+  Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+  Compute.adapterSource = ftyp,+  Compute.adapterTarget = Core.FieldType {+    Core.fieldTypeName = (Core.fieldTypeName ftyp),+    Core.fieldTypeType = (Compute.adapterTarget ad)},+  Compute.adapterCoder = (Utils.bidirectional (\dir -> \field ->  +    let name = (Core.fieldName field) +        term = (Core.fieldTerm field)+    in (Flows.map (\newTerm -> Core.Field {+      Core.fieldName = name,+      Core.fieldTerm = newTerm}) (Utils.encodeDecode dir (Compute.adapterCoder ad) term))))})))++-- | This function accounts for recursive type definitions+forTypeReference :: (Core.Name -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+forTypeReference name = (Monads.withTrace (Strings.cat2 "adapt named type " (Core.unName name)) ( +  let lossy = False +      placeholder = Compute.Adapter {+              Compute.adapterIsLossy = lossy,+              Compute.adapterSource = (Core.TypeVariable name),+              Compute.adapterTarget = (Core.TypeVariable name),+              Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Flows.bind Monads.getState (\cx ->  +                let adapters = (Coders.adapterContextAdapters cx)+                in (Optionals.maybe (Flows.fail (Strings.cat2 "no adapter for reference type " (Core.unName name))) (\ad -> Utils.encodeDecode dir (Compute.adapterCoder ad) term) (Maps.lookup name adapters)))))}+  in (Flows.bind Monads.getState (\cx ->  +    let adapters = (Coders.adapterContextAdapters cx)+    in (Optionals.maybe ( +      let newAdapters = (Maps.insert name placeholder adapters) +          newCx = Coders.AdapterContext {+                  Coders.adapterContextGraph = (Coders.adapterContextGraph cx),+                  Coders.adapterContextLanguage = (Coders.adapterContextLanguage cx),+                  Coders.adapterContextAdapters = newAdapters}+      in (Flows.bind (Monads.putState newCx) (\_ -> Flows.bind (withGraphContext (Schemas.resolveType (Core.TypeVariable name))) (\mt -> Optionals.maybe (Flows.pure (Compute.Adapter {+        Compute.adapterIsLossy = lossy,+        Compute.adapterSource = (Core.TypeVariable name),+        Compute.adapterTarget = (Core.TypeVariable name),+        Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Flows.pure term))})) (\t -> Flows.bind (termAdapter t) (\actual ->  +        let finalAdapters = (Maps.insert name actual adapters) +            finalCx = Coders.AdapterContext {+                    Coders.adapterContextGraph = (Coders.adapterContextGraph cx),+                    Coders.adapterContextLanguage = (Coders.adapterContextLanguage cx),+                    Coders.adapterContextAdapters = finalAdapters}+        in (Flows.bind (Monads.putState finalCx) (\_ -> Flows.pure actual)))) mt)))) Flows.pure (Maps.lookup name adapters))))))++functionProxyName :: Core.Name+functionProxyName = (Core.Name "hydra.core.FunctionProxy")++functionProxyType :: (t0 -> Core.Type)+functionProxyType _ = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = functionProxyName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "wrap"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "record"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "union"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "lambda"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "primitive"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "variable"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)}]}))++-- | Convert function types to union types+functionToUnion :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+functionToUnion t = ((\x -> case x of+  Core.TypeFunction v1 ->  +    let dom = (Core.functionTypeDomain v1) +        cod = (Core.functionTypeCodomain v1)+        unionType = (Flows.bind (termAdapter dom) (\domAd -> Flows.pure (Core.TypeUnion (Core.RowType {+                Core.rowTypeTypeName = functionProxyName,+                Core.rowTypeFields = [+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "wrap"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "record"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "union"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "lambda"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "primitive"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+                  Core.FieldType {+                    Core.fieldTypeName = (Core.Name "variable"),+                    Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)}]}))))+        encode = (\ad -> \term ->  +                let strippedTerm = (Rewriting.deannotateTerm term)+                in (Compute.coderEncode (Compute.adapterCoder ad) ((\x -> case x of+                  Core.TermFunction v2 -> ((\x -> case x of+                    Core.FunctionElimination v3 -> ((\x -> case x of+                      Core.EliminationWrap v4 -> (Core.TermUnion (Core.Injection {+                        Core.injectionTypeName = functionProxyName,+                        Core.injectionField = Core.Field {+                          Core.fieldName = (Core.Name "wrap"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core.unName v4)))}}))+                      Core.EliminationRecord _ -> (Core.TermUnion (Core.Injection {+                        Core.injectionTypeName = functionProxyName,+                        Core.injectionField = Core.Field {+                          Core.fieldName = (Core.Name "record"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core___.term term)))}}))+                      Core.EliminationUnion _ -> (Core.TermUnion (Core.Injection {+                        Core.injectionTypeName = functionProxyName,+                        Core.injectionField = Core.Field {+                          Core.fieldName = (Core.Name "union"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core___.term term)))}}))) v3)+                    Core.FunctionLambda _ -> (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = functionProxyName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "lambda"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core___.term term)))}}))+                    Core.FunctionPrimitive v3 -> (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = functionProxyName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "primitive"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core.unName v3)))}}))) v2)+                  Core.TermVariable v2 -> (Core.TermUnion (Core.Injection {+                    Core.injectionTypeName = functionProxyName,+                    Core.injectionField = Core.Field {+                      Core.fieldName = (Core.Name "variable"),+                      Core.fieldTerm = (Core.TermLiteral (Core.LiteralString (Core.unName v2)))}}))) strippedTerm)))+        decode = (\ad -> \term ->  +                let readFromString = (\term -> Flows.bind (Core__.string term) (\s -> Optionals.maybe (Flows.fail (Strings.cat2 "failed to parse term: " s)) Flows.pure (Core___.readTerm s))) +                    notFound = (\fname -> Flows.fail (Strings.cat2 "unexpected field: " (Core.unName fname)))+                    forCases = (\fterm -> withGraphContext (readFromString fterm))+                    forLambda = (\fterm -> withGraphContext (readFromString fterm))+                    forWrapped = (\fterm -> withGraphContext (Flows.map (\s -> Core.TermFunction (Core.FunctionElimination (Core.EliminationWrap (Core.Name s)))) (Core__.string fterm)))+                    forPrimitive = (\fterm -> withGraphContext (Flows.map (\s -> Core.TermFunction (Core.FunctionPrimitive (Core.Name s))) (Core__.string fterm)))+                    forProjection = (\fterm -> withGraphContext (readFromString fterm))+                    forVariable = (\fterm -> withGraphContext (Flows.map (\s -> Core.TermVariable (Core.Name s)) (Core__.string fterm)))+                in (Flows.bind (Compute.coderDecode (Compute.adapterCoder ad) term) (\injTerm -> Flows.bind (withGraphContext (Core__.injection functionProxyName injTerm)) (\field ->  +                  let fname = (Core.fieldName field) +                      fterm = (Core.fieldTerm field)+                  in (Optionals.fromMaybe (notFound fname) (Maps.lookup fname (Maps.fromList [+                    (Core.Name "wrap", (forWrapped fterm)),+                    (Core.Name "record", (forProjection fterm)),+                    (Core.Name "union", (forCases fterm)),+                    (Core.Name "lambda", (forLambda fterm)),+                    (Core.Name "primitive", (forPrimitive fterm)),+                    (Core.Name "variable", (forVariable fterm))])))))))+    in (Flows.bind unionType (\ut -> Flows.bind (termAdapter ut) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = Compute.Coder {+        Compute.coderEncode = (encode ad),+        Compute.coderDecode = (decode ad)}}))))) t)++-- | Convert forall types to monotypes+lambdaToMonotype :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+lambdaToMonotype t = ((\x -> case x of+  Core.TypeForall v1 ->  +    let body = (Core.forallTypeBody v1)+    in (Flows.bind (termAdapter body) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = (Compute.adapterCoder ad)})))) t)++-- | Convert optional types to list types+optionalToList :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+optionalToList t = ((\x -> case x of+  Core.TypeOptional v1 -> (Flows.bind (termAdapter v1) (\ad ->  +    let encode = (\term -> (\x -> case x of+            Core.TermOptional v2 -> (Optionals.maybe (Flows.pure (Core.TermList [])) (\r -> Flows.bind (Compute.coderEncode (Compute.adapterCoder ad) r) (\encoded -> Flows.pure (Core.TermList [+              encoded]))) v2)) term) +        decode = (\term -> (\x -> case x of+                Core.TermList v2 -> (Flows.map (\x -> Core.TermOptional x) (Logic.ifElse (Lists.null v2) (Flows.pure Nothing) (Flows.bind (Compute.coderDecode (Compute.adapterCoder ad) (Lists.head v2)) (\decoded -> Flows.pure (Just decoded)))))) term)+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = False,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeList (Compute.adapterTarget ad)),+      Compute.adapterCoder = Compute.Coder {+        Compute.coderEncode = encode,+        Compute.coderDecode = decode}}))))) t)++-- | Pass through application types+passApplication :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passApplication t = ((\x -> case x of+  Core.TypeApplication v1 ->  +    let lhs = (Core.applicationTypeFunction v1) +        rhs = (Core.applicationTypeArgument v1)+    in (Flows.bind (termAdapter lhs) (\lhsAd -> Flows.bind (termAdapter rhs) (\rhsAd -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Logic.or (Compute.adapterIsLossy lhsAd) (Compute.adapterIsLossy rhsAd)),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeApplication (Core.ApplicationType {+        Core.applicationTypeFunction = (Compute.adapterTarget lhsAd),+        Core.applicationTypeArgument = (Compute.adapterTarget rhsAd)})),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Utils.encodeDecode dir (Compute.adapterCoder lhsAd) term))}))))) t)++-- | Pass through function types with adaptation+passFunction :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passFunction t = ((\x -> case x of+  Core.TypeFunction v1 ->  +    let dom = (Core.functionTypeDomain v1) +        cod = (Core.functionTypeCodomain v1)+    in (Flows.bind (termAdapter dom) (\domAd -> Flows.bind (termAdapter cod) (\codAd -> Flows.bind ((\x -> case x of+      Core.TypeUnion v2 -> (Flows.bind (Flows.mapList (\f -> Flows.bind (fieldAdapter (Core.FieldType {+        Core.fieldTypeName = (Core.fieldTypeName f),+        Core.fieldTypeType = (Core.TypeFunction (Core.FunctionType {+          Core.functionTypeDomain = (Core.fieldTypeType f),+          Core.functionTypeCodomain = cod}))})) (\ad -> Flows.pure (Core.fieldTypeName f, ad))) (Core.rowTypeFields v2)) (\pairs -> Flows.pure (Maps.fromList pairs)))+      _ -> (Flows.pure Maps.empty)) (Rewriting.deannotateType dom)) (\caseAds -> Flows.bind ((\x -> case x of+      Core.TypeOptional v2 -> (Flows.map Optionals.pure (termAdapter (Core.TypeFunction (Core.FunctionType {+        Core.functionTypeDomain = v2,+        Core.functionTypeCodomain = cod}))))+      _ -> (Flows.pure Nothing)) (Rewriting.deannotateType dom)) (\optionAd ->  +      let lossy = (Logic.or (Compute.adapterIsLossy codAd) (Lists.foldl Logic.or False (Lists.map (\pair -> Compute.adapterIsLossy (snd pair)) (Maps.toList caseAds)))) +          target = (Core.TypeFunction (Core.FunctionType {+                  Core.functionTypeDomain = (Compute.adapterTarget domAd),+                  Core.functionTypeCodomain = (Compute.adapterTarget codAd)}))+          getCoder = (\fname -> Optionals.maybe Utils.idCoder Compute.adapterCoder (Maps.lookup fname caseAds))+      in (Flows.pure (Compute.Adapter {+        Compute.adapterIsLossy = lossy,+        Compute.adapterSource = t,+        Compute.adapterTarget = target,+        Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+          Core.TermFunction v2 -> (Flows.map (\x -> Core.TermFunction x) ((\x -> case x of+            Core.FunctionElimination v3 -> (Flows.map (\x -> Core.FunctionElimination x) ((\x -> case x of+              Core.EliminationUnion v4 ->  +                let n = (Core.caseStatementTypeName v4) +                    def = (Core.caseStatementDefault v4)+                    cases = (Core.caseStatementCases v4)+                in (Flows.bind (Flows.mapList (\f -> Utils.encodeDecode dir (getCoder (Core.fieldName f)) f) cases) (\rcases -> Flows.bind (Optionals.maybe (Flows.pure Nothing) (\d -> Flows.map Optionals.pure (Utils.encodeDecode dir (Compute.adapterCoder codAd) d)) def) (\rdef -> Flows.pure (Core.EliminationUnion (Core.CaseStatement {+                  Core.caseStatementTypeName = n,+                  Core.caseStatementDefault = rdef,+                  Core.caseStatementCases = rcases})))))) v3))+            Core.FunctionLambda v3 ->  +              let var = (Core.lambdaParameter v3) +                  d = (Core.lambdaDomain v3)+                  body = (Core.lambdaBody v3)+              in (Flows.bind (Utils.encodeDecode dir (Compute.adapterCoder codAd) body) (\newBody -> Flows.pure (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = var,+                Core.lambdaDomain = d,+                Core.lambdaBody = newBody}))))+            Core.FunctionPrimitive v3 -> (Flows.pure (Core.FunctionPrimitive v3))) v2))+          _ -> (Flows.pure term)) (Rewriting.deannotateTerm term)))})))))))) t)++-- | Pass through forall types+passForall :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passForall t = ((\x -> case x of+  Core.TypeForall v1 ->  +    let v = (Core.forallTypeParameter v1) +        body = (Core.forallTypeBody v1)+    in (Flows.bind (termAdapter body) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeForall (Core.ForallType {+        Core.forallTypeParameter = v,+        Core.forallTypeBody = (Compute.adapterTarget ad)})),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Utils.encodeDecode dir (Compute.adapterCoder ad) term))})))) t)++-- | Pass through literal types with literal adaptation+passLiteral :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passLiteral t = ((\x -> case x of+  Core.TypeLiteral v1 -> (Flows.bind (Literals.literalAdapter v1) (\ad ->  +    let step = (Utils.bidirectional (\dir -> \term -> Flows.bind (withGraphContext (Core__.literal term)) (\l -> Flows.map (\x -> Core.TermLiteral x) (Utils.encodeDecode dir (Compute.adapterCoder ad) l))))+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = (Core.TypeLiteral (Compute.adapterSource ad)),+      Compute.adapterTarget = (Core.TypeLiteral (Compute.adapterTarget ad)),+      Compute.adapterCoder = step}))))) t)++-- | Pass through list types+passList :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passList t = ((\x -> case x of+  Core.TypeList v1 -> (Flows.bind (termAdapter v1) (\ad -> Flows.pure (Compute.Adapter {+    Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+    Compute.adapterSource = t,+    Compute.adapterTarget = (Core.TypeList (Compute.adapterTarget ad)),+    Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+      Core.TermList v2 -> (Flows.bind (Flows.mapList (Utils.encodeDecode dir (Compute.adapterCoder ad)) v2) (\newTerms -> Flows.pure (Core.TermList newTerms)))) term))})))) t)++-- | Pass through map types+passMap :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passMap t = ((\x -> case x of+  Core.TypeMap v1 ->  +    let kt = (Core.mapTypeKeys v1) +        vt = (Core.mapTypeValues v1)+    in (Flows.bind (termAdapter kt) (\kad -> Flows.bind (termAdapter vt) (\vad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Logic.or (Compute.adapterIsLossy kad) (Compute.adapterIsLossy vad)),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeMap (Core.MapType {+        Core.mapTypeKeys = (Compute.adapterTarget kad),+        Core.mapTypeValues = (Compute.adapterTarget vad)})),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+        Core.TermMap v2 -> (Flows.bind (Flows.mapList (\pair ->  +          let k = (fst pair) +              v = (snd pair)+          in (Flows.bind (Utils.encodeDecode dir (Compute.adapterCoder kad) k) (\newK -> Flows.bind (Utils.encodeDecode dir (Compute.adapterCoder vad) v) (\newV -> Flows.pure (newK, newV))))) (Maps.toList v2)) (\newPairs -> Flows.pure (Core.TermMap (Maps.fromList newPairs))))) term))}))))) t)++-- | Pass through optional types+passOptional :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passOptional t = ((\x -> case x of+  Core.TypeOptional v1 ->  +    let mapTerm = (\coder -> \dir -> \term -> Flows.bind (withGraphContext (Core__.optional Flows.pure term)) (\opt -> Flows.bind (Flows.mapOptional (Utils.encodeDecode dir coder) opt) (\newOpt -> Flows.pure (Core.TermOptional newOpt))))+    in (Flows.bind (termAdapter v1) (\adapter -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeOptional (Compute.adapterTarget adapter)),+      Compute.adapterCoder = (Utils.bidirectional (mapTerm (Compute.adapterCoder adapter)))})))) t)++-- | Pass through product types+passProduct :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passProduct t = ((\x -> case x of+  Core.TypeProduct v1 -> (Flows.bind (Flows.mapList termAdapter v1) (\ads ->  +    let lossy = (Lists.foldl Logic.or False (Lists.map Compute.adapterIsLossy ads))+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = lossy,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeProduct (Lists.map Compute.adapterTarget ads)),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+        Core.TermProduct v2 -> (Flows.bind (Flows.sequence (Lists.zipWith (\term -> \ad -> Utils.encodeDecode dir (Compute.adapterCoder ad) term) v2 ads)) (\newTuple -> Flows.pure (Core.TermProduct newTuple)))) term))}))))) t)++-- | Pass through record types+passRecord :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passRecord t = ((\x -> case x of+  Core.TypeRecord v1 -> (Flows.bind (Flows.mapList fieldAdapter (Core.rowTypeFields v1)) (\adapters ->  +    let lossy = (Lists.foldl Logic.or False (Lists.map Compute.adapterIsLossy adapters)) +        sfields_ = (Lists.map Compute.adapterTarget adapters)+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = lossy,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeRecord (Core.RowType {+        Core.rowTypeTypeName = (Core.rowTypeTypeName v1),+        Core.rowTypeFields = sfields_})),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+        Core.TermRecord v2 ->  +          let dfields = (Core.recordFields v2)+          in (Flows.bind (Flows.sequence (Lists.zipWith (\ad -> \f -> Utils.encodeDecode dir (Compute.adapterCoder ad) f) adapters dfields)) (\newFields -> Flows.pure (Core.TermRecord (Core.Record {+            Core.recordTypeName = (Core.rowTypeTypeName v1),+            Core.recordFields = newFields}))))) term))}))))) t)++-- | Pass through set types+passSet :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passSet t = ((\x -> case x of+  Core.TypeSet v1 -> (Flows.bind (termAdapter v1) (\ad -> Flows.pure (Compute.Adapter {+    Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+    Compute.adapterSource = t,+    Compute.adapterTarget = (Core.TypeSet (Compute.adapterTarget ad)),+    Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+      Core.TermSet v2 -> (Flows.bind (Flows.mapList (Utils.encodeDecode dir (Compute.adapterCoder ad)) (Sets.toList v2)) (\newTerms -> Flows.pure (Core.TermSet (Sets.fromList newTerms))))) term))})))) t)++-- | Pass through sum types+passSum :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passSum t = ((\x -> case x of+  Core.TypeSum v1 -> (Flows.bind (Flows.mapList termAdapter v1) (\ads ->  +    let lossy = (Lists.foldl Logic.or False (Lists.map Compute.adapterIsLossy ads))+    in (Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = lossy,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeSum (Lists.map Compute.adapterTarget ads)),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> (\x -> case x of+        Core.TermSum v2 ->  +          let i = (Core.sumIndex v2) +              n = (Core.sumSize v2)+              term = (Core.sumTerm v2)+          in (Flows.bind (Utils.encodeDecode dir (Compute.adapterCoder (Lists.at i ads)) term) (\newTerm -> Flows.pure (Core.TermSum (Core.Sum {+            Core.sumIndex = i,+            Core.sumSize = n,+            Core.sumTerm = newTerm}))))) term))}))))) t)++-- | Pass through union types+passUnion :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passUnion t = ((\x -> case x of+  Core.TypeUnion v1 ->  +    let sfields = (Core.rowTypeFields v1) +        tname = (Core.rowTypeTypeName v1)+        getAdapter = (\adaptersMap -> \f -> Optionals.maybe (Flows.fail (Strings.cat2 "no such field: " (Core.unName (Core.fieldName f)))) Flows.pure (Maps.lookup (Core.fieldName f) adaptersMap))+    in (Flows.bind (Flows.mapList (\f -> Flows.bind (fieldAdapter f) (\ad -> Flows.pure (Core.fieldTypeName f, ad))) sfields) (\adapters ->  +      let adaptersMap = (Maps.fromList adapters) +          lossy = (Lists.foldl Logic.or False (Lists.map (\pair -> Compute.adapterIsLossy (snd pair)) adapters))+          sfields_ = (Lists.map (\pair -> Compute.adapterTarget (snd pair)) adapters)+      in (Flows.pure (Compute.Adapter {+        Compute.adapterIsLossy = lossy,+        Compute.adapterSource = t,+        Compute.adapterTarget = (Core.TypeUnion (Core.RowType {+          Core.rowTypeTypeName = tname,+          Core.rowTypeFields = sfields_})),+        Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Flows.pure term))}))))) t)++passUnit :: (t0 -> Compute.Flow t1 (Compute.Adapter t2 t3 Core.Type Core.Type Core.Term Core.Term))+passUnit _ = (Flows.pure (Compute.Adapter {+  Compute.adapterIsLossy = False,+  Compute.adapterSource = Core.TypeUnit,+  Compute.adapterTarget = Core.TypeUnit,+  Compute.adapterCoder = Compute.Coder {+    Compute.coderEncode = (\_ -> Flows.pure Core.TermUnit),+    Compute.coderDecode = (\_ -> Flows.pure Core.TermUnit)}}))++-- | Pass through wrapped types+passWrapped :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+passWrapped t = ((\x -> case x of+  Core.TypeWrap v1 ->  +    let tname = (Core.wrappedTypeTypeName v1) +        ot = (Core.wrappedTypeObject v1)+        mapTerm = (\coder -> \dir -> \term -> Flows.bind (withGraphContext (Core__.wrap tname term)) (\unwrapped -> Flows.bind (Utils.encodeDecode dir coder unwrapped) (\newTerm -> Flows.pure (Core.TermWrap (Core.WrappedTerm {+                Core.wrappedTermTypeName = tname,+                Core.wrappedTermObject = newTerm})))))+    in (Flows.bind (termAdapter ot) (\adapter -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy adapter),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Core.TypeWrap (Core.WrappedType {+        Core.wrappedTypeTypeName = tname,+        Core.wrappedTypeObject = (Compute.adapterTarget adapter)})),+      Compute.adapterCoder = (Utils.bidirectional (mapTerm (Compute.adapterCoder adapter)))})))) t)++-- | Convert set types to list types+setToList :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+setToList t = ((\x -> case x of+  Core.TypeSet v1 ->  +    let encode = (\ad -> \term -> (\x -> case x of+            Core.TermSet v2 -> (Compute.coderEncode (Compute.adapterCoder ad) (Core.TermList (Sets.toList v2)))) term) +        decode = (\ad -> \term -> Flows.bind (Compute.coderDecode (Compute.adapterCoder ad) term) (\listTerm -> (\x -> case x of+                Core.TermList v2 -> (Flows.pure (Core.TermSet (Sets.fromList v2)))) listTerm))+    in (Flows.bind (termAdapter (Core.TypeList v1)) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = Compute.Coder {+        Compute.coderEncode = (encode ad),+        Compute.coderDecode = (decode ad)}})))) t)++-- | Simplify application types+simplifyApplication :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+simplifyApplication t = ((\x -> case x of+  Core.TypeApplication v1 ->  +    let lhs = (Core.applicationTypeFunction v1)+    in (Flows.bind (termAdapter lhs) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = False,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = (Utils.bidirectional (\dir -> \term -> Utils.encodeDecode dir (Compute.adapterCoder ad) term))})))) t)++-- | Create an adapter for any type+termAdapter :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+termAdapter typ =  +  let constraints = (\cx -> Coders.languageConstraints (Coders.adapterContextLanguage cx)) +      supported = (\cx -> Utils.typeIsSupported (constraints cx))+      variantIsSupported = (\cx -> \t -> Sets.member (Variants.typeVariant t) (Coders.languageConstraintsTypeVariants (constraints cx)))+      supportedAtTopLevel = (\cx -> \t -> Logic.and (variantIsSupported cx t) (Coders.languageConstraintsTypes (constraints cx) t))+      pass = (\t -> (\x -> case x of+              Mantle.TypeVariantApplication -> [+                passApplication]+              Mantle.TypeVariantForall -> [+                passForall]+              Mantle.TypeVariantFunction -> [+                passFunction]+              Mantle.TypeVariantList -> [+                passList]+              Mantle.TypeVariantLiteral -> [+                passLiteral]+              Mantle.TypeVariantMap -> [+                passMap]+              Mantle.TypeVariantOptional -> [+                passOptional,+                optionalToList]+              Mantle.TypeVariantProduct -> [+                passProduct]+              Mantle.TypeVariantRecord -> [+                passRecord]+              Mantle.TypeVariantSet -> [+                passSet]+              Mantle.TypeVariantSum -> [+                passSum]+              Mantle.TypeVariantUnion -> [+                passUnion]+              Mantle.TypeVariantUnit -> [+                passUnit]+              Mantle.TypeVariantWrap -> [+                passWrapped]) (Variants.typeVariant (Rewriting.deannotateType t)))+      trySubstitution = (\t -> (\x -> case x of+              Mantle.TypeVariantApplication -> [+                simplifyApplication]+              Mantle.TypeVariantFunction -> [+                functionToUnion]+              Mantle.TypeVariantForall -> [+                lambdaToMonotype]+              Mantle.TypeVariantOptional -> [+                optionalToList]+              Mantle.TypeVariantSet -> [+                setToList]+              Mantle.TypeVariantUnion -> [+                unionToRecord]+              Mantle.TypeVariantUnit -> [+                unitToRecord]+              Mantle.TypeVariantWrap -> [+                wrapToUnwrapped]) (Variants.typeVariant t))+      alts = (\cx -> \t -> Flows.mapList (\c -> c t) (Logic.ifElse (supportedAtTopLevel cx t) (pass t) (trySubstitution t)))+  in ((\x -> case x of+    Core.TypeAnnotated v1 -> (Flows.bind (termAdapter (Core.annotatedTypeSubject v1)) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = (Compute.adapterSource ad),+      Compute.adapterTarget = (Core.TypeAnnotated (Core.AnnotatedType {+        Core.annotatedTypeSubject = (Compute.adapterTarget ad),+        Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v1)})),+      Compute.adapterCoder = (Compute.adapterCoder ad)})))+    _ -> (Monads.withTrace (Strings.cat2 "adapter for " (Core_.type_ typ)) ((\x -> case x of+      Core.TypeVariable v1 -> (forTypeReference v1)+      _ -> (Flows.bind Monads.getState (\cx -> Utils.chooseAdapter (alts cx) (supported cx) Core___.type_ Core_.type_ typ))) typ))) typ)++-- | Convert union types to record types+unionToRecord :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+unionToRecord t = ((\x -> case x of+  Core.TypeUnion v1 ->  +    let nm = (Core.rowTypeTypeName v1) +        sfields = (Core.rowTypeFields v1)+        target = (Core.TypeRecord (unionTypeToRecordType v1))+        toRecordField = (\term -> \fn -> \f ->  +                let fn_ = (Core.fieldTypeName f)+                in Core.Field {+                  Core.fieldName = fn_,+                  Core.fieldTerm = (Core.TermOptional (Logic.ifElse (Equality.equal fn_ fn) (Just term) Nothing))})+        fromRecordFields = (\term -> \term_ -> \t_ -> \fields ->  +                let matches = (Optionals.mapMaybe (\field ->  +                        let fn = (Core.fieldName field) +                            fterm = (Core.fieldTerm field)+                        in ((\x -> case x of+                          Core.TermOptional v2 -> (Optionals.bind v2 (\t -> Just (Core.Field {+                            Core.fieldName = fn,+                            Core.fieldTerm = t})))) fterm)) fields)+                in (Logic.ifElse (Lists.null matches) (Flows.fail (Strings.cat [+                  "cannot convert term back to union: ",+                  Core___.term term,+                  " where type = ",+                  Core___.type_ t,+                  "    and target type = ",+                  (Core___.type_ t_)])) (Flows.pure (Lists.head matches))))+    in (Flows.bind (termAdapter target) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = (Compute.adapterIsLossy ad),+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = Compute.Coder {+        Compute.coderEncode = (\term_ -> Flows.bind (withGraphContext (Core__.injection (Core.rowTypeTypeName v1) term_)) (\field ->  +          let fn = (Core.fieldName field) +              term = (Core.fieldTerm field)+          in (Compute.coderEncode (Compute.adapterCoder ad) (Core.TermRecord (Core.Record {+            Core.recordTypeName = nm,+            Core.recordFields = (Lists.map (toRecordField term fn) sfields)}))))),+        Compute.coderDecode = (\term -> Flows.bind (Compute.coderDecode (Compute.adapterCoder ad) term) (\recTerm -> (\x -> case x of+          Core.TermRecord v2 ->  +            let fields = (Core.recordFields v2)+            in (Flows.bind (fromRecordFields term (Core.TermRecord (Core.Record {+              Core.recordTypeName = nm,+              Core.recordFields = fields})) (Compute.adapterTarget ad) fields) (\resultField -> Flows.pure (Core.TermUnion (Core.Injection {+              Core.injectionTypeName = nm,+              Core.injectionField = resultField}))))) recTerm))}})))) t)++-- | Convert a union row type to a record row type+unionTypeToRecordType :: (Core.RowType -> Core.RowType)+unionTypeToRecordType rt =  +  let makeOptional = (\f ->  +          let fn = (Core.fieldTypeName f) +              ft = (Core.fieldTypeType f)+          in Core.FieldType {+            Core.fieldTypeName = fn,+            Core.fieldTypeType = (Rewriting.mapBeneathTypeAnnotations (\x -> Core.TypeOptional x) ft)})+  in Core.RowType {+    Core.rowTypeTypeName = (Core.rowTypeTypeName rt),+    Core.rowTypeFields = (Lists.map makeOptional (Core.rowTypeFields rt))}++unitToRecord :: (t0 -> Compute.Flow t1 (Compute.Adapter t2 t3 Core.Type Core.Type Core.Term Core.Term))+unitToRecord _ = (Flows.pure (Compute.Adapter {+  Compute.adapterIsLossy = False,+  Compute.adapterSource = Core.TypeUnit,+  Compute.adapterTarget = (Core.TypeRecord (Core.RowType {+    Core.rowTypeTypeName = (Core.Name "_Unit"),+    Core.rowTypeFields = []})),+  Compute.adapterCoder = Compute.Coder {+    Compute.coderEncode = (\_ -> Flows.pure (Core.TermRecord (Core.Record {+      Core.recordTypeName = (Core.Name "_Unit"),+      Core.recordFields = []}))),+    Compute.coderDecode = (\_ -> Flows.pure Core.TermUnit)}}))++-- | Convert wrapped types to unwrapped types+wrapToUnwrapped :: (Core.Type -> Compute.Flow Coders.AdapterContext (Compute.Adapter Coders.AdapterContext Coders.AdapterContext Core.Type Core.Type Core.Term Core.Term))+wrapToUnwrapped t = ((\x -> case x of+  Core.TypeWrap v1 ->  +    let tname = (Core.wrappedTypeTypeName v1) +        typ = (Core.wrappedTypeObject v1)+        encode = (\ad -> \term -> Flows.bind (withGraphContext (Core__.wrap tname term)) (\unwrapped -> Compute.coderEncode (Compute.adapterCoder ad) unwrapped))+        decode = (\ad -> \term -> Flows.bind (Compute.coderDecode (Compute.adapterCoder ad) term) (\decoded -> Flows.pure (Core.TermWrap (Core.WrappedTerm {+                Core.wrappedTermTypeName = tname,+                Core.wrappedTermObject = decoded}))))+    in (Flows.bind (termAdapter typ) (\ad -> Flows.pure (Compute.Adapter {+      Compute.adapterIsLossy = False,+      Compute.adapterSource = t,+      Compute.adapterTarget = (Compute.adapterTarget ad),+      Compute.adapterCoder = Compute.Coder {+        Compute.coderEncode = (encode ad),+        Compute.coderDecode = (decode ad)}})))) t)++withGraphContext :: (Compute.Flow Graph.Graph t0 -> Compute.Flow Coders.AdapterContext t0)+withGraphContext f = (Flows.bind Monads.getState (\cx -> Monads.withState (Coders.adapterContextGraph cx) f))
+ src/gen-main/haskell/Hydra/Adapt/Utils.hs view
@@ -0,0 +1,132 @@+-- | Additional adapter utilities, above and beyond the generated ones.++module Hydra.Adapt.Utils where++import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Lib.Flows as Flows+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.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.Names as Names+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core_+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++bidirectional :: ((Coders.CoderDirection -> t0 -> Compute.Flow t1 t0) -> Compute.Coder t1 t1 t0 t0)+bidirectional f = Compute.Coder {+  Compute.coderEncode = (f Coders.CoderDirectionEncode),+  Compute.coderDecode = (f Coders.CoderDirectionDecode)}++chooseAdapter :: ((t0 -> Compute.Flow t1 [Compute.Adapter t2 t3 t0 t0 t4 t4]) -> (t0 -> Bool) -> (t0 -> String) -> (t0 -> String) -> t0 -> Compute.Flow t1 (Compute.Adapter t2 t3 t0 t0 t4 t4))+chooseAdapter alts supported show describe typ = (Logic.ifElse (supported typ) (Flows.pure (Compute.Adapter {+  Compute.adapterIsLossy = False,+  Compute.adapterSource = typ,+  Compute.adapterTarget = typ,+  Compute.adapterCoder = idCoder})) (Flows.bind (alts typ) (\raw ->  +  let candidates = (Lists.filter (\adapter -> supported (Compute.adapterTarget adapter)) raw)+  in (Logic.ifElse (Lists.null candidates) (Flows.fail (Strings.cat [+    "no adapters found for ",+    describe typ,+    Logic.ifElse (Lists.null raw) "" (Strings.cat [+      " (discarded ",+      Literals.showInt32 (Lists.length raw),+      " unsupported candidate types: ",+      Core_.list show (Lists.map Compute.adapterTarget raw),+      ")"]),+    ". Original type: ",+    (show typ)])) (Flows.pure (Lists.head candidates))))))++composeCoders :: (Compute.Coder t0 t1 t2 t3 -> Compute.Coder t0 t1 t3 t4 -> Compute.Coder t0 t1 t2 t4)+composeCoders c1 c2 = Compute.Coder {+  Compute.coderEncode = (\a -> Flows.bind (Compute.coderEncode c1 a) (Compute.coderEncode c2)),+  Compute.coderDecode = (\c -> Flows.bind (Compute.coderDecode c2 c) (Compute.coderDecode c1))}++encodeDecode :: (Coders.CoderDirection -> Compute.Coder t0 t0 t1 t1 -> t1 -> Compute.Flow t0 t1)+encodeDecode dir coder = ((\x -> case x of+  Coders.CoderDirectionEncode -> (Compute.coderEncode coder)+  Coders.CoderDirectionDecode -> (Compute.coderDecode coder)) dir)++-- | Check if float type is supported by language constraints+floatTypeIsSupported :: (Coders.LanguageConstraints -> Core.FloatType -> Bool)+floatTypeIsSupported constraints ft = (Sets.member ft (Coders.languageConstraintsFloatTypes constraints))++idAdapter :: (t0 -> Compute.Adapter t1 t2 t0 t0 t3 t3)+idAdapter t = Compute.Adapter {+  Compute.adapterIsLossy = False,+  Compute.adapterSource = t,+  Compute.adapterTarget = t,+  Compute.adapterCoder = idCoder}++idCoder :: (Compute.Coder t0 t1 t2 t2)+idCoder = Compute.Coder {+  Compute.coderEncode = Flows.pure,+  Compute.coderDecode = Flows.pure}++-- | Check if integer type is supported by language constraints+integerTypeIsSupported :: (Coders.LanguageConstraints -> Core.IntegerType -> Bool)+integerTypeIsSupported constraints it = (Sets.member it (Coders.languageConstraintsIntegerTypes constraints))++-- | Check if literal type is supported by language constraints+literalTypeIsSupported :: (Coders.LanguageConstraints -> Core.LiteralType -> Bool)+literalTypeIsSupported constraints lt = (Logic.and (Sets.member (Variants.literalTypeVariant lt) (Coders.languageConstraintsLiteralVariants constraints)) ((\x -> case x of+  Core.LiteralTypeFloat v1 -> (floatTypeIsSupported constraints v1)+  Core.LiteralTypeInteger v1 -> (integerTypeIsSupported constraints v1)+  _ -> True) lt))++-- | Convert a name to file path, given case conventions for namespaces and local names, and assuming '/' as the file path separator+nameToFilePath :: (Mantle.CaseConvention -> Mantle.CaseConvention -> Module.FileExtension -> Core.Name -> String)+nameToFilePath nsConv localConv ext name =  +  let qualName = (Names.qualifyName name) +      ns = (Module.qualifiedNameNamespace qualName)+      local = (Module.qualifiedNameLocal qualName)+      nsToFilePath = (\ns -> Strings.intercalate "/" (Lists.map (\part -> Formatting.convertCase Mantle.CaseConventionCamel nsConv part) (Strings.splitOn "." (Module.unNamespace ns))))+      prefix = (Optionals.maybe "" (\n -> Strings.cat2 (nsToFilePath n) "/") ns)+      suffix = (Formatting.convertCase Mantle.CaseConventionPascal localConv local)+  in (Strings.cat [+    prefix,+    suffix,+    ".",+    (Module.unFileExtension ext)])++-- | Check if type is supported by language constraints+typeIsSupported :: (Coders.LanguageConstraints -> Core.Type -> Bool)+typeIsSupported constraints t =  +  let base = (Rewriting.deannotateType t) +      isSupportedVariant = (\v -> Logic.or ((\x -> case x of+              Mantle.TypeVariantVariable -> True+              _ -> False) v) (Sets.member v (Coders.languageConstraintsTypeVariants constraints)))+  in (Logic.and (Coders.languageConstraintsTypes constraints base) (Logic.and (isSupportedVariant (Variants.typeVariant base)) ((\x -> case x of+    Core.TypeAnnotated v1 -> (typeIsSupported constraints (Core.annotatedTypeSubject v1))+    Core.TypeApplication v1 -> (Logic.and (typeIsSupported constraints (Core.applicationTypeFunction v1)) (typeIsSupported constraints (Core.applicationTypeArgument v1)))+    Core.TypeForall v1 -> (typeIsSupported constraints (Core.forallTypeBody v1))+    Core.TypeFunction v1 -> (Logic.and (typeIsSupported constraints (Core.functionTypeDomain v1)) (typeIsSupported constraints (Core.functionTypeCodomain v1)))+    Core.TypeList v1 -> (typeIsSupported constraints v1)+    Core.TypeLiteral v1 -> (literalTypeIsSupported constraints v1)+    Core.TypeMap v1 -> (Logic.and (typeIsSupported constraints (Core.mapTypeKeys v1)) (typeIsSupported constraints (Core.mapTypeValues v1)))+    Core.TypeOptional v1 -> (typeIsSupported constraints v1)+    Core.TypeProduct v1 -> (Lists.foldl Logic.and True (Lists.map (typeIsSupported constraints) v1))+    Core.TypeRecord v1 -> (Lists.foldl Logic.and True (Lists.map (\field -> typeIsSupported constraints (Core.fieldTypeType field)) (Core.rowTypeFields v1)))+    Core.TypeSet v1 -> (typeIsSupported constraints v1)+    Core.TypeSum v1 -> (Lists.foldl Logic.and True (Lists.map (typeIsSupported constraints) v1))+    Core.TypeUnion v1 -> (Lists.foldl Logic.and True (Lists.map (\field -> typeIsSupported constraints (Core.fieldTypeType field)) (Core.rowTypeFields v1)))+    Core.TypeUnit -> True+    Core.TypeWrap v1 -> (typeIsSupported constraints (Core.wrappedTypeObject v1))+    Core.TypeVariable _ -> True) base)))++unidirectionalCoder :: ((t0 -> Compute.Flow t1 t2) -> Compute.Coder t1 t3 t0 t2)+unidirectionalCoder m = Compute.Coder {+  Compute.coderEncode = m,+  Compute.coderDecode = (\_ -> Flows.fail "inbound mapping is unsupported")}
+ src/gen-main/haskell/Hydra/Annotations.hs view
@@ -0,0 +1,272 @@+-- | Utilities for reading and writing type and term annotations++module Hydra.Annotations where++import qualified Hydra.Compute as Compute+import qualified Hydra.Constants as Constants+import qualified Hydra.Core as Core+import qualified Hydra.Decode.Core as Core_+import qualified Hydra.Decoding as Decoding+import qualified Hydra.Encode.Core as Core__+import qualified Hydra.Extract.Core as Core___+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Math as Math+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.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core____+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++aggregateAnnotations :: (Ord t2) => ((t0 -> Maybe t1) -> (t1 -> t0) -> (t1 -> M.Map t2 t3) -> t0 -> M.Map t2 t3)+aggregateAnnotations getValue getX getAnns t =  +  let toPairs = (\rest -> \t -> Optionals.maybe rest (\yy -> toPairs (Lists.cons (Maps.toList (getAnns yy)) rest) (getX yy)) (getValue t))+  in (Maps.fromList (Lists.concat (toPairs [] t)))++debugIf :: (t0 -> String -> Compute.Flow t1 ())+debugIf debugId message =  +  let checkAndFail = (\desc -> Logic.ifElse (Equality.equal desc (Just "debugId")) (Flows.fail message) (Flows.pure ()))+  in (Flows.bind getDebugId checkAndFail)++failOnFlag :: (Core.Name -> String -> Compute.Flow t0 ())+failOnFlag flag msg = (Flows.bind (hasFlag flag) (\val -> Logic.ifElse val (Flows.fail msg) (Flows.pure ())))++getDebugId :: (Compute.Flow t0 (Maybe String))+getDebugId = (Lexical.withEmptyGraph (Flows.bind (getAttr Constants.key_debugId) (\desc -> Flows.mapOptional Core___.string desc)))++getAttr :: (Core.Name -> Compute.Flow t0 (Maybe Core.Term))+getAttr key = (Compute.Flow (\s0 -> \t0 -> Compute.FlowState {+  Compute.flowStateValue = (Just (Maps.lookup key (Compute.traceOther t0))),+  Compute.flowStateState = s0,+  Compute.flowStateTrace = t0}))++getAttrWithDefault :: (Core.Name -> Core.Term -> Compute.Flow t0 Core.Term)+getAttrWithDefault key def = (Flows.map (\mval -> Optionals.fromMaybe def mval) (getAttr key))++getCount :: (Core.Name -> Compute.Flow t0 Int)+getCount key = (Lexical.withEmptyGraph (Flows.bind (getAttrWithDefault key (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))) Core___.int32))++-- | Get description from annotations map+getDescription :: (M.Map Core.Name Core.Term -> Compute.Flow Graph.Graph (Maybe String))+getDescription anns = (Optionals.maybe (Flows.pure Nothing) (\term -> Flows.map Optionals.pure (Core___.string term)) (Maps.lookup (Core.Name "description") anns))++-- | Get a term annotation+getTermAnnotation :: (Core.Name -> Core.Term -> Maybe Core.Term)+getTermAnnotation key term = (Maps.lookup key (termAnnotationInternal term))++-- | Get term description+getTermDescription :: (Core.Term -> Compute.Flow Graph.Graph (Maybe String))+getTermDescription term = (getDescription (termAnnotationInternal term))++-- | Get type from annotations+getType :: (M.Map Core.Name Core.Term -> Compute.Flow Graph.Graph (Maybe Core.Type))+getType anns = (Optionals.maybe (Flows.pure Nothing) (\dat -> Flows.map Optionals.pure (Core_.type_ dat)) (Maps.lookup Constants.key_type anns))++-- | Get a type annotation+getTypeAnnotation :: (Core.Name -> Core.Type -> Maybe Core.Term)+getTypeAnnotation key typ = (Maps.lookup key (typeAnnotationInternal typ))++-- | Get type classes from term+getTypeClasses :: (Core.Term -> Compute.Flow Graph.Graph (M.Map Core.Name (S.Set Mantle.TypeClass)))+getTypeClasses term =  +  let decodeClass = (\term ->  +          let byName = (Maps.fromList [+                  (Core.Name "equality", Mantle.TypeClassEquality),+                  (Core.Name "ordering", Mantle.TypeClassOrdering)])+          in (Flows.bind (Core___.unitVariant (Core.Name "hydra.mantle.TypeClass") term) (\fn -> Optionals.maybe (Monads.unexpected "type class" (Core____.term term)) Flows.pure (Maps.lookup fn byName))))+  in (Optionals.maybe (Flows.pure Maps.empty) (\term -> Core___.map Core_.name (Core___.setOf decodeClass) term) (getTermAnnotation Constants.key_classes term))++-- | Get type description+getTypeDescription :: (Core.Type -> Compute.Flow Graph.Graph (Maybe String))+getTypeDescription typ = (getDescription (typeAnnotationInternal typ))++-- | For a typed term, decide whether a coder should encode it as a native type expression, or as a Hydra type expression.+isNativeType :: (Core.Binding -> Bool)+isNativeType el =  +  let isFlaggedAsFirstClassType = (Optionals.fromMaybe False (Optionals.bind (getTermAnnotation Constants.key_firstClassType (Core.bindingTerm el)) Decoding.boolean))+  in (Optionals.maybe False (\ts -> Logic.and (Equality.equal ts (Core.TypeScheme {+    Core.typeSchemeVariables = [],+    Core.typeSchemeType = (Core.TypeVariable (Core.Name "hydra.core.Type"))})) (Logic.not isFlaggedAsFirstClassType)) (Core.bindingType el))++hasDescription :: (M.Map Core.Name t0 -> Bool)+hasDescription anns = (Optionals.isJust (Maps.lookup Constants.key_description anns))++hasFlag :: (Core.Name -> Compute.Flow t0 Bool)+hasFlag flag = (Lexical.withEmptyGraph (Flows.bind (getAttrWithDefault flag (Core.TermLiteral (Core.LiteralBoolean False))) (\term -> Core___.boolean term)))++-- | Check if type has description+hasTypeDescription :: (Core.Type -> Bool)+hasTypeDescription typ = (hasDescription (typeAnnotationInternal typ))++nextCount :: (Core.Name -> Compute.Flow t0 Int)+nextCount key = (Flows.bind (getCount key) (\count -> Flows.map (\_ -> count) (putCount key (Math.add count 1))))++-- | Normalize term annotations+normalizeTermAnnotations :: (Core.Term -> Core.Term)+normalizeTermAnnotations term =  +  let anns = (termAnnotationInternal term) +      stripped = (Rewriting.deannotateTerm term)+  in (Logic.ifElse (Maps.null anns) stripped (Core.TermAnnotated (Core.AnnotatedTerm {+    Core.annotatedTermSubject = stripped,+    Core.annotatedTermAnnotation = anns})))++-- | Normalize type annotations+normalizeTypeAnnotations :: (Core.Type -> Core.Type)+normalizeTypeAnnotations typ =  +  let anns = (typeAnnotationInternal typ) +      stripped = (Rewriting.deannotateType typ)+  in (Logic.ifElse (Maps.null anns) stripped (Core.TypeAnnotated (Core.AnnotatedType {+    Core.annotatedTypeSubject = stripped,+    Core.annotatedTypeAnnotation = anns})))++putAttr :: (Core.Name -> Core.Term -> Compute.Flow t0 ())+putAttr key val = (Compute.Flow (\s0 -> \t0 -> Compute.FlowState {+  Compute.flowStateValue = (Just ()),+  Compute.flowStateState = s0,+  Compute.flowStateTrace = Compute.Trace {+    Compute.traceStack = (Compute.traceStack t0),+    Compute.traceMessages = (Compute.traceMessages t0),+    Compute.traceOther = (Maps.insert key val (Compute.traceOther t0))}}))++putCount :: (Core.Name -> Int -> Compute.Flow t0 ())+putCount key count = (putAttr key (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 count))))++resetCount :: (Core.Name -> Compute.Flow t0 ())+resetCount key = (putAttr key (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))))++setAnnotation :: (Ord t0) => (t0 -> Maybe t1 -> M.Map t0 t1 -> M.Map t0 t1)+setAnnotation key val m = (Maps.alter (\_ -> val) key m)++-- | Set description in annotations+setDescription :: (Maybe String -> M.Map Core.Name Core.Term -> M.Map Core.Name Core.Term)+setDescription d = (setAnnotation Constants.key_description (Optionals.map (\arg_ -> (\x -> Core.TermLiteral x) ((\x -> Core.LiteralString x) arg_)) d))++-- | Set term annotation+setTermAnnotation :: (Core.Name -> Maybe Core.Term -> Core.Term -> Core.Term)+setTermAnnotation key val term =  +  let term_ = (Rewriting.deannotateTerm term) +      anns = (setAnnotation key val (termAnnotationInternal term))+  in (Logic.ifElse (Maps.null anns) term_ (Core.TermAnnotated (Core.AnnotatedTerm {+    Core.annotatedTermSubject = term_,+    Core.annotatedTermAnnotation = anns})))++-- | Set term description+setTermDescription :: (Maybe String -> Core.Term -> Core.Term)+setTermDescription d = (setTermAnnotation Constants.key_description (Optionals.map (\s -> Core.TermLiteral (Core.LiteralString s)) d))++-- | Set type in annotations+setType :: (Maybe Core.Type -> M.Map Core.Name Core.Term -> M.Map Core.Name Core.Term)+setType mt = (setAnnotation Constants.key_type (Optionals.map Core__.type_ mt))++-- | Set type annotation+setTypeAnnotation :: (Core.Name -> Maybe Core.Term -> Core.Type -> Core.Type)+setTypeAnnotation key val typ =  +  let typ_ = (Rewriting.deannotateType typ) +      anns = (setAnnotation key val (typeAnnotationInternal typ))+  in (Logic.ifElse (Maps.null anns) typ_ (Core.TypeAnnotated (Core.AnnotatedType {+    Core.annotatedTypeSubject = typ_,+    Core.annotatedTypeAnnotation = anns})))++-- | Set type classes on term+setTypeClasses :: (M.Map Core.Name (S.Set Mantle.TypeClass) -> Core.Term -> Core.Term)+setTypeClasses m =  +  let encodeClass = (\tc -> (\x -> case x of+          Mantle.TypeClassEquality -> (Core.TermUnion (Core.Injection {+            Core.injectionTypeName = (Core.Name "hydra.mantle.TypeClass"),+            Core.injectionField = Core.Field {+              Core.fieldName = (Core.Name "equality"),+              Core.fieldTerm = Core.TermUnit}}))+          Mantle.TypeClassOrdering -> (Core.TermUnion (Core.Injection {+            Core.injectionTypeName = (Core.Name "hydra.mantle.TypeClass"),+            Core.injectionField = Core.Field {+              Core.fieldName = (Core.Name "ordering"),+              Core.fieldTerm = Core.TermUnit}}))) tc) +      encodePair = (\nameClasses ->  +              let name = (fst nameClasses) +                  classes = (snd nameClasses)+              in (Core__.name name, (Core.TermSet (Sets.fromList (Lists.map encodeClass (Sets.toList classes))))))+      encoded = (Logic.ifElse (Maps.null m) Nothing (Just (Core.TermMap (Maps.fromList (Lists.map encodePair (Maps.toList m))))))+  in (setTermAnnotation Constants.key_classes encoded)++-- | Set type description+setTypeDescription :: (Maybe String -> Core.Type -> Core.Type)+setTypeDescription d = (setTypeAnnotation Constants.key_description (Optionals.map (\arg_ -> (\x -> Core.TermLiteral x) ((\x -> Core.LiteralString x) arg_)) d))++-- | Get internal term annotations+termAnnotationInternal :: (Core.Term -> M.Map Core.Name Core.Term)+termAnnotationInternal = (aggregateAnnotations getAnn Core.annotatedTermSubject Core.annotatedTermAnnotation) +  where +    getAnn = (\t -> (\x -> case x of+      Core.TermAnnotated v1 -> (Just v1)+      _ -> Nothing) t)++-- | Get internal type annotations+typeAnnotationInternal :: (Core.Type -> M.Map Core.Name Core.Term)+typeAnnotationInternal = (aggregateAnnotations getAnn Core.annotatedTypeSubject Core.annotatedTypeAnnotation) +  where +    getAnn = (\t -> (\x -> case x of+      Core.TypeAnnotated v1 -> (Just v1)+      _ -> Nothing) t)++-- | Create a type element with proper annotations+typeElement :: (Core.Name -> Core.Type -> Core.Binding)+typeElement name typ =  +  let schemaTerm = (Core.TermVariable (Core.Name "hydra.core.Type")) +      dataTerm = (normalizeTermAnnotations (Core.TermAnnotated (Core.AnnotatedTerm {+              Core.annotatedTermSubject = (Core__.type_ typ),+              Core.annotatedTermAnnotation = (Maps.fromList [+                (Constants.key_type, schemaTerm)])})))+  in Core.Binding {+    Core.bindingName = name,+    Core.bindingTerm = dataTerm,+    Core.bindingType = (Just (Core.TypeScheme {+      Core.typeSchemeVariables = [],+      Core.typeSchemeType = typ}))}++whenFlag :: (Core.Name -> Compute.Flow t0 t1 -> Compute.Flow t0 t1 -> Compute.Flow t0 t1)+whenFlag flag fthen felse = (Flows.bind (hasFlag flag) (\b -> Logic.ifElse b fthen felse))++-- | Unshadow variables in term+unshadowVariables :: (Core.Term -> Core.Term)+unshadowVariables term =  +  let freshName = (Flows.map (\n -> Core.Name (Strings.cat2 "s" (Literals.showInt32 n))) (nextCount (Core.Name "unshadow"))) +      rewrite = (\recurse -> \term ->  +              let handleOther = (recurse term)+              in (Flows.bind Monads.getState (\state ->  +                let reserved = (fst state) +                    subst = (snd state)+                in ((\x -> case x of+                  Core.TermVariable v1 -> (Flows.pure (Core.TermVariable (Optionals.fromMaybe v1 (Maps.lookup v1 subst))))+                  Core.TermFunction v1 -> ((\x -> case x of+                    Core.FunctionLambda v2 ->  +                      let v = (Core.lambdaParameter v2) +                          d = (Core.lambdaDomain v2)+                          body = (Core.lambdaBody v2)+                      in (Logic.ifElse (Sets.member v reserved) (Flows.bind freshName (\v_ -> Flows.bind (Monads.putState (Sets.insert v_ reserved, (Maps.insert v v_ subst))) (\_ -> Flows.bind (recurse body) (\body_ -> Flows.bind (Monads.putState state) (\_ -> Flows.pure (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = v_,+                        Core.lambdaDomain = d,+                        Core.lambdaBody = body_})))))))) (Flows.bind (Monads.putState (Sets.insert v reserved, subst)) (\_ -> Flows.map (\body_ -> Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = v,+                        Core.lambdaDomain = d,+                        Core.lambdaBody = body_}))) (recurse body))))+                    _ -> handleOther) v1)+                  _ -> handleOther) term))))+  in (Optionals.fromJust (Compute.flowStateValue (Compute.unFlow (Rewriting.rewriteTermM rewrite term) (Sets.empty, Maps.empty) Monads.emptyTrace)))++withDepth :: (Core.Name -> (Int -> Compute.Flow t0 t1) -> Compute.Flow t0 t1)+withDepth key f = (Flows.bind (getCount key) (\count ->  +  let inc = (Math.add count 1)+  in (Flows.bind (putCount key inc) (\_ -> Flows.bind (f inc) (\r -> Flows.bind (putCount key count) (\_ -> Flows.pure r))))))
+ src/gen-main/haskell/Hydra/Arity.hs view
@@ -0,0 +1,47 @@+-- | Functions dealing with arguments and arity.++module Hydra.Arity where++import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Math as Math+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++functionArity :: (Core.Function -> Int)+functionArity x = case x of+  Core.FunctionElimination _ -> 1+  Core.FunctionLambda v1 -> ((\i -> Math.add 1 i) (termArity (Core.lambdaBody v1)))+  Core.FunctionPrimitive _ -> 42++-- | Find the arity (expected number of arguments) of a primitive constant or function+primitiveArity :: (Graph.Primitive -> Int)+primitiveArity arg_ = ((\arg_ -> typeArity (Core.typeSchemeType arg_)) (Graph.primitiveType arg_))++termArity :: (Core.Term -> Int)+termArity x = case x of+  Core.TermApplication v1 -> ((\arg_ -> (\xapp -> Math.sub xapp 1) (termArity arg_)) (Core.applicationFunction v1))+  Core.TermFunction v1 -> (functionArity v1)+  _ -> 0++typeArity :: (Core.Type -> Int)+typeArity x = case x of+  Core.TypeAnnotated v1 -> (typeArity (Core.annotatedTypeSubject v1))+  Core.TypeApplication v1 -> (typeArity (Core.applicationTypeFunction v1))+  Core.TypeForall v1 -> (typeArity (Core.forallTypeBody v1))+  Core.TypeFunction v1 -> (Math.add 1 (typeArity (Core.functionTypeCodomain v1)))+  _ -> 0++-- | Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)+uncurryType :: (Core.Type -> [Core.Type])+uncurryType t = ((\x -> case x of+  Core.TypeAnnotated v1 -> (uncurryType (Core.annotatedTypeSubject v1))+  Core.TypeApplication v1 -> (uncurryType (Core.applicationTypeFunction v1))+  Core.TypeForall v1 -> (uncurryType (Core.forallTypeBody v1))+  Core.TypeFunction v1 -> (Lists.cons (Core.functionTypeDomain v1) (uncurryType (Core.functionTypeCodomain v1)))+  _ -> [+    t]) t)
src/gen-main/haskell/Hydra/Ast.hs view
@@ -3,10 +3,11 @@ module Hydra.Ast where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | Operator associativity data Associativity = @@ -16,7 +17,7 @@   AssociativityBoth    deriving (Eq, Ord, Read, Show) -_Associativity = (Core.Name "hydra/ast.Associativity")+_Associativity = (Core.Name "hydra.ast.Associativity")  _Associativity_none = (Core.Name "none") @@ -34,7 +35,7 @@     blockStyleNewlineAfterContent :: Bool}   deriving (Eq, Ord, Read, Show) -_BlockStyle = (Core.Name "hydra/ast.BlockStyle")+_BlockStyle = (Core.Name "hydra.ast.BlockStyle")  _BlockStyle_indent = (Core.Name "indent") @@ -50,7 +51,7 @@     bracketExprStyle :: BlockStyle}   deriving (Eq, Ord, Read, Show) -_BracketExpr = (Core.Name "hydra/ast.BracketExpr")+_BracketExpr = (Core.Name "hydra.ast.BracketExpr")  _BracketExpr_brackets = (Core.Name "brackets") @@ -65,7 +66,7 @@     bracketsClose :: Symbol}   deriving (Eq, Ord, Read, Show) -_Brackets = (Core.Name "hydra/ast.Brackets")+_Brackets = (Core.Name "hydra.ast.Brackets")  _Brackets_open = (Core.Name "open") @@ -79,7 +80,7 @@   ExprBrackets BracketExpr   deriving (Eq, Ord, Read, Show) -_Expr = (Core.Name "hydra/ast.Expr")+_Expr = (Core.Name "hydra.ast.Expr")  _Expr_const = (Core.Name "const") @@ -96,7 +97,7 @@     indentedExpressionExpr :: Expr}   deriving (Eq, Ord, Read, Show) -_IndentedExpression = (Core.Name "hydra/ast.IndentedExpression")+_IndentedExpression = (Core.Name "hydra.ast.IndentedExpression")  _IndentedExpression_style = (Core.Name "style") @@ -108,7 +109,7 @@   IndentStyleSubsequentLines String   deriving (Eq, Ord, Read, Show) -_IndentStyle = (Core.Name "hydra/ast.IndentStyle")+_IndentStyle = (Core.Name "hydra.ast.IndentStyle")  _IndentStyle_allLines = (Core.Name "allLines") @@ -123,7 +124,7 @@     opAssociativity :: Associativity}   deriving (Eq, Ord, Read, Show) -_Op = (Core.Name "hydra/ast.Op")+_Op = (Core.Name "hydra.ast.Op")  _Op_symbol = (Core.Name "symbol") @@ -141,7 +142,7 @@     opExprRhs :: Expr}   deriving (Eq, Ord, Read, Show) -_OpExpr = (Core.Name "hydra/ast.OpExpr")+_OpExpr = (Core.Name "hydra.ast.OpExpr")  _OpExpr_op = (Core.Name "op") @@ -156,7 +157,7 @@     paddingRight :: Ws}   deriving (Eq, Ord, Read, Show) -_Padding = (Core.Name "hydra/ast.Padding")+_Padding = (Core.Name "hydra.ast.Padding")  _Padding_left = (Core.Name "left") @@ -168,7 +169,7 @@     unPrecedence :: Int}   deriving (Eq, Ord, Read, Show) -_Precedence = (Core.Name "hydra/ast.Precedence")+_Precedence = (Core.Name "hydra.ast.Precedence")  -- | Any symbol newtype Symbol = @@ -176,7 +177,7 @@     unSymbol :: String}   deriving (Eq, Ord, Read, Show) -_Symbol = (Core.Name "hydra/ast.Symbol")+_Symbol = (Core.Name "hydra.ast.Symbol")  -- | One of several classes of whitespace data Ws = @@ -187,7 +188,7 @@   WsDoubleBreak    deriving (Eq, Ord, Read, Show) -_Ws = (Core.Name "hydra/ast.Ws")+_Ws = (Core.Name "hydra.ast.Ws")  _Ws_none = (Core.Name "none")
− src/gen-main/haskell/Hydra/Basics.hs 
@@ -1,339 +0,0 @@--- | A tier-2 module of basic functions for working with types and terms.--module Hydra.Basics where--import qualified Hydra.Core as Core-import qualified Hydra.Graph as Graph-import qualified Hydra.Lib.Equality as Equality-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Logic as Logic-import qualified Hydra.Lib.Maps as Maps-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---- | Find the elimination variant (constructor) for a given elimination term-eliminationVariant :: (Core.Elimination -> Mantle.EliminationVariant)-eliminationVariant x = case x of-  Core.EliminationList _ -> Mantle.EliminationVariantList-  Core.EliminationOptional _ -> Mantle.EliminationVariantOptional-  Core.EliminationProduct _ -> Mantle.EliminationVariantProduct-  Core.EliminationRecord _ -> Mantle.EliminationVariantRecord-  Core.EliminationUnion _ -> Mantle.EliminationVariantUnion-  Core.EliminationWrap _ -> Mantle.EliminationVariantWrap---- | All elimination variants (constructors), in a canonical order-eliminationVariants :: [Mantle.EliminationVariant]-eliminationVariants = [-  Mantle.EliminationVariantList,-  Mantle.EliminationVariantWrap,-  Mantle.EliminationVariantOptional,-  Mantle.EliminationVariantProduct,-  Mantle.EliminationVariantRecord,-  Mantle.EliminationVariantUnion]---- | Find the precision of a given floating-point type-floatTypePrecision :: (Core.FloatType -> Mantle.Precision)-floatTypePrecision x = case x of-  Core.FloatTypeBigfloat -> Mantle.PrecisionArbitrary-  Core.FloatTypeFloat32 -> (Mantle.PrecisionBits 32)-  Core.FloatTypeFloat64 -> (Mantle.PrecisionBits 64)---- | All floating-point types in a canonical order-floatTypes :: [Core.FloatType]-floatTypes = [-  Core.FloatTypeBigfloat,-  Core.FloatTypeFloat32,-  Core.FloatTypeFloat64]---- | Find the float type for a given floating-point value-floatValueType :: (Core.FloatValue -> Core.FloatType)-floatValueType x = case x of-  Core.FloatValueBigfloat _ -> Core.FloatTypeBigfloat-  Core.FloatValueFloat32 _ -> Core.FloatTypeFloat32-  Core.FloatValueFloat64 _ -> Core.FloatTypeFloat64---- | Find the function variant (constructor) for a given function-functionVariant :: (Core.Function -> Mantle.FunctionVariant)-functionVariant x = case x of-  Core.FunctionElimination _ -> Mantle.FunctionVariantElimination-  Core.FunctionLambda _ -> Mantle.FunctionVariantLambda-  Core.FunctionPrimitive _ -> Mantle.FunctionVariantPrimitive---- | All function variants (constructors), in a canonical order-functionVariants :: [Mantle.FunctionVariant]-functionVariants = [-  Mantle.FunctionVariantElimination,-  Mantle.FunctionVariantLambda,-  Mantle.FunctionVariantPrimitive]---- | The identity function-id_ :: (a -> a)-id_ x = x---- | Find whether a given integer type is signed (true) or unsigned (false)-integerTypeIsSigned :: (Core.IntegerType -> Bool)-integerTypeIsSigned x = case x of-  Core.IntegerTypeBigint -> True-  Core.IntegerTypeInt8 -> True-  Core.IntegerTypeInt16 -> True-  Core.IntegerTypeInt32 -> True-  Core.IntegerTypeInt64 -> True-  Core.IntegerTypeUint8 -> False-  Core.IntegerTypeUint16 -> False-  Core.IntegerTypeUint32 -> False-  Core.IntegerTypeUint64 -> False---- | Find the precision of a given integer type-integerTypePrecision :: (Core.IntegerType -> Mantle.Precision)-integerTypePrecision x = case x of-  Core.IntegerTypeBigint -> Mantle.PrecisionArbitrary-  Core.IntegerTypeInt8 -> (Mantle.PrecisionBits 8)-  Core.IntegerTypeInt16 -> (Mantle.PrecisionBits 16)-  Core.IntegerTypeInt32 -> (Mantle.PrecisionBits 32)-  Core.IntegerTypeInt64 -> (Mantle.PrecisionBits 64)-  Core.IntegerTypeUint8 -> (Mantle.PrecisionBits 8)-  Core.IntegerTypeUint16 -> (Mantle.PrecisionBits 16)-  Core.IntegerTypeUint32 -> (Mantle.PrecisionBits 32)-  Core.IntegerTypeUint64 -> (Mantle.PrecisionBits 64)---- | All integer types, in a canonical order-integerTypes :: [Core.IntegerType]-integerTypes = [-  Core.IntegerTypeBigint,-  Core.IntegerTypeInt8,-  Core.IntegerTypeInt16,-  Core.IntegerTypeInt32,-  Core.IntegerTypeInt64,-  Core.IntegerTypeUint8,-  Core.IntegerTypeUint16,-  Core.IntegerTypeUint32,-  Core.IntegerTypeUint64]---- | Find the integer type for a given integer value-integerValueType :: (Core.IntegerValue -> Core.IntegerType)-integerValueType x = case x of-  Core.IntegerValueBigint _ -> Core.IntegerTypeBigint-  Core.IntegerValueInt8 _ -> Core.IntegerTypeInt8-  Core.IntegerValueInt16 _ -> Core.IntegerTypeInt16-  Core.IntegerValueInt32 _ -> Core.IntegerTypeInt32-  Core.IntegerValueInt64 _ -> Core.IntegerTypeInt64-  Core.IntegerValueUint8 _ -> Core.IntegerTypeUint8-  Core.IntegerValueUint16 _ -> Core.IntegerTypeUint16-  Core.IntegerValueUint32 _ -> Core.IntegerTypeUint32-  Core.IntegerValueUint64 _ -> Core.IntegerTypeUint64---- | Find the literal type for a given literal value-literalType :: (Core.Literal -> Core.LiteralType)-literalType x = case x of-  Core.LiteralBinary _ -> Core.LiteralTypeBinary-  Core.LiteralBoolean _ -> Core.LiteralTypeBoolean-  Core.LiteralFloat v228 -> ((\x2 -> Core.LiteralTypeFloat x2) (floatValueType v228))-  Core.LiteralInteger v229 -> ((\x2 -> Core.LiteralTypeInteger x2) (integerValueType v229))-  Core.LiteralString _ -> Core.LiteralTypeString---- | Find the literal type variant (constructor) for a given literal value-literalTypeVariant :: (Core.LiteralType -> Mantle.LiteralVariant)-literalTypeVariant x = case x of-  Core.LiteralTypeBinary -> Mantle.LiteralVariantBinary-  Core.LiteralTypeBoolean -> Mantle.LiteralVariantBoolean-  Core.LiteralTypeFloat _ -> Mantle.LiteralVariantFloat-  Core.LiteralTypeInteger _ -> Mantle.LiteralVariantInteger-  Core.LiteralTypeString -> Mantle.LiteralVariantString---- | Find the literal variant (constructor) for a given literal value-literalVariant :: (Core.Literal -> Mantle.LiteralVariant)-literalVariant x = (literalTypeVariant (literalType x))---- | All literal variants, in a canonical order-literalVariants :: [Mantle.LiteralVariant]-literalVariants = [-  Mantle.LiteralVariantBinary,-  Mantle.LiteralVariantBoolean,-  Mantle.LiteralVariantFloat,-  Mantle.LiteralVariantInteger,-  Mantle.LiteralVariantString]---- | Find the term variant (constructor) for a given term-termVariant :: (Core.Term -> Mantle.TermVariant)-termVariant x = case x of-  Core.TermAnnotated _ -> Mantle.TermVariantAnnotated-  Core.TermApplication _ -> Mantle.TermVariantApplication-  Core.TermFunction _ -> Mantle.TermVariantFunction-  Core.TermLet _ -> Mantle.TermVariantLet-  Core.TermList _ -> Mantle.TermVariantList-  Core.TermLiteral _ -> Mantle.TermVariantLiteral-  Core.TermMap _ -> Mantle.TermVariantMap-  Core.TermOptional _ -> Mantle.TermVariantOptional-  Core.TermProduct _ -> Mantle.TermVariantProduct-  Core.TermRecord _ -> Mantle.TermVariantRecord-  Core.TermSet _ -> Mantle.TermVariantSet-  Core.TermSum _ -> Mantle.TermVariantSum-  Core.TermTypeAbstraction _ -> Mantle.TermVariantTypeAbstraction-  Core.TermTypeApplication _ -> Mantle.TermVariantTypeApplication-  Core.TermTyped _ -> Mantle.TermVariantTyped-  Core.TermUnion _ -> Mantle.TermVariantUnion-  Core.TermVariable _ -> Mantle.TermVariantVariable-  Core.TermWrap _ -> Mantle.TermVariantWrap---- | All term (expression) variants, in a canonical order-termVariants :: [Mantle.TermVariant]-termVariants = [-  Mantle.TermVariantAnnotated,-  Mantle.TermVariantApplication,-  Mantle.TermVariantLiteral,-  Mantle.TermVariantFunction,-  Mantle.TermVariantList,-  Mantle.TermVariantMap,-  Mantle.TermVariantOptional,-  Mantle.TermVariantProduct,-  Mantle.TermVariantRecord,-  Mantle.TermVariantSet,-  Mantle.TermVariantSum,-  Mantle.TermVariantTypeAbstraction,-  Mantle.TermVariantTypeApplication,-  Mantle.TermVariantTyped,-  Mantle.TermVariantUnion,-  Mantle.TermVariantVariable,-  Mantle.TermVariantWrap]---- | Find the type variant (constructor) for a given type-typeVariant :: (Core.Type -> Mantle.TypeVariant)-typeVariant x = case x of-  Core.TypeAnnotated _ -> Mantle.TypeVariantAnnotated-  Core.TypeApplication _ -> Mantle.TypeVariantApplication-  Core.TypeFunction _ -> Mantle.TypeVariantFunction-  Core.TypeLambda _ -> Mantle.TypeVariantLambda-  Core.TypeList _ -> Mantle.TypeVariantList-  Core.TypeLiteral _ -> Mantle.TypeVariantLiteral-  Core.TypeMap _ -> Mantle.TypeVariantMap-  Core.TypeOptional _ -> Mantle.TypeVariantOptional-  Core.TypeProduct _ -> Mantle.TypeVariantProduct-  Core.TypeRecord _ -> Mantle.TypeVariantRecord-  Core.TypeSet _ -> Mantle.TypeVariantSet-  Core.TypeSum _ -> Mantle.TypeVariantSum-  Core.TypeUnion _ -> Mantle.TypeVariantUnion-  Core.TypeVariable _ -> Mantle.TypeVariantVariable-  Core.TypeWrap _ -> Mantle.TypeVariantWrap---- | All type variants, in a canonical order-typeVariants :: [Mantle.TypeVariant]-typeVariants = [-  Mantle.TypeVariantAnnotated,-  Mantle.TypeVariantApplication,-  Mantle.TypeVariantFunction,-  Mantle.TypeVariantLambda,-  Mantle.TypeVariantList,-  Mantle.TypeVariantLiteral,-  Mantle.TypeVariantMap,-  Mantle.TypeVariantWrap,-  Mantle.TypeVariantOptional,-  Mantle.TypeVariantProduct,-  Mantle.TypeVariantRecord,-  Mantle.TypeVariantSet,-  Mantle.TypeVariantSum,-  Mantle.TypeVariantUnion,-  Mantle.TypeVariantVariable]---- | Capitalize the first letter of a string-capitalize :: (String -> String)-capitalize = (mapFirstLetter Strings.toUpper)---- | Decapitalize the first letter of a string-decapitalize :: (String -> String)-decapitalize = (mapFirstLetter Strings.toLower)---- | A helper which maps the first letter of a string to another string-mapFirstLetter :: ((String -> String) -> String -> String)-mapFirstLetter mapping s =  -  let firstLetter = (mapping (Strings.fromList (Lists.pure (Lists.head list)))) -      list = (Strings.toList s)-  in (Logic.ifElse s (Strings.cat2 firstLetter (Strings.fromList (Lists.tail list))) (Strings.isEmpty s))--fieldMap :: ([Core.Field] -> Map Core.Name Core.Term)-fieldMap fields = (Maps.fromList (Lists.map toPair fields)) -  where -    toPair = (\f -> (Core.fieldName f, (Core.fieldTerm f)))--fieldTypeMap :: ([Core.FieldType] -> Map Core.Name Core.Type)-fieldTypeMap fields = (Maps.fromList (Lists.map toPair fields)) -  where -    toPair = (\f -> (Core.fieldTypeName f, (Core.fieldTypeType f)))--isEncodedType :: (Core.Term -> Bool)-isEncodedType t = ((\x -> case x of-  Core.TermApplication v269 -> (isEncodedType (Core.applicationFunction v269))-  Core.TermUnion v270 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.injectionTypeName v270)))-  _ -> False) (Strip.stripTerm t))--isType :: (Core.Type -> Bool)-isType t = ((\x -> case x of-  Core.TypeApplication v271 -> (isType (Core.applicationTypeFunction v271))-  Core.TypeLambda v272 -> (isType (Core.lambdaTypeBody v272))-  Core.TypeUnion v273 -> (Equality.equalString "hydra/core.Type" (Core.unName (Core.rowTypeTypeName v273)))-  _ -> False) (Strip.stripType t))--isUnitTerm :: (Core.Term -> Bool)-isUnitTerm t = (Equality.equalTerm (Strip.fullyStripTerm t) (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Unit"),-  Core.recordFields = []})))--isUnitType :: (Core.Type -> Bool)-isUnitType t = (Equality.equalType (Strip.stripType t) (Core.TypeRecord (Core.RowType {-  Core.rowTypeTypeName = (Core.Name "hydra/core.Unit"),-  Core.rowTypeFields = []})))--elementsToGraph :: (Graph.Graph -> Maybe Graph.Graph -> [Graph.Element] -> Graph.Graph)-elementsToGraph parent schema elements =  -  let toPair = (\el -> (Graph.elementName el, el))-  in Graph.Graph {-    Graph.graphElements = (Maps.fromList (Lists.map toPair elements)),-    Graph.graphEnvironment = (Graph.graphEnvironment parent),-    Graph.graphTypes = (Graph.graphTypes parent),-    Graph.graphBody = (Graph.graphBody parent),-    Graph.graphPrimitives = (Graph.graphPrimitives parent),-    Graph.graphSchema = schema}--localNameOfEager :: (Core.Name -> String)-localNameOfEager x = (Module.qualifiedNameLocal (qualifyNameEager x))--localNameOfLazy :: (Core.Name -> String)-localNameOfLazy x = (Module.qualifiedNameLocal (qualifyNameLazy x))--namespaceOfEager :: (Core.Name -> Maybe Module.Namespace)-namespaceOfEager x = (Module.qualifiedNameNamespace (qualifyNameEager x))--namespaceOfLazy :: (Core.Name -> Maybe Module.Namespace)-namespaceOfLazy x = (Module.qualifiedNameNamespace (qualifyNameLazy x))--namespaceToFilePath :: (Bool -> Module.FileExtension -> Module.Namespace -> String)-namespaceToFilePath caps ext ns =  -  let parts = (Lists.map (Logic.ifElse capitalize id_ caps) (Strings.splitOn "/" (Module.unNamespace ns)))-  in (Strings.cat [-    Strings.cat [-      Strings.intercalate "/" parts,-      "."],-    (Module.unFileExtension ext)])--qualifyNameEager :: (Core.Name -> Module.QualifiedName)-qualifyNameEager name =  -  let parts = (Strings.splitOn "." (Core.unName name))-  in (Logic.ifElse (Module.QualifiedName {-    Module.qualifiedNameNamespace = Nothing,-    Module.qualifiedNameLocal = (Core.unName name)}) (Module.QualifiedName {-    Module.qualifiedNameNamespace = (Just (Module.Namespace (Lists.head parts))),-    Module.qualifiedNameLocal = (Strings.intercalate "." (Lists.tail parts))}) (Equality.equalInt32 1 (Lists.length parts)))--qualifyNameLazy :: (Core.Name -> Module.QualifiedName)-qualifyNameLazy name =  -  let parts = (Lists.reverse (Strings.splitOn "." (Core.unName name)))-  in (Logic.ifElse (Module.QualifiedName {-    Module.qualifiedNameNamespace = Nothing,-    Module.qualifiedNameLocal = (Core.unName name)}) (Module.QualifiedName {-    Module.qualifiedNameNamespace = (Just (Module.Namespace (Strings.intercalate "." (Lists.reverse (Lists.tail parts))))),-    Module.qualifiedNameLocal = (Lists.head parts)}) (Equality.equalInt32 1 (Lists.length parts)))
src/gen-main/haskell/Hydra/Coders.hs view
@@ -6,19 +6,20 @@ import qualified Hydra.Core as Core import qualified Hydra.Graph as Graph import qualified Hydra.Mantle as Mantle-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | An evaluation context together with a source language and a target language data AdapterContext =    AdapterContext {     adapterContextGraph :: Graph.Graph,     adapterContextLanguage :: Language,-    adapterContextAdapters :: (Map Core.Name (Compute.Adapter AdapterContext AdapterContext Core.Type Core.Type Core.Term Core.Term))}+    adapterContextAdapters :: (M.Map Core.Name (Compute.Adapter AdapterContext AdapterContext Core.Type Core.Type Core.Term Core.Term))} -_AdapterContext = (Core.Name "hydra/coders.AdapterContext")+_AdapterContext = (Core.Name "hydra.coders.AdapterContext")  _AdapterContext_graph = (Core.Name "graph") @@ -32,7 +33,7 @@   CoderDirectionDecode    deriving (Eq, Ord, Read, Show) -_CoderDirection = (Core.Name "hydra/coders.CoderDirection")+_CoderDirection = (Core.Name "hydra.coders.CoderDirection")  _CoderDirection_encode = (Core.Name "encode") @@ -44,7 +45,7 @@     languageName :: LanguageName,     languageConstraints :: LanguageConstraints} -_Language = (Core.Name "hydra/coders.Language")+_Language = (Core.Name "hydra.coders.Language")  _Language_name = (Core.Name "name") @@ -54,23 +55,23 @@ data LanguageConstraints =    LanguageConstraints {     -- | All supported elimination variants-    languageConstraintsEliminationVariants :: (Set Mantle.EliminationVariant),+    languageConstraintsEliminationVariants :: (S.Set Mantle.EliminationVariant),     -- | All supported literal variants-    languageConstraintsLiteralVariants :: (Set Mantle.LiteralVariant),+    languageConstraintsLiteralVariants :: (S.Set Mantle.LiteralVariant),     -- | All supported float types-    languageConstraintsFloatTypes :: (Set Core.FloatType),+    languageConstraintsFloatTypes :: (S.Set Core.FloatType),     -- | All supported function variants-    languageConstraintsFunctionVariants :: (Set Mantle.FunctionVariant),+    languageConstraintsFunctionVariants :: (S.Set Mantle.FunctionVariant),     -- | All supported integer types-    languageConstraintsIntegerTypes :: (Set Core.IntegerType),+    languageConstraintsIntegerTypes :: (S.Set Core.IntegerType),     -- | All supported term variants-    languageConstraintsTermVariants :: (Set Mantle.TermVariant),+    languageConstraintsTermVariants :: (S.Set Mantle.TermVariant),     -- | All supported type variants-    languageConstraintsTypeVariants :: (Set Mantle.TypeVariant),+    languageConstraintsTypeVariants :: (S.Set Mantle.TypeVariant),     -- | A logical set of types, as a predicate which tests a type for inclusion     languageConstraintsTypes :: (Core.Type -> Bool)} -_LanguageConstraints = (Core.Name "hydra/coders.LanguageConstraints")+_LanguageConstraints = (Core.Name "hydra.coders.LanguageConstraints")  _LanguageConstraints_eliminationVariants = (Core.Name "eliminationVariants") @@ -94,8 +95,13 @@     unLanguageName :: String}   deriving (Eq, Ord, Read, Show) -_LanguageName = (Core.Name "hydra/coders.LanguageName")+_LanguageName = (Core.Name "hydra.coders.LanguageName") +-- | A bidirectional encoder which maps between the same type and term languages on either side+type SymmetricAdapter s t v = (Compute.Adapter s s t t v v)++_SymmetricAdapter = (Core.Name "hydra.coders.SymmetricAdapter")+ -- | Specifies either a pre-order or post-order traversal data TraversalOrder =    -- | Pre-order traversal@@ -104,8 +110,13 @@   TraversalOrderPost    deriving (Eq, Ord, Read, Show) -_TraversalOrder = (Core.Name "hydra/coders.TraversalOrder")+_TraversalOrder = (Core.Name "hydra.coders.TraversalOrder")  _TraversalOrder_pre = (Core.Name "pre")  _TraversalOrder_post = (Core.Name "post")++-- | A function which maps a Hydra type to a symmetric adapter between types and terms+type TypeAdapter = (Core.Type -> Compute.Flow AdapterContext (SymmetricAdapter AdapterContext Core.Type Core.Term))++_TypeAdapter = (Core.Name "hydra.coders.TypeAdapter")
src/gen-main/haskell/Hydra/Compute.hs view
@@ -3,10 +3,11 @@ module Hydra.Compute where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A two-level bidirectional encoder which adapts types to types and terms to terms data Adapter s1 s2 t1 t2 v1 v2 = @@ -16,7 +17,7 @@     adapterTarget :: t2,     adapterCoder :: (Coder s1 s2 v1 v2)} -_Adapter = (Core.Name "hydra/compute.Adapter")+_Adapter = (Core.Name "hydra.compute.Adapter")  _Adapter_isLossy = (Core.Name "isLossy") @@ -32,7 +33,7 @@     bicoderEncode :: (t1 -> Adapter s1 s2 t1 t2 v1 v2),     bicoderDecode :: (t2 -> Adapter s2 s1 t2 t1 v2 v1)} -_Bicoder = (Core.Name "hydra/compute.Bicoder")+_Bicoder = (Core.Name "hydra.compute.Bicoder")  _Bicoder_encode = (Core.Name "encode") @@ -44,28 +45,28 @@     coderEncode :: (v1 -> Flow s1 v2),     coderDecode :: (v2 -> Flow s2 v1)} -_Coder = (Core.Name "hydra/compute.Coder")+_Coder = (Core.Name "hydra.compute.Coder")  _Coder_encode = (Core.Name "encode")  _Coder_decode = (Core.Name "decode")  -- | A variant of the State monad with built-in logging and error handling-newtype Flow s x = +newtype Flow s v =    Flow {-    unFlow :: (s -> Trace -> FlowState s x)}+    unFlow :: (s -> Trace -> FlowState s v)} -_Flow = (Core.Name "hydra/compute.Flow")+_Flow = (Core.Name "hydra.compute.Flow")  -- | The result of evaluating a Flow-data FlowState s x = +data FlowState s v =    FlowState {-    flowStateValue :: (Maybe x),+    flowStateValue :: (Maybe v),     flowStateState :: s,     flowStateTrace :: Trace}   deriving (Eq, Ord, Read, Show) -_FlowState = (Core.Name "hydra/compute.FlowState")+_FlowState = (Core.Name "hydra.compute.FlowState")  _FlowState_value = (Core.Name "value") @@ -79,10 +80,10 @@     traceStack :: [String],     traceMessages :: [String],     -- | A map of string keys to arbitrary terms as values, for application-specific use-    traceOther :: (Map Core.Name Core.Term)}+    traceOther :: (M.Map Core.Name Core.Term)}   deriving (Eq, Ord, Read, Show) -_Trace = (Core.Name "hydra/compute.Trace")+_Trace = (Core.Name "hydra.compute.Trace")  _Trace_stack = (Core.Name "stack")
src/gen-main/haskell/Hydra/Constants.hs view
@@ -3,17 +3,57 @@ module Hydra.Constants where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  ignoredVariable :: String ignoredVariable = "_" +key_classes :: Core.Name+key_classes = (Core.Name "classes")++key_debugId :: Core.Name+key_debugId = (Core.Name "debugId")++key_deprecated :: Core.Name+key_deprecated = (Core.Name "deprecated")++key_description :: Core.Name+key_description = (Core.Name "description")++key_exclude :: Core.Name+key_exclude = (Core.Name "exclude")++-- | A flag which tells the language coders to encode a given encoded type as a term rather than a native type+key_firstClassType :: Core.Name+key_firstClassType = (Core.Name "firstClassType")++key_maxLength :: Core.Name+key_maxLength = (Core.Name "maxLength")++key_minLength :: Core.Name+key_minLength = (Core.Name "minLength")++key_preserveFieldName :: Core.Name+key_preserveFieldName = (Core.Name "preserveFieldName")++key_type :: Core.Name+key_type = (Core.Name "type")++-- | The maximum value of a 32-bit integer+maxInt32 :: Int+maxInt32 = 9223372036854775807+ -- | A placeholder name for row types as they are being constructed placeholderName :: Core.Name placeholderName = (Core.Name "Placeholder") +-- | A maximum depth for nested flows. Currently, this is set very high because deep flows are common in type inference over the Hydra kernel. maxTraceDepth :: Int-maxTraceDepth = 50+maxTraceDepth = 4000++warningAutoGeneratedFile :: String+warningAutoGeneratedFile = "Note: this is an automatically generated file. Do not edit."
src/gen-main/haskell/Hydra/Constraints.hs view
@@ -4,10 +4,11 @@  import qualified Hydra.Core as Core import qualified Hydra.Query as Query-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A declared equivalence between two abstract paths in a graph data PathEquation = @@ -16,7 +17,7 @@     pathEquationRight :: Query.Path}   deriving (Eq, Ord, Read, Show) -_PathEquation = (Core.Name "hydra/constraints.PathEquation")+_PathEquation = (Core.Name "hydra.constraints.PathEquation")  _PathEquation_left = (Core.Name "left") @@ -29,7 +30,7 @@     patternImplicationConsequent :: Query.Pattern}   deriving (Eq, Ord, Read, Show) -_PatternImplication = (Core.Name "hydra/constraints.PatternImplication")+_PatternImplication = (Core.Name "hydra.constraints.PatternImplication")  _PatternImplication_antecedent = (Core.Name "antecedent")
src/gen-main/haskell/Hydra/Core.hs view
@@ -1,20 +1,21 @@--- | Hydra's core data model, defining types, terms, and their dependencies+-- | Hydra's core data model, consisting of the fundamental hydra.core.Term type and all of its dependencies.  module Hydra.Core where -import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A term together with an annotation data AnnotatedTerm =    AnnotatedTerm {     annotatedTermSubject :: Term,-    annotatedTermAnnotation :: (Map Name Term)}+    annotatedTermAnnotation :: (M.Map Name Term)}   deriving (Eq, Ord, Read, Show) -_AnnotatedTerm = (Name "hydra/core.AnnotatedTerm")+_AnnotatedTerm = (Name "hydra.core.AnnotatedTerm")  _AnnotatedTerm_subject = (Name "subject") @@ -24,10 +25,10 @@ data AnnotatedType =    AnnotatedType {     annotatedTypeSubject :: Type,-    annotatedTypeAnnotation :: (Map Name Term)}+    annotatedTypeAnnotation :: (M.Map Name Term)}   deriving (Eq, Ord, Read, Show) -_AnnotatedType = (Name "hydra/core.AnnotatedType")+_AnnotatedType = (Name "hydra.core.AnnotatedType")  _AnnotatedType_subject = (Name "subject") @@ -42,7 +43,7 @@     applicationArgument :: Term}   deriving (Eq, Ord, Read, Show) -_Application = (Name "hydra/core.Application")+_Application = (Name "hydra.core.Application")  _Application_function = (Name "function") @@ -57,7 +58,7 @@     applicationTypeArgument :: Type}   deriving (Eq, Ord, Read, Show) -_ApplicationType = (Name "hydra/core.ApplicationType")+_ApplicationType = (Name "hydra.core.ApplicationType")  _ApplicationType_function = (Name "function") @@ -71,7 +72,7 @@     caseStatementCases :: [Field]}   deriving (Eq, Ord, Read, Show) -_CaseStatement = (Name "hydra/core.CaseStatement")+_CaseStatement = (Name "hydra.core.CaseStatement")  _CaseStatement_typeName = (Name "typeName") @@ -81,10 +82,6 @@  -- | A corresponding elimination for an introduction term data Elimination = -  -- | Eliminates a list using a fold function; this function has the signature b -> [a] -> b-  EliminationList Term |-  -- | Eliminates an optional term by matching over the two possible cases-  EliminationOptional OptionalCases |   -- | Eliminates a tuple by projecting the component at a given 0-indexed offset   EliminationProduct TupleProjection |   -- | Eliminates a record by projecting a given field@@ -95,11 +92,7 @@   EliminationWrap Name   deriving (Eq, Ord, Read, Show) -_Elimination = (Name "hydra/core.Elimination")--_Elimination_list = (Name "list")--_Elimination_optional = (Name "optional")+_Elimination = (Name "hydra.core.Elimination")  _Elimination_product = (Name "product") @@ -116,7 +109,7 @@     fieldTerm :: Term}   deriving (Eq, Ord, Read, Show) -_Field = (Name "hydra/core.Field")+_Field = (Name "hydra.core.Field")  _Field_name = (Name "name") @@ -129,7 +122,7 @@     fieldTypeType :: Type}   deriving (Eq, Ord, Read, Show) -_FieldType = (Name "hydra/core.FieldType")+_FieldType = (Name "hydra.core.FieldType")  _FieldType_name = (Name "name") @@ -142,7 +135,7 @@   FloatTypeFloat64    deriving (Eq, Ord, Read, Show) -_FloatType = (Name "hydra/core.FloatType")+_FloatType = (Name "hydra.core.FloatType")  _FloatType_bigfloat = (Name "bigfloat") @@ -160,7 +153,7 @@   FloatValueFloat64 Double   deriving (Eq, Ord, Read, Show) -_FloatValue = (Name "hydra/core.FloatValue")+_FloatValue = (Name "hydra.core.FloatValue")  _FloatValue_bigfloat = (Name "bigfloat") @@ -168,6 +161,21 @@  _FloatValue_float64 = (Name "float64") +-- | A universally quantified type; the System F equivalent of a type scheme, and the type-level equivalent of a lambda term.+data ForallType = +  ForallType {+    -- | The variable which is bound by the lambda+    forallTypeParameter :: Name,+    -- | The body of the lambda+    forallTypeBody :: Type}+  deriving (Eq, Ord, Read, Show)++_ForallType = (Name "hydra.core.ForallType")++_ForallType_parameter = (Name "parameter")++_ForallType_body = (Name "body")+ -- | A function data Function =    -- | An elimination for any of a few term variants@@ -178,7 +186,7 @@   FunctionPrimitive Name   deriving (Eq, Ord, Read, Show) -_Function = (Name "hydra/core.Function")+_Function = (Name "hydra.core.Function")  _Function_elimination = (Name "elimination") @@ -193,7 +201,7 @@     functionTypeCodomain :: Type}   deriving (Eq, Ord, Read, Show) -_FunctionType = (Name "hydra/core.FunctionType")+_FunctionType = (Name "hydra.core.FunctionType")  _FunctionType_domain = (Name "domain") @@ -206,7 +214,7 @@     injectionField :: Field}   deriving (Eq, Ord, Read, Show) -_Injection = (Name "hydra/core.Injection")+_Injection = (Name "hydra.core.Injection")  _Injection_typeName = (Name "typeName") @@ -225,7 +233,7 @@   IntegerTypeUint64    deriving (Eq, Ord, Read, Show) -_IntegerType = (Name "hydra/core.IntegerType")+_IntegerType = (Name "hydra.core.IntegerType")  _IntegerType_bigint = (Name "bigint") @@ -250,24 +258,24 @@   -- | An arbitrary-precision integer value   IntegerValueBigint Integer |   -- | An 8-bit signed integer value-  IntegerValueInt8 Int8 |+  IntegerValueInt8 I.Int8 |   -- | A 16-bit signed integer value (short value)-  IntegerValueInt16 Int16 |+  IntegerValueInt16 I.Int16 |   -- | A 32-bit signed integer value (int value)   IntegerValueInt32 Int |   -- | A 64-bit signed integer value (long value)-  IntegerValueInt64 Int64 |+  IntegerValueInt64 I.Int64 |   -- | An 8-bit unsigned integer value (byte)-  IntegerValueUint8 Int16 |+  IntegerValueUint8 I.Int16 |   -- | A 16-bit unsigned integer value   IntegerValueUint16 Int |   -- | A 32-bit unsigned integer value (unsigned int)-  IntegerValueUint32 Int64 |+  IntegerValueUint32 I.Int64 |   -- | A 64-bit unsigned integer value (unsigned long)   IntegerValueUint64 Integer   deriving (Eq, Ord, Read, Show) -_IntegerValue = (Name "hydra/core.IntegerValue")+_IntegerValue = (Name "hydra.core.IntegerValue")  _IntegerValue_bigint = (Name "bigint") @@ -298,7 +306,7 @@     lambdaBody :: Term}   deriving (Eq, Ord, Read, Show) -_Lambda = (Name "hydra/core.Lambda")+_Lambda = (Name "hydra.core.Lambda")  _Lambda_parameter = (Name "parameter") @@ -306,49 +314,34 @@  _Lambda_body = (Name "body") --- | A type abstraction; the type-level analog of a lambda term-data LambdaType = -  LambdaType {-    -- | The variable which is bound by the lambda-    lambdaTypeParameter :: Name,-    -- | The body of the lambda-    lambdaTypeBody :: Type}-  deriving (Eq, Ord, Read, Show)--_LambdaType = (Name "hydra/core.LambdaType")--_LambdaType_parameter = (Name "parameter")--_LambdaType_body = (Name "body")- -- | A set of (possibly recursive) 'let' bindings together with an environment in which they are bound data Let =    Let {-    letBindings :: [LetBinding],+    letBindings :: [Binding],     letEnvironment :: Term}   deriving (Eq, Ord, Read, Show) -_Let = (Name "hydra/core.Let")+_Let = (Name "hydra.core.Let")  _Let_bindings = (Name "bindings")  _Let_environment = (Name "environment")  -- | A field with an optional type scheme, used to bind variables to terms in a 'let' expression-data LetBinding = -  LetBinding {-    letBindingName :: Name,-    letBindingTerm :: Term,-    letBindingType :: (Maybe TypeScheme)}+data Binding = +  Binding {+    bindingName :: Name,+    bindingTerm :: Term,+    bindingType :: (Maybe TypeScheme)}   deriving (Eq, Ord, Read, Show) -_LetBinding = (Name "hydra/core.LetBinding")+_Binding = (Name "hydra.core.Binding") -_LetBinding_name = (Name "name")+_Binding_name = (Name "name") -_LetBinding_term = (Name "term")+_Binding_term = (Name "term") -_LetBinding_type = (Name "type")+_Binding_type = (Name "type")  -- | A term constant; an instance of a literal type data Literal = @@ -364,7 +357,7 @@   LiteralString String   deriving (Eq, Ord, Read, Show) -_Literal = (Name "hydra/core.Literal")+_Literal = (Name "hydra.core.Literal")  _Literal_binary = (Name "binary") @@ -378,14 +371,19 @@  -- | Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants data LiteralType = +  -- | The type of a binary (byte string) value   LiteralTypeBinary  |+  -- | The type of a boolean (true/false) value   LiteralTypeBoolean  |+  -- | The type of a floating-point value   LiteralTypeFloat FloatType |+  -- | The type of an integer value   LiteralTypeInteger IntegerType |+  -- | The type of a string value   LiteralTypeString    deriving (Eq, Ord, Read, Show) -_LiteralType = (Name "hydra/core.LiteralType")+_LiteralType = (Name "hydra.core.LiteralType")  _LiteralType_binary = (Name "binary") @@ -404,7 +402,7 @@     mapTypeValues :: Type}   deriving (Eq, Ord, Read, Show) -_MapType = (Name "hydra/core.MapType")+_MapType = (Name "hydra.core.MapType")  _MapType_keys = (Name "keys") @@ -416,48 +414,7 @@     unName :: String}   deriving (Eq, Ord, Read, Show) -_Name = (Name "hydra/core.Name")---- | A term wrapped in a type name-data WrappedTerm = -  WrappedTerm {-    wrappedTermTypeName :: Name,-    wrappedTermObject :: Term}-  deriving (Eq, Ord, Read, Show)--_WrappedTerm = (Name "hydra/core.WrappedTerm")--_WrappedTerm_typeName = (Name "typeName")--_WrappedTerm_object = (Name "object")---- | A type wrapped in a type name-data WrappedType = -  WrappedType {-    wrappedTypeTypeName :: Name,-    wrappedTypeObject :: Type}-  deriving (Eq, Ord, Read, Show)--_WrappedType = (Name "hydra/core.WrappedType")--_WrappedType_typeName = (Name "typeName")--_WrappedType_object = (Name "object")---- | A case statement for matching optional terms-data OptionalCases = -  OptionalCases {-    -- | A term provided if the optional value is nothing-    optionalCasesNothing :: Term,-    -- | A function which is applied if the optional value is non-nothing-    optionalCasesJust :: Term}-  deriving (Eq, Ord, Read, Show)--_OptionalCases = (Name "hydra/core.OptionalCases")--_OptionalCases_nothing = (Name "nothing")--_OptionalCases_just = (Name "just")+_Name = (Name "hydra.core.Name")  -- | A record elimination; a projection data Projection = @@ -468,7 +425,7 @@     projectionField :: Name}   deriving (Eq, Ord, Read, Show) -_Projection = (Name "hydra/core.Projection")+_Projection = (Name "hydra.core.Projection")  _Projection_typeName = (Name "typeName") @@ -481,7 +438,7 @@     recordFields :: [Field]}   deriving (Eq, Ord, Read, Show) -_Record = (Name "hydra/core.Record")+_Record = (Name "hydra.core.Record")  _Record_typeName = (Name "typeName") @@ -496,7 +453,7 @@     rowTypeFields :: [FieldType]}   deriving (Eq, Ord, Read, Show) -_RowType = (Name "hydra/core.RowType")+_RowType = (Name "hydra.core.RowType")  _RowType_typeName = (Name "typeName") @@ -510,7 +467,7 @@     sumTerm :: Term}   deriving (Eq, Ord, Read, Show) -_Sum = (Name "hydra/core.Sum")+_Sum = (Name "hydra.core.Sum")  _Sum_index = (Name "index") @@ -526,13 +483,14 @@   TermApplication Application |   -- | A function term   TermFunction Function |+  -- | A 'let' term, which binds variables to terms   TermLet Let |   -- | A list   TermList [Term] |   -- | A literal value   TermLiteral Literal |   -- | A map of keys to values-  TermMap (Map Term Term) |+  TermMap (M.Map Term Term) |   -- | An optional value   TermOptional (Maybe Term) |   -- | A tuple@@ -540,23 +498,24 @@   -- | A record term   TermRecord Record |   -- | A set of values-  TermSet (Set Term) |+  TermSet (S.Set Term) |   -- | A variant tuple   TermSum Sum |-  -- | A System F type abstraction term-  TermTypeAbstraction TypeAbstraction |   -- | A System F type application term   TermTypeApplication TypedTerm |-  -- | A term annotated with its type-  TermTyped TypedTerm |+  -- | A System F type abstraction term+  TermTypeLambda TypeLambda |   -- | An injection; an instance of a union type   TermUnion Injection |+  -- | A unit value; a term with no value+  TermUnit  |   -- | A variable reference   TermVariable Name |+  -- | A wrapped term; an instance of a wrapper type (newtype)   TermWrap WrappedTerm   deriving (Eq, Ord, Read, Show) -_Term = (Name "hydra/core.Term")+_Term = (Name "hydra.core.Term")  _Term_annotated = (Name "annotated") @@ -582,14 +541,14 @@  _Term_sum = (Name "sum") -_Term_typeAbstraction = (Name "typeAbstraction")- _Term_typeApplication = (Name "typeApplication") -_Term_typed = (Name "typed")+_Term_typeLambda = (Name "typeLambda")  _Term_union = (Name "union") +_Term_unit = (Name "unit")+ _Term_variable = (Name "variable")  _Term_wrap = (Name "wrap")@@ -600,21 +559,25 @@     -- | The arity of the tuple     tupleProjectionArity :: Int,     -- | The 0-indexed offset from the beginning of the tuple-    tupleProjectionIndex :: Int}+    tupleProjectionIndex :: Int,+    -- | An optional domain for the projection; this is a list of component types+    tupleProjectionDomain :: (Maybe [Type])}   deriving (Eq, Ord, Read, Show) -_TupleProjection = (Name "hydra/core.TupleProjection")+_TupleProjection = (Name "hydra.core.TupleProjection")  _TupleProjection_arity = (Name "arity")  _TupleProjection_index = (Name "index") +_TupleProjection_domain = (Name "domain")+ -- | A data type data Type =    TypeAnnotated AnnotatedType |   TypeApplication ApplicationType |+  TypeForall ForallType |   TypeFunction FunctionType |-  TypeLambda LambdaType |   TypeList Type |   TypeLiteral LiteralType |   TypeMap MapType |@@ -624,19 +587,20 @@   TypeSet Type |   TypeSum [Type] |   TypeUnion RowType |+  TypeUnit  |   TypeVariable Name |   TypeWrap WrappedType   deriving (Eq, Ord, Read, Show) -_Type = (Name "hydra/core.Type")+_Type = (Name "hydra.core.Type")  _Type_annotated = (Name "annotated")  _Type_application = (Name "application") -_Type_function = (Name "function")+_Type_forall = (Name "forall") -_Type_lambda = (Name "lambda")+_Type_function = (Name "function")  _Type_list = (Name "list") @@ -656,25 +620,40 @@  _Type_union = (Name "union") +_Type_unit = (Name "unit")+ _Type_variable = (Name "variable")  _Type_wrap = (Name "wrap")  -- | A System F type abstraction term-data TypeAbstraction = -  TypeAbstraction {+data TypeLambda = +  TypeLambda {     -- | The type variable introduced by the abstraction-    typeAbstractionParameter :: Name,+    typeLambdaParameter :: Name,     -- | The body of the abstraction-    typeAbstractionBody :: Term}+    typeLambdaBody :: Term}   deriving (Eq, Ord, Read, Show) -_TypeAbstraction = (Name "hydra/core.TypeAbstraction")+_TypeLambda = (Name "hydra.core.TypeLambda") -_TypeAbstraction_parameter = (Name "parameter")+_TypeLambda_parameter = (Name "parameter") -_TypeAbstraction_body = (Name "body")+_TypeLambda_body = (Name "body") +-- | A term applied to a type; a type application+data TypedTerm = +  TypedTerm {+    typedTermTerm :: Term,+    typedTermType :: Type}+  deriving (Eq, Ord, Read, Show)++_TypedTerm = (Name "hydra.core.TypedTerm")++_TypedTerm_term = (Name "term")++_TypedTerm_type = (Name "type")+ -- | A type expression together with free type variables occurring in the expression data TypeScheme =    TypeScheme {@@ -682,28 +661,34 @@     typeSchemeType :: Type}   deriving (Eq, Ord, Read, Show) -_TypeScheme = (Name "hydra/core.TypeScheme")+_TypeScheme = (Name "hydra.core.TypeScheme")  _TypeScheme_variables = (Name "variables")  _TypeScheme_type = (Name "type") --- | A term together with its type-data TypedTerm = -  TypedTerm {-    typedTermTerm :: Term,-    typedTermType :: Type}+-- | A term wrapped in a type name+data WrappedTerm = +  WrappedTerm {+    wrappedTermTypeName :: Name,+    wrappedTermObject :: Term}   deriving (Eq, Ord, Read, Show) -_TypedTerm = (Name "hydra/core.TypedTerm")+_WrappedTerm = (Name "hydra.core.WrappedTerm") -_TypedTerm_term = (Name "term")+_WrappedTerm_typeName = (Name "typeName") -_TypedTerm_type = (Name "type")+_WrappedTerm_object = (Name "object") --- | An empty record as a canonical unit value-data Unit = -  Unit {}+-- | A type wrapped in a type name; a newtype+data WrappedType = +  WrappedType {+    wrappedTypeTypeName :: Name,+    wrappedTypeObject :: Type}   deriving (Eq, Ord, Read, Show) -_Unit = (Name "hydra/core.Unit")+_WrappedType = (Name "hydra.core.WrappedType")++_WrappedType_typeName = (Name "typeName")++_WrappedType_object = (Name "object")
− src/gen-main/haskell/Hydra/CoreEncoding.hs 
@@ -1,728 +0,0 @@--- | Mapping of hydra/core constructs in a host language like Haskell or Java  to their native Hydra counterparts as terms.  This includes an implementation of LambdaGraph's epsilon encoding (types to terms).--module Hydra.CoreEncoding where--import qualified Hydra.Core as Core-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Optionals as Optionals-import qualified Hydra.Lib.Sets as Sets-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--coreEncodeAnnotatedTerm :: (Core.AnnotatedTerm -> Core.Term)-coreEncodeAnnotatedTerm a = (Core.TermAnnotated (Core.AnnotatedTerm {-  Core.annotatedTermSubject = (coreEncodeTerm (Core.annotatedTermSubject a)),-  Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation a)}))--coreEncodeAnnotatedType :: (Core.AnnotatedType -> Core.Term)-coreEncodeAnnotatedType at = (Core.TermAnnotated (Core.AnnotatedTerm {-  Core.annotatedTermSubject = (coreEncodeType (Core.annotatedTypeSubject at)),-  Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation at)}))--coreEncodeApplication :: (Core.Application -> Core.Term)-coreEncodeApplication app = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Application"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "function"),-      Core.fieldTerm = (coreEncodeTerm (Core.applicationFunction app))},-    Core.Field {-      Core.fieldName = (Core.Name "argument"),-      Core.fieldTerm = (coreEncodeTerm (Core.applicationArgument app))}]}))--coreEncodeApplicationType :: (Core.ApplicationType -> Core.Term)-coreEncodeApplicationType at = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.ApplicationType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "function"),-      Core.fieldTerm = (coreEncodeType (Core.applicationTypeFunction at))},-    Core.Field {-      Core.fieldName = (Core.Name "argument"),-      Core.fieldTerm = (coreEncodeType (Core.applicationTypeArgument at))}]}))--coreEncodeCaseStatement :: (Core.CaseStatement -> Core.Term)-coreEncodeCaseStatement cs = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.CaseStatement"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.caseStatementTypeName cs))},-    Core.Field {-      Core.fieldName = (Core.Name "default"),-      Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTerm (Core.caseStatementDefault cs)))},-    Core.Field {-      Core.fieldName = (Core.Name "cases"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeField (Core.caseStatementCases cs)))}]}))--coreEncodeElimination :: (Core.Elimination -> Core.Term)-coreEncodeElimination x = case x of-  Core.EliminationList v0 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "list"),-      Core.fieldTerm = (coreEncodeTerm v0)}}))-  Core.EliminationOptional v1 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "optional"),-      Core.fieldTerm = (coreEncodeOptionalCases v1)}}))-  Core.EliminationProduct v2 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "product"),-      Core.fieldTerm = (coreEncodeTupleProjection v2)}}))-  Core.EliminationRecord v3 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "record"),-      Core.fieldTerm = (coreEncodeProjection v3)}}))-  Core.EliminationUnion v4 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "union"),-      Core.fieldTerm = (coreEncodeCaseStatement v4)}}))-  Core.EliminationWrap v5 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Elimination"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "wrap"),-      Core.fieldTerm = (coreEncodeName v5)}}))--coreEncodeField :: (Core.Field -> Core.Term)-coreEncodeField f = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Field"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "name"),-      Core.fieldTerm = (Core.TermWrap (Core.WrappedTerm {-        Core.wrappedTermTypeName = (Core.Name "hydra/core.Name"),-        Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName (Core.fieldName f))))}))},-    Core.Field {-      Core.fieldName = (Core.Name "term"),-      Core.fieldTerm = (coreEncodeTerm (Core.fieldTerm f))}]}))--coreEncodeFieldType :: (Core.FieldType -> Core.Term)-coreEncodeFieldType ft = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.FieldType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "name"),-      Core.fieldTerm = (coreEncodeName (Core.fieldTypeName ft))},-    Core.Field {-      Core.fieldName = (Core.Name "type"),-      Core.fieldTerm = (coreEncodeType (Core.fieldTypeType ft))}]}))--coreEncodeFloatType :: (Core.FloatType -> Core.Term)-coreEncodeFloatType x = case x of-  Core.FloatTypeBigfloat -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "bigfloat"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.FloatTypeFloat32 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float32"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.FloatTypeFloat64 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float64"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))--coreEncodeFloatValue :: (Core.FloatValue -> Core.Term)-coreEncodeFloatValue x = case x of-  Core.FloatValueBigfloat v9 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "bigfloat"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueBigfloat v9)))}}))-  Core.FloatValueFloat32 v10 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float32"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 v10)))}}))-  Core.FloatValueFloat64 v11 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.FloatValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float64"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v11)))}}))--coreEncodeFunction :: (Core.Function -> Core.Term)-coreEncodeFunction x = case x of-  Core.FunctionElimination v12 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Function"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "elimination"),-      Core.fieldTerm = (coreEncodeElimination v12)}}))-  Core.FunctionLambda v13 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Function"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "lambda"),-      Core.fieldTerm = (coreEncodeLambda v13)}}))-  Core.FunctionPrimitive v14 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Function"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "primitive"),-      Core.fieldTerm = (coreEncodeName v14)}}))--coreEncodeFunctionType :: (Core.FunctionType -> Core.Term)-coreEncodeFunctionType ft = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.FunctionType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "domain"),-      Core.fieldTerm = (coreEncodeType (Core.functionTypeDomain ft))},-    Core.Field {-      Core.fieldName = (Core.Name "codomain"),-      Core.fieldTerm = (coreEncodeType (Core.functionTypeCodomain ft))}]}))--coreEncodeInjection :: (Core.Injection -> Core.Term)-coreEncodeInjection i = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Injection"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.injectionTypeName i))},-    Core.Field {-      Core.fieldName = (Core.Name "field"),-      Core.fieldTerm = (coreEncodeField (Core.injectionField i))}]}))--coreEncodeIntegerType :: (Core.IntegerType -> Core.Term)-coreEncodeIntegerType x = case x of-  Core.IntegerTypeBigint -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "bigint"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeInt8 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int8"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeInt16 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int16"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeInt32 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int32"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeInt64 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int64"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeUint8 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint8"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeUint16 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint16"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeUint32 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint32"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.IntegerTypeUint64 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint64"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))--coreEncodeIntegerValue :: (Core.IntegerValue -> Core.Term)-coreEncodeIntegerValue x = case x of-  Core.IntegerValueBigint v24 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "bigint"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueBigint v24)))}}))-  Core.IntegerValueInt8 v25 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int8"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt8 v25)))}}))-  Core.IntegerValueInt16 v26 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int16"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt16 v26)))}}))-  Core.IntegerValueInt32 v27 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int32"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v27)))}}))-  Core.IntegerValueInt64 v28 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "int64"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 v28)))}}))-  Core.IntegerValueUint8 v29 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint8"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint8 v29)))}}))-  Core.IntegerValueUint16 v30 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint16"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint16 v30)))}}))-  Core.IntegerValueUint32 v31 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint32"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 v31)))}}))-  Core.IntegerValueUint64 v32 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.IntegerValue"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "uint64"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 v32)))}}))--coreEncodeLambda :: (Core.Lambda -> Core.Term)-coreEncodeLambda l = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Lambda"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "parameter"),-      Core.fieldTerm = (coreEncodeName (Core.lambdaParameter l))},-    Core.Field {-      Core.fieldName = (Core.Name "domain"),-      Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeType (Core.lambdaDomain l)))},-    Core.Field {-      Core.fieldName = (Core.Name "body"),-      Core.fieldTerm = (coreEncodeTerm (Core.lambdaBody l))}]}))--coreEncodeLambdaType :: (Core.LambdaType -> Core.Term)-coreEncodeLambdaType lt = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.LambdaType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "parameter"),-      Core.fieldTerm = (coreEncodeName (Core.lambdaTypeParameter lt))},-    Core.Field {-      Core.fieldName = (Core.Name "body"),-      Core.fieldTerm = (coreEncodeType (Core.lambdaTypeBody lt))}]}))--coreEncodeLet :: (Core.Let -> Core.Term)-coreEncodeLet l = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Let"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "bindings"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeLetBinding (Core.letBindings l)))},-    Core.Field {-      Core.fieldName = (Core.Name "environment"),-      Core.fieldTerm = (coreEncodeTerm (Core.letEnvironment l))}]}))--coreEncodeLetBinding :: (Core.LetBinding -> Core.Term)-coreEncodeLetBinding b = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.LetBinding"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "name"),-      Core.fieldTerm = (coreEncodeName (Core.letBindingName b))},-    Core.Field {-      Core.fieldName = (Core.Name "term"),-      Core.fieldTerm = (coreEncodeTerm (Core.letBindingTerm b))},-    Core.Field {-      Core.fieldName = (Core.Name "type"),-      Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTypeScheme (Core.letBindingType b)))}]}))--coreEncodeLiteral :: (Core.Literal -> Core.Term)-coreEncodeLiteral x = case x of-  Core.LiteralBinary v33 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Literal"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "binary"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralBinary v33))}}))-  Core.LiteralBoolean v34 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Literal"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "boolean"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralBoolean v34))}}))-  Core.LiteralFloat v35 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Literal"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float"),-      Core.fieldTerm = (coreEncodeFloatValue v35)}}))-  Core.LiteralInteger v36 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Literal"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "integer"),-      Core.fieldTerm = (coreEncodeIntegerValue v36)}}))-  Core.LiteralString v37 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Literal"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "string"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v37))}}))--coreEncodeLiteralType :: (Core.LiteralType -> Core.Term)-coreEncodeLiteralType x = case x of-  Core.LiteralTypeBinary -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "binary"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.LiteralTypeBoolean -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "boolean"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))-  Core.LiteralTypeFloat v40 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "float"),-      Core.fieldTerm = (coreEncodeFloatType v40)}}))-  Core.LiteralTypeInteger v41 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "integer"),-      Core.fieldTerm = (coreEncodeIntegerType v41)}}))-  Core.LiteralTypeString -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.LiteralType"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "string"),-      Core.fieldTerm = (Core.TermRecord (Core.Record {-        Core.recordTypeName = (Core.Name "hydra/core.Unit"),-        Core.recordFields = []}))}}))--coreEncodeMapType :: (Core.MapType -> Core.Term)-coreEncodeMapType mt = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.MapType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "keys"),-      Core.fieldTerm = (coreEncodeType (Core.mapTypeKeys mt))},-    Core.Field {-      Core.fieldName = (Core.Name "values"),-      Core.fieldTerm = (coreEncodeType (Core.mapTypeValues mt))}]}))--coreEncodeName :: (Core.Name -> Core.Term)-coreEncodeName fn = (Core.TermWrap (Core.WrappedTerm {-  Core.wrappedTermTypeName = (Core.Name "hydra/core.Name"),-  Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName fn)))}))--coreEncodeOptionalCases :: (Core.OptionalCases -> Core.Term)-coreEncodeOptionalCases oc = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.OptionalCases"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "nothing"),-      Core.fieldTerm = (coreEncodeTerm (Core.optionalCasesNothing oc))},-    Core.Field {-      Core.fieldName = (Core.Name "just"),-      Core.fieldTerm = (coreEncodeTerm (Core.optionalCasesJust oc))}]}))--coreEncodeProjection :: (Core.Projection -> Core.Term)-coreEncodeProjection p = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Projection"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.projectionTypeName p))},-    Core.Field {-      Core.fieldName = (Core.Name "field"),-      Core.fieldTerm = (coreEncodeName (Core.projectionField p))}]}))--coreEncodeRecord :: (Core.Record -> Core.Term)-coreEncodeRecord r = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Record"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.recordTypeName r))},-    Core.Field {-      Core.fieldName = (Core.Name "fields"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeField (Core.recordFields r)))}]}))--coreEncodeRowType :: (Core.RowType -> Core.Term)-coreEncodeRowType rt = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.RowType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.rowTypeTypeName rt))},-    Core.Field {-      Core.fieldName = (Core.Name "fields"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeFieldType (Core.rowTypeFields rt)))}]}))--coreEncodeSum :: (Core.Sum -> Core.Term)-coreEncodeSum s = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.Sum"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "index"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumIndex s))))},-    Core.Field {-      Core.fieldName = (Core.Name "size"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumSize s))))},-    Core.Field {-      Core.fieldName = (Core.Name "term"),-      Core.fieldTerm = (coreEncodeTerm (Core.sumTerm s))}]}))--coreEncodeTerm :: (Core.Term -> Core.Term)-coreEncodeTerm x = case x of-  Core.TermAnnotated v43 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "annotated"),-      Core.fieldTerm = (coreEncodeAnnotatedTerm v43)}}))-  Core.TermApplication v44 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "application"),-      Core.fieldTerm = (coreEncodeApplication v44)}}))-  Core.TermFunction v45 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "function"),-      Core.fieldTerm = (coreEncodeFunction v45)}}))-  Core.TermLet v46 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "let"),-      Core.fieldTerm = (coreEncodeLet v46)}}))-  Core.TermLiteral v47 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "literal"),-      Core.fieldTerm = (coreEncodeLiteral v47)}}))-  Core.TermList v48 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "list"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeTerm v48))}}))-  Core.TermOptional v49 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "optional"),-      Core.fieldTerm = (Core.TermOptional (Optionals.map coreEncodeTerm v49))}}))-  Core.TermProduct v50 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "product"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeTerm v50))}}))-  Core.TermRecord v51 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "record"),-      Core.fieldTerm = (coreEncodeRecord v51)}}))-  Core.TermSet v52 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "set"),-      Core.fieldTerm = (Core.TermSet (Sets.map coreEncodeTerm v52))}}))-  Core.TermSum v53 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "sum"),-      Core.fieldTerm = (coreEncodeSum v53)}}))-  Core.TermTypeAbstraction v54 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "typeAbstraction"),-      Core.fieldTerm = (coreEncodeTypeAbstraction v54)}}))-  Core.TermTypeApplication v55 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "typeApplication"),-      Core.fieldTerm = (coreEncodeTypedTerm v55)}}))-  Core.TermTyped v56 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "typed"),-      Core.fieldTerm = (coreEncodeTypedTerm v56)}}))-  Core.TermUnion v57 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "union"),-      Core.fieldTerm = (coreEncodeInjection v57)}}))-  Core.TermVariable v58 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "variable"),-      Core.fieldTerm = (coreEncodeName v58)}}))-  Core.TermWrap v59 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Term"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "wrap"),-      Core.fieldTerm = (coreEncodeWrappedTerm v59)}}))-  _ -> (Core.TermLiteral (Core.LiteralString "not implemented"))--coreEncodeTupleProjection :: (Core.TupleProjection -> Core.Term)-coreEncodeTupleProjection tp = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.TupleProjection"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "arity"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionArity tp))))},-    Core.Field {-      Core.fieldName = (Core.Name "index"),-      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionIndex tp))))}]}))--coreEncodeType :: (Core.Type -> Core.Term)-coreEncodeType x = case x of-  Core.TypeAnnotated v60 -> (Core.TermAnnotated (Core.AnnotatedTerm {-    Core.annotatedTermSubject = (coreEncodeType (Core.annotatedTypeSubject v60)),-    Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation v60)}))-  Core.TypeApplication v61 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "application"),-      Core.fieldTerm = (coreEncodeApplicationType v61)}}))-  Core.TypeFunction v62 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "function"),-      Core.fieldTerm = (coreEncodeFunctionType v62)}}))-  Core.TypeLambda v63 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "lambda"),-      Core.fieldTerm = (coreEncodeLambdaType v63)}}))-  Core.TypeList v64 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "list"),-      Core.fieldTerm = (coreEncodeType v64)}}))-  Core.TypeLiteral v65 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "literal"),-      Core.fieldTerm = (coreEncodeLiteralType v65)}}))-  Core.TypeMap v66 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "map"),-      Core.fieldTerm = (coreEncodeMapType v66)}}))-  Core.TypeOptional v67 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "optional"),-      Core.fieldTerm = (coreEncodeType v67)}}))-  Core.TypeProduct v68 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "product"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v68))}}))-  Core.TypeRecord v69 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "record"),-      Core.fieldTerm = (coreEncodeRowType v69)}}))-  Core.TypeSet v70 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "set"),-      Core.fieldTerm = (coreEncodeType v70)}}))-  Core.TypeSum v71 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "sum"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeType v71))}}))-  Core.TypeUnion v72 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "union"),-      Core.fieldTerm = (coreEncodeRowType v72)}}))-  Core.TypeVariable v73 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "variable"),-      Core.fieldTerm = (coreEncodeName v73)}}))-  Core.TypeWrap v74 -> (Core.TermUnion (Core.Injection {-    Core.injectionTypeName = (Core.Name "hydra/core.Type"),-    Core.injectionField = Core.Field {-      Core.fieldName = (Core.Name "wrap"),-      Core.fieldTerm = (coreEncodeWrappedType v74)}}))--coreEncodeTypeAbstraction :: (Core.TypeAbstraction -> Core.Term)-coreEncodeTypeAbstraction l = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.TypeAbstraction"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "parameter"),-      Core.fieldTerm = (coreEncodeName (Core.typeAbstractionParameter l))},-    Core.Field {-      Core.fieldName = (Core.Name "body"),-      Core.fieldTerm = (coreEncodeTerm (Core.typeAbstractionBody l))}]}))--coreEncodeTypeScheme :: (Core.TypeScheme -> Core.Term)-coreEncodeTypeScheme ts = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.TypeScheme"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "variables"),-      Core.fieldTerm = (Core.TermList (Lists.map coreEncodeName (Core.typeSchemeVariables ts)))},-    Core.Field {-      Core.fieldName = (Core.Name "type"),-      Core.fieldTerm = (coreEncodeType (Core.typeSchemeType ts))}]}))--coreEncodeTypedTerm :: (Core.TypedTerm -> Core.Term)-coreEncodeTypedTerm tt = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.TypedTerm"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "term"),-      Core.fieldTerm = (coreEncodeTerm (Core.typedTermTerm tt))},-    Core.Field {-      Core.fieldName = (Core.Name "type"),-      Core.fieldTerm = (coreEncodeType (Core.typedTermType tt))}]}))--coreEncodeWrappedTerm :: (Core.WrappedTerm -> Core.Term)-coreEncodeWrappedTerm n = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.WrappedTerm"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.wrappedTermTypeName n))},-    Core.Field {-      Core.fieldName = (Core.Name "object"),-      Core.fieldTerm = (coreEncodeTerm (Core.wrappedTermObject n))}]}))--coreEncodeWrappedType :: (Core.WrappedType -> Core.Term)-coreEncodeWrappedType nt = (Core.TermRecord (Core.Record {-  Core.recordTypeName = (Core.Name "hydra/core.WrappedType"),-  Core.recordFields = [-    Core.Field {-      Core.fieldName = (Core.Name "typeName"),-      Core.fieldTerm = (coreEncodeName (Core.wrappedTypeTypeName nt))},-    Core.Field {-      Core.fieldName = (Core.Name "object"),-      Core.fieldTerm = (coreEncodeType (Core.wrappedTypeObject nt))}]}))
− src/gen-main/haskell/Hydra/CoreLanguage.hs 
@@ -1,25 +0,0 @@--- | Language constraints for Hydra Core--module Hydra.CoreLanguage where--import qualified Hydra.Basics as Basics-import qualified Hydra.Coders as Coders-import qualified Hydra.Lib.Sets as Sets-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Language constraints for Java-hydraCoreLanguage :: Coders.Language-hydraCoreLanguage = Coders.Language {-  Coders.languageName = (Coders.LanguageName "hydra/core"),-  Coders.languageConstraints = Coders.LanguageConstraints {-    Coders.languageConstraintsEliminationVariants = (Sets.fromList Basics.eliminationVariants),-    Coders.languageConstraintsLiteralVariants = (Sets.fromList Basics.literalVariants),-    Coders.languageConstraintsFloatTypes = (Sets.fromList Basics.floatTypes),-    Coders.languageConstraintsFunctionVariants = (Sets.fromList Basics.functionVariants),-    Coders.languageConstraintsIntegerTypes = (Sets.fromList Basics.integerTypes),-    Coders.languageConstraintsTermVariants = (Sets.fromList Basics.termVariants),-    Coders.languageConstraintsTypeVariants = (Sets.fromList Basics.typeVariants),-    Coders.languageConstraintsTypes = (\_ -> True)}}
− src/gen-main/haskell/Hydra/Decode.hs 
@@ -1,258 +0,0 @@--- | A module for decoding terms to native objects--module Hydra.Decode where--import qualified Hydra.Core as Core-import qualified Hydra.Lib.Equality as Equality-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Logic as Logic-import qualified Hydra.Lib.Optionals as Optionals-import qualified Hydra.Strip as Strip-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--bigfloat :: (Core.Term -> Maybe Double)-bigfloat = (Optionals.compose (Optionals.compose literal floatLiteral) bigfloatValue)--bigfloatValue :: (Core.FloatValue -> Maybe Double)-bigfloatValue x = case x of-  Core.FloatValueBigfloat v75 -> (Optionals.pure v75)-  _ -> Nothing--bigint :: (Core.Term -> Maybe Integer)-bigint = (Optionals.compose (Optionals.compose literal integerLiteral) bigintValue)--bigintValue :: (Core.IntegerValue -> Maybe Integer)-bigintValue x = case x of-  Core.IntegerValueBigint v76 -> (Optionals.pure v76)-  _ -> Nothing--binary :: (Core.Term -> Maybe String)-binary = (Optionals.compose literal binaryLiteral)--binaryLiteral :: (Core.Literal -> Maybe String)-binaryLiteral x = case x of-  Core.LiteralBinary v77 -> (Optionals.pure v77)-  _ -> Nothing--boolean :: (Core.Term -> Maybe Bool)-boolean = (Optionals.compose literal booleanLiteral)--booleanLiteral :: (Core.Literal -> Maybe Bool)-booleanLiteral x = case x of-  Core.LiteralBoolean v78 -> (Optionals.pure v78)-  _ -> Nothing--casesCase :: (Core.Name -> Core.Name -> Core.Term -> Maybe Core.Term)-casesCase tname fname = (Optionals.compose (cases tname) (field fname))--cases :: (Core.Name -> Core.Term -> Maybe [Core.Field])-cases = (nominal Core.caseStatementTypeName Core.caseStatementCases (Optionals.compose (Optionals.compose (\x -> (\x -> case x of-  Core.TermFunction v79 -> (Optionals.pure v79)-  _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of-  Core.FunctionElimination v80 -> (Optionals.pure v80)-  _ -> Nothing)) (\x -> case x of-  Core.EliminationUnion v81 -> (Optionals.pure v81)-  _ -> Nothing)))--field :: (Core.Name -> [Core.Field] -> Maybe Core.Term)-field fname fields =  -  let matches = (Lists.filter (\f -> Equality.equal (Core.fieldName f) fname) fields)-  in (Logic.ifElse (Just (Core.fieldTerm (Lists.head matches))) Nothing (Equality.equal 1 (Lists.length matches)))--float32 :: (Core.Term -> Maybe Float)-float32 = (Optionals.compose (Optionals.compose literal floatLiteral) float32Value)--float32Value :: (Core.FloatValue -> Maybe Float)-float32Value x = case x of-  Core.FloatValueFloat32 v82 -> (Optionals.pure v82)-  _ -> Nothing--float64 :: (Core.Term -> Maybe Double)-float64 = (Optionals.compose (Optionals.compose literal floatLiteral) float64Value)--float64Value :: (Core.FloatValue -> Maybe Double)-float64Value x = case x of-  Core.FloatValueFloat64 v83 -> (Optionals.pure v83)-  _ -> Nothing--floatLiteral :: (Core.Literal -> Maybe Core.FloatValue)-floatLiteral x = case x of-  Core.LiteralFloat v84 -> (Optionals.pure v84)-  _ -> Nothing--int16 :: (Core.Term -> Maybe Int16)-int16 = (Optionals.compose (Optionals.compose literal integerLiteral) int16Value)--int16Value :: (Core.IntegerValue -> Maybe Int16)-int16Value x = case x of-  Core.IntegerValueInt16 v85 -> (Optionals.pure v85)-  _ -> Nothing--int32 :: (Core.Term -> Maybe Int)-int32 = (Optionals.compose (Optionals.compose literal integerLiteral) int32Value)--int32Value :: (Core.IntegerValue -> Maybe Int)-int32Value x = case x of-  Core.IntegerValueInt32 v86 -> (Optionals.pure v86)-  _ -> Nothing--int64 :: (Core.Term -> Maybe Int64)-int64 = (Optionals.compose (Optionals.compose literal integerLiteral) int64Value)--int64Value :: (Core.IntegerValue -> Maybe Int64)-int64Value x = case x of-  Core.IntegerValueInt64 v87 -> (Optionals.pure v87)-  _ -> Nothing--int8 :: (Core.Term -> Maybe Int8)-int8 = (Optionals.compose (Optionals.compose literal integerLiteral) int8Value)--int8Value :: (Core.IntegerValue -> Maybe Int8)-int8Value x = case x of-  Core.IntegerValueInt8 v88 -> (Optionals.pure v88)-  _ -> Nothing--integerLiteral :: (Core.Literal -> Maybe Core.IntegerValue)-integerLiteral x = case x of-  Core.LiteralInteger v89 -> (Optionals.pure v89)-  _ -> Nothing--lambda :: (Core.Term -> Maybe Core.Lambda)-lambda = (Optionals.compose (\x -> (\x -> case x of-  Core.TermFunction v90 -> (Optionals.pure v90)-  _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of-  Core.FunctionLambda v91 -> (Optionals.pure v91)-  _ -> Nothing))--letBinding :: (Core.Name -> Core.Term -> Maybe Core.LetBinding)-letBinding fname term = (Optionals.bind (Optionals.map Core.letBindings (letTerm term)) (letBindingWithKey fname))--letBindingWithKey :: (Core.Name -> [Core.LetBinding] -> Maybe Core.LetBinding)-letBindingWithKey fname bindings =  -  let matches = (Lists.filter (\b -> Equality.equal (Core.letBindingName b) fname) bindings)-  in (Logic.ifElse (Just (Lists.head matches)) Nothing (Equality.equal 1 (Lists.length matches)))--letTerm :: (Core.Term -> Maybe Core.Let)-letTerm x = ((\x -> case x of-  Core.TermLet v92 -> (Optionals.pure v92)-  _ -> Nothing) (Strip.fullyStripTerm x))--list :: (Core.Term -> Maybe [Core.Term])-list x = ((\x -> case x of-  Core.TermList v93 -> (Optionals.pure v93)-  _ -> Nothing) (Strip.fullyStripTerm x))--literal :: (Core.Term -> Maybe Core.Literal)-literal x = ((\x -> case x of-  Core.TermLiteral v94 -> (Optionals.pure v94)-  _ -> Nothing) (Strip.fullyStripTerm x))--map :: (Core.Term -> Maybe (Map Core.Term Core.Term))-map x = ((\x -> case x of-  Core.TermMap v95 -> (Optionals.pure v95)-  _ -> Nothing) (Strip.fullyStripTerm x))--name :: (Core.Term -> Maybe Core.Name)-name term = (Optionals.map (\s -> Core.Name s) (Optionals.bind (wrap (Core.Name "hydra/core.Name") term) string))--nominal :: ((a -> Core.Name) -> (a -> b) -> (c -> Maybe a) -> Core.Name -> c -> Maybe b)-nominal getName getB getA expected = (Optionals.compose getA (\a -> Logic.ifElse (Just (getB a)) Nothing (Equality.equal (getName a) expected)))--optCases :: (Core.Term -> Maybe Core.OptionalCases)-optCases = (Optionals.compose (Optionals.compose (\x -> (\x -> case x of-  Core.TermFunction v96 -> (Optionals.pure v96)-  _ -> Nothing) (Strip.fullyStripTerm x)) (\x -> case x of-  Core.FunctionElimination v97 -> (Optionals.pure v97)-  _ -> Nothing)) (\x -> case x of-  Core.EliminationOptional v98 -> (Optionals.pure v98)-  _ -> Nothing))--optCasesJust :: (Core.Term -> Maybe Core.Term)-optCasesJust term = (Optionals.map Core.optionalCasesJust (optCases term))--optCasesNothing :: (Core.Term -> Maybe Core.Term)-optCasesNothing term = (Optionals.map Core.optionalCasesNothing (optCases term))--optional :: (Core.Term -> Maybe (Maybe Core.Term))-optional x = ((\x -> case x of-  Core.TermOptional v99 -> (Optionals.pure v99)-  _ -> Nothing) (Strip.fullyStripTerm x))--pair :: (Core.Term -> Maybe (Core.Term, Core.Term))-pair = (Optionals.compose (\x -> (\x -> case x of-  Core.TermProduct v100 -> (Optionals.pure v100)-  _ -> Nothing) (Strip.fullyStripTerm x)) (\l -> Logic.ifElse (Just (Lists.at 0 l, (Lists.at 1 l))) Nothing (Equality.equal 2 (Lists.length l))))--record :: (Core.Name -> Core.Term -> Maybe [Core.Field])-record = (nominal Core.recordTypeName Core.recordFields (\x -> (\x -> case x of-  Core.TermRecord v101 -> (Optionals.pure v101)-  _ -> Nothing) (Strip.fullyStripTerm x)))--set :: (Core.Term -> Maybe (Set Core.Term))-set x = ((\x -> case x of-  Core.TermSet v102 -> (Optionals.pure v102)-  _ -> Nothing) (Strip.fullyStripTerm x))--string :: (Core.Term -> Maybe String)-string = (Optionals.compose literal stringLiteral)--stringLiteral :: (Core.Literal -> Maybe String)-stringLiteral x = case x of-  Core.LiteralString v103 -> (Optionals.pure v103)-  _ -> Nothing--uint16 :: (Core.Term -> Maybe Int)-uint16 = (Optionals.compose (Optionals.compose literal integerLiteral) uint16Value)--uint16Value :: (Core.IntegerValue -> Maybe Int)-uint16Value x = case x of-  Core.IntegerValueUint16 v104 -> (Optionals.pure v104)-  _ -> Nothing--uint32 :: (Core.Term -> Maybe Int64)-uint32 = (Optionals.compose (Optionals.compose literal integerLiteral) uint32Value)--uint32Value :: (Core.IntegerValue -> Maybe Int64)-uint32Value x = case x of-  Core.IntegerValueUint32 v105 -> (Optionals.pure v105)-  _ -> Nothing--uint64 :: (Core.Term -> Maybe Integer)-uint64 = (Optionals.compose (Optionals.compose literal integerLiteral) uint64Value)--uint64Value :: (Core.IntegerValue -> Maybe Integer)-uint64Value x = case x of-  Core.IntegerValueUint64 v106 -> (Optionals.pure v106)-  _ -> Nothing--uint8 :: (Core.Term -> Maybe Int16)-uint8 = (Optionals.compose (Optionals.compose literal integerLiteral) uint8Value)--uint8Value :: (Core.IntegerValue -> Maybe Int16)-uint8Value x = case x of-  Core.IntegerValueUint8 v107 -> (Optionals.pure v107)-  _ -> Nothing--unit :: (Core.Term -> Maybe ())-unit term = (Optionals.map (\_ -> ()) (record (Core.Name "hydra/core.Unit") term))--unitVariant :: (Core.Name -> Core.Term -> Maybe Core.Name)-unitVariant tname term = (Optionals.map Core.fieldName (variant tname term))--variable :: (Core.Term -> Maybe Core.Name)-variable x = ((\x -> (\x -> case x of-  Core.TermVariable v108 -> (Optionals.pure v108)-  _ -> Nothing) (Strip.fullyStripTerm x)) (Strip.fullyStripTerm x))--variant :: (Core.Name -> Core.Term -> Maybe Core.Field)-variant = (nominal Core.injectionTypeName Core.injectionField (\x -> (\x -> case x of-  Core.TermUnion v109 -> (Optionals.pure v109)-  _ -> Nothing) (Strip.fullyStripTerm x)))--wrap :: (Core.Name -> Core.Term -> Maybe Core.Term)-wrap = (nominal Core.wrappedTermTypeName Core.wrappedTermObject (\x -> (\x -> case x of-  Core.TermWrap v110 -> (Optionals.pure v110)-  _ -> Nothing) (Strip.fullyStripTerm x)))
+ src/gen-main/haskell/Hydra/Decode/Core.hs view
@@ -0,0 +1,119 @@+-- | Decode hydra.core types from the hydra.core.Term type++module Hydra.Decode.Core where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Extract.Core as Core_+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core__+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++applicationType :: (Core.Term -> Compute.Flow Graph.Graph Core.ApplicationType)+applicationType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "function") type_) (\function -> Flows.bind (Lexical.getField m (Core.Name "argument") type_) (\argument -> Flows.pure (Core.ApplicationType {+  Core.applicationTypeFunction = function,+  Core.applicationTypeArgument = argument})))))++fieldType :: (Core.Term -> Compute.Flow Graph.Graph Core.FieldType)+fieldType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "name") name) (\name -> Flows.bind (Lexical.getField m (Core.Name "type") type_) (\typ -> Flows.pure (Core.FieldType {+  Core.fieldTypeName = name,+  Core.fieldTypeType = typ})))))++fieldTypes :: (Core.Term -> Compute.Flow Graph.Graph [Core.FieldType])+fieldTypes term =  +  let stripped = (Rewriting.deannotateAndDetypeTerm term)+  in ((\x -> case x of+    Core.TermList v1 -> (Flows.mapList fieldType v1)+    _ -> (Monads.unexpected "list" (Core__.term term))) stripped)++floatType :: (Core.Term -> Compute.Flow Graph.Graph Core.FloatType)+floatType = (Lexical.matchEnum (Core.Name "hydra.core.FloatType") [+  (Core.Name "bigfloat", Core.FloatTypeBigfloat),+  (Core.Name "float32", Core.FloatTypeFloat32),+  (Core.Name "float64", Core.FloatTypeFloat64)])++forallType :: (Core.Term -> Compute.Flow Graph.Graph Core.ForallType)+forallType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "parameter") name) (\parameter -> Flows.bind (Lexical.getField m (Core.Name "body") type_) (\body -> Flows.pure (Core.ForallType {+  Core.forallTypeParameter = parameter,+  Core.forallTypeBody = body})))))++functionType :: (Core.Term -> Compute.Flow Graph.Graph Core.FunctionType)+functionType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "domain") type_) (\domain -> Flows.bind (Lexical.getField m (Core.Name "codomain") type_) (\codomain -> Flows.pure (Core.FunctionType {+  Core.functionTypeDomain = domain,+  Core.functionTypeCodomain = codomain})))))++integerType :: (Core.Term -> Compute.Flow Graph.Graph Core.IntegerType)+integerType = (Lexical.matchEnum (Core.Name "hydra.core.IntegerType") [+  (Core.Name "bigint", Core.IntegerTypeBigint),+  (Core.Name "int8", Core.IntegerTypeInt8),+  (Core.Name "int16", Core.IntegerTypeInt16),+  (Core.Name "int32", Core.IntegerTypeInt32),+  (Core.Name "int64", Core.IntegerTypeInt64),+  (Core.Name "uint8", Core.IntegerTypeUint8),+  (Core.Name "uint16", Core.IntegerTypeUint16),+  (Core.Name "uint32", Core.IntegerTypeUint32),+  (Core.Name "uint64", Core.IntegerTypeUint64)])++literalType :: (Core.Term -> Compute.Flow Graph.Graph Core.LiteralType)+literalType = (Lexical.matchUnion (Core.Name "hydra.core.LiteralType") [+  Lexical.matchUnitField (Core.Name "binary") Core.LiteralTypeBinary,+  Lexical.matchUnitField (Core.Name "boolean") Core.LiteralTypeBoolean,+  (Core.Name "float", (\ft -> Flows.map (\x -> Core.LiteralTypeFloat x) (floatType ft))),+  (Core.Name "integer", (\it -> Flows.map (\x -> Core.LiteralTypeInteger x) (integerType it))),+  (Lexical.matchUnitField (Core.Name "string") Core.LiteralTypeString)])++mapType :: (Core.Term -> Compute.Flow Graph.Graph Core.MapType)+mapType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "keys") type_) (\keys -> Flows.bind (Lexical.getField m (Core.Name "values") type_) (\values -> Flows.pure (Core.MapType {+  Core.mapTypeKeys = keys,+  Core.mapTypeValues = values})))))++name :: (Core.Term -> Compute.Flow Graph.Graph Core.Name)+name term = (Flows.map (\x -> Core.Name x) (Flows.bind (Core_.wrap (Core.Name "hydra.core.Name") term) Core_.string))++rowType :: (Core.Term -> Compute.Flow Graph.Graph Core.RowType)+rowType = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "typeName") name) (\typeName -> Flows.bind (Lexical.getField m (Core.Name "fields") fieldTypes) (\fields -> Flows.pure (Core.RowType {+  Core.rowTypeTypeName = typeName,+  Core.rowTypeFields = fields})))))++string :: (Core.Term -> Compute.Flow Graph.Graph String)+string term = (Core_.string (Rewriting.deannotateAndDetypeTerm term))++type_ :: (Core.Term -> Compute.Flow Graph.Graph Core.Type)+type_ dat = ((\x -> case x of+  Core.TermAnnotated v1 -> (Flows.map (\t -> Core.TypeAnnotated (Core.AnnotatedType {+    Core.annotatedTypeSubject = t,+    Core.annotatedTypeAnnotation = (Core.annotatedTermAnnotation v1)})) (type_ (Core.annotatedTermSubject v1)))+  _ -> (Lexical.matchUnion (Core.Name "hydra.core.Type") [+    (Core.Name "application", (\at -> Flows.map (\x -> Core.TypeApplication x) (applicationType at))),+    (Core.Name "forall", (\ft -> Flows.map (\x -> Core.TypeForall x) (forallType ft))),+    (Core.Name "function", (\ft -> Flows.map (\x -> Core.TypeFunction x) (functionType ft))),+    (Core.Name "list", (\et -> Flows.map (\x -> Core.TypeList x) (type_ et))),+    (Core.Name "literal", (\lt -> Flows.map (\x -> Core.TypeLiteral x) (literalType lt))),+    (Core.Name "map", (\mt -> Flows.map (\x -> Core.TypeMap x) (mapType mt))),+    (Core.Name "optional", (\et -> Flows.map (\x -> Core.TypeOptional x) (type_ et))),+    (Core.Name "product", (\types -> Flows.map (\x -> Core.TypeProduct x) (Core_.listOf type_ types))),+    (Core.Name "record", (\rt -> Flows.map (\x -> Core.TypeRecord x) (rowType rt))),+    (Core.Name "set", (\et -> Flows.map (\x -> Core.TypeSet x) (type_ et))),+    (Core.Name "sum", (\types -> Flows.map (\x -> Core.TypeSum x) (Core_.listOf type_ types))),+    (Core.Name "union", (\rt -> Flows.map (\x -> Core.TypeUnion x) (rowType rt))),+    (Core.Name "unit", (\_ -> Flows.pure Core.TypeUnit)),+    (Core.Name "variable", (\n -> Flows.map (\x -> Core.TypeVariable x) (name n))),+    (Core.Name "wrap", (\wt -> Flows.map (\x -> Core.TypeWrap x) (wrappedType wt)))] dat)) dat)++typeScheme :: (Core.Term -> Compute.Flow Graph.Graph Core.TypeScheme)+typeScheme = (Lexical.matchRecord (\m -> Flows.bind (Lexical.getField m (Core.Name "variables") (Core_.listOf name)) (\vars -> Flows.bind (Lexical.getField m (Core.Name "type") type_) (\body -> Flows.pure (Core.TypeScheme {+  Core.typeSchemeVariables = vars,+  Core.typeSchemeType = body})))))++wrappedType :: (Core.Term -> Compute.Flow Graph.Graph Core.WrappedType)+wrappedType term = (Flows.bind (Core_.record (Core.Name "hydra.core.WrappedType") term) (\fields -> Flows.bind (Core_.field (Core.Name "typeName") name fields) (\name -> Flows.bind (Core_.field (Core.Name "object") type_ fields) (\obj -> Flows.pure (Core.WrappedType {+  Core.wrappedTypeTypeName = name,+  Core.wrappedTypeObject = obj})))))
+ src/gen-main/haskell/Hydra/Decoding.hs view
@@ -0,0 +1,257 @@+-- | A module for decoding terms to native objects++module Hydra.Decoding where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Logic as Logic+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Rewriting as Rewriting+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++bigfloat :: (Core.Term -> Maybe Double)+bigfloat = (Optionals.compose (Optionals.compose literal floatLiteral) bigfloatValue)++bigfloatValue :: (Core.FloatValue -> Maybe Double)+bigfloatValue x = case x of+  Core.FloatValueBigfloat v1 -> (Optionals.pure v1)+  _ -> Nothing++bigint :: (Core.Term -> Maybe Integer)+bigint = (Optionals.compose (Optionals.compose literal integerLiteral) bigintValue)++bigintValue :: (Core.IntegerValue -> Maybe Integer)+bigintValue x = case x of+  Core.IntegerValueBigint v1 -> (Optionals.pure v1)+  _ -> Nothing++binary :: (Core.Term -> Maybe String)+binary = (Optionals.compose literal binaryLiteral)++binaryLiteral :: (Core.Literal -> Maybe String)+binaryLiteral x = case x of+  Core.LiteralBinary v1 -> (Optionals.pure v1)+  _ -> Nothing++boolean :: (Core.Term -> Maybe Bool)+boolean = (Optionals.compose literal booleanLiteral)++booleanLiteral :: (Core.Literal -> Maybe Bool)+booleanLiteral x = case x of+  Core.LiteralBoolean v1 -> (Optionals.pure v1)+  _ -> Nothing++caseField :: (Core.Name -> Core.Name -> Core.Term -> Maybe Core.Term)+caseField tname fname = (Optionals.compose (cases tname) (field fname))++cases :: (Core.Name -> Core.Term -> Maybe [Core.Field])+cases = (nominal Core.caseStatementTypeName Core.caseStatementCases (Optionals.compose (Optionals.compose matchFunction matchElimination) matchUnion)) +  where +    matchFunction = (\arg_ -> (\x -> case x of+      Core.TermFunction v1 -> (Optionals.pure v1)+      _ -> Nothing) (Rewriting.deannotateTerm arg_))+    matchElimination = (\x -> case x of+      Core.FunctionElimination v1 -> (Optionals.pure v1)+      _ -> Nothing)+    matchUnion = (\x -> case x of+      Core.EliminationUnion v1 -> (Optionals.pure v1)+      _ -> Nothing)++field :: (Core.Name -> [Core.Field] -> Maybe Core.Term)+field fname fields =  +  let matches = (Lists.filter (\f -> Equality.equal (Core.fieldName f) fname) fields)+  in (Logic.ifElse (Equality.equal 1 (Lists.length matches)) (Just (Core.fieldTerm (Lists.head matches))) Nothing)++float32 :: (Core.Term -> Maybe Float)+float32 = (Optionals.compose (Optionals.compose literal floatLiteral) float32Value)++float32Value :: (Core.FloatValue -> Maybe Float)+float32Value x = case x of+  Core.FloatValueFloat32 v1 -> (Optionals.pure v1)+  _ -> Nothing++float64 :: (Core.Term -> Maybe Double)+float64 = (Optionals.compose (Optionals.compose literal floatLiteral) float64Value)++float64Value :: (Core.FloatValue -> Maybe Double)+float64Value x = case x of+  Core.FloatValueFloat64 v1 -> (Optionals.pure v1)+  _ -> Nothing++floatLiteral :: (Core.Literal -> Maybe Core.FloatValue)+floatLiteral x = case x of+  Core.LiteralFloat v1 -> (Optionals.pure v1)+  _ -> Nothing++int16 :: (Core.Term -> Maybe I.Int16)+int16 = (Optionals.compose (Optionals.compose literal integerLiteral) int16Value)++int16Value :: (Core.IntegerValue -> Maybe I.Int16)+int16Value x = case x of+  Core.IntegerValueInt16 v1 -> (Optionals.pure v1)+  _ -> Nothing++int32 :: (Core.Term -> Maybe Int)+int32 = (Optionals.compose (Optionals.compose literal integerLiteral) int32Value)++int32Value :: (Core.IntegerValue -> Maybe Int)+int32Value x = case x of+  Core.IntegerValueInt32 v1 -> (Optionals.pure v1)+  _ -> Nothing++int64 :: (Core.Term -> Maybe I.Int64)+int64 = (Optionals.compose (Optionals.compose literal integerLiteral) int64Value)++int64Value :: (Core.IntegerValue -> Maybe I.Int64)+int64Value x = case x of+  Core.IntegerValueInt64 v1 -> (Optionals.pure v1)+  _ -> Nothing++int8 :: (Core.Term -> Maybe I.Int8)+int8 = (Optionals.compose (Optionals.compose literal integerLiteral) int8Value)++int8Value :: (Core.IntegerValue -> Maybe I.Int8)+int8Value x = case x of+  Core.IntegerValueInt8 v1 -> (Optionals.pure v1)+  _ -> Nothing++integerLiteral :: (Core.Literal -> Maybe Core.IntegerValue)+integerLiteral x = case x of+  Core.LiteralInteger v1 -> (Optionals.pure v1)+  _ -> Nothing++lambda :: (Core.Term -> Maybe Core.Lambda)+lambda = (Optionals.compose matchFunction matchLambda) +  where +    matchFunction = (\arg_ -> (\x -> case x of+      Core.TermFunction v1 -> (Optionals.pure v1)+      _ -> Nothing) (Rewriting.deannotateTerm arg_))+    matchLambda = (\x -> case x of+      Core.FunctionLambda v1 -> (Optionals.pure v1)+      _ -> Nothing)++letBinding :: (Core.Name -> Core.Term -> Maybe Core.Binding)+letBinding fname term = (Optionals.bind (Optionals.map Core.letBindings (letTerm term)) (letBindingWithKey fname))++letBindingWithKey :: (Core.Name -> [Core.Binding] -> Maybe Core.Binding)+letBindingWithKey fname bindings =  +  let matches = (Lists.filter (\b -> Equality.equal (Core.bindingName b) fname) bindings)+  in (Logic.ifElse (Equality.equal 1 (Lists.length matches)) (Just (Lists.head matches)) Nothing)++letTerm :: (Core.Term -> Maybe Core.Let)+letTerm arg_ = ((\x -> case x of+  Core.TermLet v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++list :: (Core.Term -> Maybe [Core.Term])+list arg_ = ((\x -> case x of+  Core.TermList v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++literal :: (Core.Term -> Maybe Core.Literal)+literal arg_ = ((\x -> case x of+  Core.TermLiteral v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++map :: (Core.Term -> Maybe (M.Map Core.Term Core.Term))+map arg_ = ((\x -> case x of+  Core.TermMap v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++name :: (Core.Term -> Maybe Core.Name)+name term = (Optionals.map (\s -> Core.Name s) (Optionals.bind (wrap (Core.Name "hydra.core.Name") term) string))++nominal :: ((t0 -> Core.Name) -> (t0 -> t1) -> (t2 -> Maybe t0) -> Core.Name -> t2 -> Maybe t1)+nominal getName getB getA expected =  +  let namesEqual = (\n1 -> \n2 -> Equality.equal (Core.unName n1) (Core.unName n2))+  in (Optionals.compose getA (\a -> Logic.ifElse (namesEqual (getName a) expected) (Just (getB a)) Nothing))++optional :: (Core.Term -> Maybe (Maybe Core.Term))+optional arg_ = ((\x -> case x of+  Core.TermOptional v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++pair :: (Core.Term -> Maybe (Core.Term, Core.Term))+pair = (Optionals.compose matchProduct (\l -> Logic.ifElse (Equality.equal 2 (Lists.length l)) (Just (Lists.at 0 l, (Lists.at 1 l))) Nothing)) +  where +    matchProduct = (\arg_ -> (\x -> case x of+      Core.TermProduct v1 -> (Optionals.pure v1)+      _ -> Nothing) (Rewriting.deannotateTerm arg_))++record :: (Core.Name -> Core.Term -> Maybe [Core.Field])+record = (nominal Core.recordTypeName Core.recordFields (\arg_ -> (\x -> case x of+  Core.TermRecord v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_)))++set :: (Core.Term -> Maybe (S.Set Core.Term))+set arg_ = ((\x -> case x of+  Core.TermSet v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++string :: (Core.Term -> Maybe String)+string = (Optionals.compose literal stringLiteral)++stringLiteral :: (Core.Literal -> Maybe String)+stringLiteral x = case x of+  Core.LiteralString v1 -> (Optionals.pure v1)+  _ -> Nothing++uint16 :: (Core.Term -> Maybe Int)+uint16 = (Optionals.compose (Optionals.compose literal integerLiteral) uint16Value)++uint16Value :: (Core.IntegerValue -> Maybe Int)+uint16Value x = case x of+  Core.IntegerValueUint16 v1 -> (Optionals.pure v1)+  _ -> Nothing++uint32 :: (Core.Term -> Maybe I.Int64)+uint32 = (Optionals.compose (Optionals.compose literal integerLiteral) uint32Value)++uint32Value :: (Core.IntegerValue -> Maybe I.Int64)+uint32Value x = case x of+  Core.IntegerValueUint32 v1 -> (Optionals.pure v1)+  _ -> Nothing++uint64 :: (Core.Term -> Maybe Integer)+uint64 = (Optionals.compose (Optionals.compose literal integerLiteral) uint64Value)++uint64Value :: (Core.IntegerValue -> Maybe Integer)+uint64Value x = case x of+  Core.IntegerValueUint64 v1 -> (Optionals.pure v1)+  _ -> Nothing++uint8 :: (Core.Term -> Maybe I.Int16)+uint8 = (Optionals.compose (Optionals.compose literal integerLiteral) uint8Value)++uint8Value :: (Core.IntegerValue -> Maybe I.Int16)+uint8Value x = case x of+  Core.IntegerValueUint8 v1 -> (Optionals.pure v1)+  _ -> Nothing++unit :: (Core.Term -> Maybe ())+unit term = ((\x -> case x of+  Core.TermUnit -> (Just ())+  _ -> Nothing) term)++unitVariant :: (Core.Name -> Core.Term -> Maybe Core.Name)+unitVariant tname term = (Optionals.map Core.fieldName (variant tname term))++variable :: (Core.Term -> Maybe Core.Name)+variable arg_ = ((\x -> case x of+  Core.TermVariable v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_))++variant :: (Core.Name -> Core.Term -> Maybe Core.Field)+variant = (nominal Core.injectionTypeName Core.injectionField (\arg_ -> (\x -> case x of+  Core.TermUnion v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_)))++wrap :: (Core.Name -> Core.Term -> Maybe Core.Term)+wrap = (nominal Core.wrappedTermTypeName Core.wrappedTermObject (\arg_ -> (\x -> case x of+  Core.TermWrap v1 -> (Optionals.pure v1)+  _ -> Nothing) (Rewriting.deannotateTerm arg_)))
+ src/gen-main/haskell/Hydra/Describe/Core.hs view
@@ -0,0 +1,79 @@+-- | Natural-language descriptions for hydra.core types++module Hydra.Describe.Core where++import qualified Hydra.Core as Core+import qualified Hydra.Describe.Mantle as Mantle+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Display a floating-point type as a string+floatType :: (Core.FloatType -> String)+floatType t = (Strings.cat [+  (\arg_ -> Mantle.precision (Variants.floatTypePrecision arg_)) t,+  " floating-point number"])++-- | Display an integer type as a string+integerType :: (Core.IntegerType -> String)+integerType t = (Strings.cat [+  (\arg_ -> Mantle.precision (Variants.integerTypePrecision arg_)) t,+  " integer"])++-- | Display a literal type as a string+literalType :: (Core.LiteralType -> String)+literalType x = case x of+  Core.LiteralTypeBinary -> "binary string"+  Core.LiteralTypeBoolean -> "boolean value"+  Core.LiteralTypeFloat v1 -> (floatType v1)+  Core.LiteralTypeInteger v1 -> (integerType v1)+  Core.LiteralTypeString -> "character string"++-- | Display a type as a string+type_ :: (Core.Type -> String)+type_ x = case x of+  Core.TypeAnnotated v1 -> (Strings.cat [+    "annotated ",+    (type_ (Core.annotatedTypeSubject v1))])+  Core.TypeApplication v1 -> (Strings.cat [+    type_ (Core.applicationTypeFunction v1),+    " applied to ",+    (type_ (Core.applicationTypeArgument v1))])+  Core.TypeLiteral v1 -> (literalType v1)+  Core.TypeFunction v1 -> (Strings.cat [+    Strings.cat [+      Strings.cat [+        "function from ",+        (type_ (Core.functionTypeDomain v1))],+      " to "],+    (type_ (Core.functionTypeCodomain v1))])+  Core.TypeForall v1 -> (Strings.cat2 "polymorphic " (type_ (Core.forallTypeBody v1)))+  Core.TypeList v1 -> (Strings.cat [+    "list of ",+    (type_ v1)])+  Core.TypeMap v1 -> (Strings.cat [+    Strings.cat [+      Strings.cat [+        "map from ",+        (type_ (Core.mapTypeKeys v1))],+      " to "],+    (type_ (Core.mapTypeValues v1))])+  Core.TypeOptional v1 -> (Strings.cat [+    "optional ",+    (type_ v1)])+  Core.TypeProduct _ -> "tuple"+  Core.TypeRecord _ -> "record"+  Core.TypeSet v1 -> (Strings.cat [+    "set of ",+    (type_ v1)])+  Core.TypeSum _ -> "variant tuple"+  Core.TypeUnion _ -> "union"+  Core.TypeUnit -> "unit"+  Core.TypeVariable _ -> "instance of a named type"+  Core.TypeWrap v1 -> (Strings.cat [+    "wrapper for ",+    (type_ (Core.wrappedTypeObject v1))])
+ src/gen-main/haskell/Hydra/Describe/Mantle.hs view
@@ -0,0 +1,20 @@+-- | Natural-language descriptions for hydra.mantle types++module Hydra.Describe.Mantle where++import qualified Hydra.Lib.Literals as Literals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Display numeric precision as a string+precision :: (Mantle.Precision -> String)+precision x = case x of+  Mantle.PrecisionArbitrary -> "arbitrary-precision"+  Mantle.PrecisionBits v1 -> (Strings.cat [+    Literals.showInt32 v1,+    "-bit"])
+ src/gen-main/haskell/Hydra/Encode/Core.hs view
@@ -0,0 +1,720 @@+-- | Mapping of hydra.core constructs in a host language like Haskell or Java  to their native Hydra counterparts as terms.  This includes an implementation of LambdaGraph's epsilon encoding (types to terms).++module Hydra.Encode.Core where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Rewriting as Rewriting+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++annotatedTerm :: (Core.AnnotatedTerm -> Core.Term)+annotatedTerm a = (Core.TermAnnotated (Core.AnnotatedTerm {+  Core.annotatedTermSubject = (term (Core.annotatedTermSubject a)),+  Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation a)}))++annotatedType :: (Core.AnnotatedType -> Core.Term)+annotatedType at = (Core.TermAnnotated (Core.AnnotatedTerm {+  Core.annotatedTermSubject = (type_ (Core.annotatedTypeSubject at)),+  Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation at)}))++application :: (Core.Application -> Core.Term)+application app = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Application"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "function"),+      Core.fieldTerm = (term (Core.applicationFunction app))},+    Core.Field {+      Core.fieldName = (Core.Name "argument"),+      Core.fieldTerm = (term (Core.applicationArgument app))}]}))++applicationType :: (Core.ApplicationType -> Core.Term)+applicationType at = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.ApplicationType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "function"),+      Core.fieldTerm = (type_ (Core.applicationTypeFunction at))},+    Core.Field {+      Core.fieldName = (Core.Name "argument"),+      Core.fieldTerm = (type_ (Core.applicationTypeArgument at))}]}))++caseStatement :: (Core.CaseStatement -> Core.Term)+caseStatement cs = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.CaseStatement"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.caseStatementTypeName cs))},+    Core.Field {+      Core.fieldName = (Core.Name "default"),+      Core.fieldTerm = (Core.TermOptional (Optionals.map term (Core.caseStatementDefault cs)))},+    Core.Field {+      Core.fieldName = (Core.Name "cases"),+      Core.fieldTerm = (Core.TermList (Lists.map field (Core.caseStatementCases cs)))}]}))++elimination :: (Core.Elimination -> Core.Term)+elimination x = case x of+  Core.EliminationProduct v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Elimination"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "product"),+      Core.fieldTerm = (tupleProjection v1)}}))+  Core.EliminationRecord v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Elimination"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "record"),+      Core.fieldTerm = (projection v1)}}))+  Core.EliminationUnion v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Elimination"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "union"),+      Core.fieldTerm = (caseStatement v1)}}))+  Core.EliminationWrap v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Elimination"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "wrap"),+      Core.fieldTerm = (name v1)}}))++field :: (Core.Field -> Core.Term)+field f = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Field"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "name"),+      Core.fieldTerm = (Core.TermWrap (Core.WrappedTerm {+        Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"),+        Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName (Core.fieldName f))))}))},+    Core.Field {+      Core.fieldName = (Core.Name "term"),+      Core.fieldTerm = (term (Core.fieldTerm f))}]}))++fieldType :: (Core.FieldType -> Core.Term)+fieldType ft = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.FieldType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "name"),+      Core.fieldTerm = (name (Core.fieldTypeName ft))},+    Core.Field {+      Core.fieldName = (Core.Name "type"),+      Core.fieldTerm = (type_ (Core.fieldTypeType ft))}]}))++floatType :: (Core.FloatType -> Core.Term)+floatType x = case x of+  Core.FloatTypeBigfloat -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "bigfloat"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.FloatTypeFloat32 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float32"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.FloatTypeFloat64 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float64"),+      Core.fieldTerm = Core.TermUnit}}))++floatValue :: (Core.FloatValue -> Core.Term)+floatValue x = case x of+  Core.FloatValueBigfloat v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "bigfloat"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueBigfloat v1)))}}))+  Core.FloatValueFloat32 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float32"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 v1)))}}))+  Core.FloatValueFloat64 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.FloatValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float64"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 v1)))}}))++function :: (Core.Function -> Core.Term)+function x = case x of+  Core.FunctionElimination v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Function"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "elimination"),+      Core.fieldTerm = (elimination v1)}}))+  Core.FunctionLambda v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Function"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "lambda"),+      Core.fieldTerm = (lambda v1)}}))+  Core.FunctionPrimitive v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Function"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "primitive"),+      Core.fieldTerm = (name v1)}}))++functionType :: (Core.FunctionType -> Core.Term)+functionType ft = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.FunctionType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "domain"),+      Core.fieldTerm = (type_ (Core.functionTypeDomain ft))},+    Core.Field {+      Core.fieldName = (Core.Name "codomain"),+      Core.fieldTerm = (type_ (Core.functionTypeCodomain ft))}]}))++injection :: (Core.Injection -> Core.Term)+injection i = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Injection"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.injectionTypeName i))},+    Core.Field {+      Core.fieldName = (Core.Name "field"),+      Core.fieldTerm = (field (Core.injectionField i))}]}))++integerType :: (Core.IntegerType -> Core.Term)+integerType x = case x of+  Core.IntegerTypeBigint -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "bigint"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeInt8 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int8"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeInt16 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int16"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeInt32 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int32"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeInt64 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int64"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeUint8 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint8"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeUint16 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint16"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeUint32 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint32"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.IntegerTypeUint64 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint64"),+      Core.fieldTerm = Core.TermUnit}}))++integerValue :: (Core.IntegerValue -> Core.Term)+integerValue x = case x of+  Core.IntegerValueBigint v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "bigint"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueBigint v1)))}}))+  Core.IntegerValueInt8 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int8"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt8 v1)))}}))+  Core.IntegerValueInt16 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int16"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt16 v1)))}}))+  Core.IntegerValueInt32 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int32"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 v1)))}}))+  Core.IntegerValueInt64 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "int64"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt64 v1)))}}))+  Core.IntegerValueUint8 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint8"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint8 v1)))}}))+  Core.IntegerValueUint16 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint16"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint16 v1)))}}))+  Core.IntegerValueUint32 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint32"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint32 v1)))}}))+  Core.IntegerValueUint64 v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.IntegerValue"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "uint64"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 v1)))}}))++lambda :: (Core.Lambda -> Core.Term)+lambda l = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Lambda"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "parameter"),+      Core.fieldTerm = (name (Core.lambdaParameter l))},+    Core.Field {+      Core.fieldName = (Core.Name "domain"),+      Core.fieldTerm = (Core.TermOptional (Optionals.map type_ (Core.lambdaDomain l)))},+    Core.Field {+      Core.fieldName = (Core.Name "body"),+      Core.fieldTerm = (term (Core.lambdaBody l))}]}))++forallType :: (Core.ForallType -> Core.Term)+forallType lt = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.ForallType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "parameter"),+      Core.fieldTerm = (name (Core.forallTypeParameter lt))},+    Core.Field {+      Core.fieldName = (Core.Name "body"),+      Core.fieldTerm = (type_ (Core.forallTypeBody lt))}]}))++let_ :: (Core.Let -> Core.Term)+let_ l = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Let"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "bindings"),+      Core.fieldTerm = (Core.TermList (Lists.map binding (Core.letBindings l)))},+    Core.Field {+      Core.fieldName = (Core.Name "environment"),+      Core.fieldTerm = (term (Core.letEnvironment l))}]}))++binding :: (Core.Binding -> Core.Term)+binding b = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Binding"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "name"),+      Core.fieldTerm = (name (Core.bindingName b))},+    Core.Field {+      Core.fieldName = (Core.Name "term"),+      Core.fieldTerm = (term (Core.bindingTerm b))},+    Core.Field {+      Core.fieldName = (Core.Name "type"),+      Core.fieldTerm = (Core.TermOptional (Optionals.map typeScheme (Core.bindingType b)))}]}))++literal :: (Core.Literal -> Core.Term)+literal x = case x of+  Core.LiteralBinary v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Literal"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "binary"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralBinary v1))}}))+  Core.LiteralBoolean v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Literal"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "boolean"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralBoolean v1))}}))+  Core.LiteralFloat v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Literal"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float"),+      Core.fieldTerm = (floatValue v1)}}))+  Core.LiteralInteger v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Literal"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "integer"),+      Core.fieldTerm = (integerValue v1)}}))+  Core.LiteralString v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Literal"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "string"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralString v1))}}))++literalType :: (Core.LiteralType -> Core.Term)+literalType x = case x of+  Core.LiteralTypeBinary -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.LiteralType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "binary"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.LiteralTypeBoolean -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.LiteralType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "boolean"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.LiteralTypeFloat v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.LiteralType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "float"),+      Core.fieldTerm = (floatType v1)}}))+  Core.LiteralTypeInteger v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.LiteralType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "integer"),+      Core.fieldTerm = (integerType v1)}}))+  Core.LiteralTypeString -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.LiteralType"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "string"),+      Core.fieldTerm = Core.TermUnit}}))++mapType :: (Core.MapType -> Core.Term)+mapType mt = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.MapType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "keys"),+      Core.fieldTerm = (type_ (Core.mapTypeKeys mt))},+    Core.Field {+      Core.fieldName = (Core.Name "values"),+      Core.fieldTerm = (type_ (Core.mapTypeValues mt))}]}))++name :: (Core.Name -> Core.Term)+name fn = (Core.TermWrap (Core.WrappedTerm {+  Core.wrappedTermTypeName = (Core.Name "hydra.core.Name"),+  Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString (Core.unName fn)))}))++projection :: (Core.Projection -> Core.Term)+projection p = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Projection"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.projectionTypeName p))},+    Core.Field {+      Core.fieldName = (Core.Name "field"),+      Core.fieldTerm = (name (Core.projectionField p))}]}))++record :: (Core.Record -> Core.Term)+record r = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Record"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.recordTypeName r))},+    Core.Field {+      Core.fieldName = (Core.Name "fields"),+      Core.fieldTerm = (Core.TermList (Lists.map field (Core.recordFields r)))}]}))++rowType :: (Core.RowType -> Core.Term)+rowType rt = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.RowType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.rowTypeTypeName rt))},+    Core.Field {+      Core.fieldName = (Core.Name "fields"),+      Core.fieldTerm = (Core.TermList (Lists.map fieldType (Core.rowTypeFields rt)))}]}))++sum :: (Core.Sum -> Core.Term)+sum s = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.Sum"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "index"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumIndex s))))},+    Core.Field {+      Core.fieldName = (Core.Name "size"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumSize s))))},+    Core.Field {+      Core.fieldName = (Core.Name "term"),+      Core.fieldTerm = (term (Core.sumTerm s))}]}))++term :: (Core.Term -> Core.Term)+term x = case x of+  Core.TermAnnotated v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "annotated"),+      Core.fieldTerm = (annotatedTerm v1)}}))+  Core.TermApplication v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "application"),+      Core.fieldTerm = (application v1)}}))+  Core.TermFunction v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "function"),+      Core.fieldTerm = (function v1)}}))+  Core.TermLet v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "let"),+      Core.fieldTerm = (let_ v1)}}))+  Core.TermLiteral v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "literal"),+      Core.fieldTerm = (literal v1)}}))+  Core.TermList v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "list"),+      Core.fieldTerm = (Core.TermList (Lists.map term v1))}}))+  Core.TermMap v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "map"),+      Core.fieldTerm = (Core.TermMap (Maps.bimap term term v1))}}))+  Core.TermOptional v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "optional"),+      Core.fieldTerm = (Core.TermOptional (Optionals.map term v1))}}))+  Core.TermProduct v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "product"),+      Core.fieldTerm = (Core.TermList (Lists.map term v1))}}))+  Core.TermRecord v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "record"),+      Core.fieldTerm = (record v1)}}))+  Core.TermSet v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "set"),+      Core.fieldTerm = (Core.TermSet (Sets.map term v1))}}))+  Core.TermSum v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "sum"),+      Core.fieldTerm = (sum v1)}}))+  Core.TermTypeLambda v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "typeLambda"),+      Core.fieldTerm = (typeLambda v1)}}))+  Core.TermTypeApplication v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "typeApplication"),+      Core.fieldTerm = (typedTerm v1)}}))+  Core.TermUnion v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "union"),+      Core.fieldTerm = (injection v1)}}))+  Core.TermUnit -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "unit"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.TermVariable v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "variable"),+      Core.fieldTerm = (name v1)}}))+  Core.TermWrap v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Term"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "wrap"),+      Core.fieldTerm = (wrappedTerm v1)}}))++tupleProjection :: (Core.TupleProjection -> Core.Term)+tupleProjection tp = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.TupleProjection"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "arity"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionArity tp))))},+    Core.Field {+      Core.fieldName = (Core.Name "index"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.tupleProjectionIndex tp))))},+    Core.Field {+      Core.fieldName = (Core.Name "domain"),+      Core.fieldTerm = (Core.TermOptional (Optionals.map encodeTypes (Core.tupleProjectionDomain tp)))}]})) +  where +    encodeTypes = (\types -> Core.TermList (Lists.map type_ types))++type_ :: (Core.Type -> Core.Term)+type_ x = case x of+  Core.TypeAnnotated v1 -> (Core.TermAnnotated (Core.AnnotatedTerm {+    Core.annotatedTermSubject = (type_ (Core.annotatedTypeSubject v1)),+    Core.annotatedTermAnnotation = (Core.annotatedTypeAnnotation v1)}))+  Core.TypeApplication v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "application"),+      Core.fieldTerm = (applicationType v1)}}))+  Core.TypeFunction v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "function"),+      Core.fieldTerm = (functionType v1)}}))+  Core.TypeForall v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "forall"),+      Core.fieldTerm = (forallType v1)}}))+  Core.TypeList v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "list"),+      Core.fieldTerm = (type_ v1)}}))+  Core.TypeLiteral v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "literal"),+      Core.fieldTerm = (literalType v1)}}))+  Core.TypeMap v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "map"),+      Core.fieldTerm = (mapType v1)}}))+  Core.TypeOptional v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "optional"),+      Core.fieldTerm = (type_ v1)}}))+  Core.TypeProduct v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "product"),+      Core.fieldTerm = (Core.TermList (Lists.map type_ v1))}}))+  Core.TypeRecord v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "record"),+      Core.fieldTerm = (rowType v1)}}))+  Core.TypeSet v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "set"),+      Core.fieldTerm = (type_ v1)}}))+  Core.TypeSum v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "sum"),+      Core.fieldTerm = (Core.TermList (Lists.map type_ v1))}}))+  Core.TypeUnion v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "union"),+      Core.fieldTerm = (rowType v1)}}))+  Core.TypeUnit -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "unit"),+      Core.fieldTerm = Core.TermUnit}}))+  Core.TypeVariable v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "variable"),+      Core.fieldTerm = (name v1)}}))+  Core.TypeWrap v1 -> (Core.TermUnion (Core.Injection {+    Core.injectionTypeName = (Core.Name "hydra.core.Type"),+    Core.injectionField = Core.Field {+      Core.fieldName = (Core.Name "wrap"),+      Core.fieldTerm = (wrappedType v1)}}))++typeLambda :: (Core.TypeLambda -> Core.Term)+typeLambda l = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.TypeLambda"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "parameter"),+      Core.fieldTerm = (name (Core.typeLambdaParameter l))},+    Core.Field {+      Core.fieldName = (Core.Name "body"),+      Core.fieldTerm = (term (Core.typeLambdaBody l))}]}))++typeScheme :: (Core.TypeScheme -> Core.Term)+typeScheme ts = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.TypeScheme"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "variables"),+      Core.fieldTerm = (Core.TermList (Lists.map name (Core.typeSchemeVariables ts)))},+    Core.Field {+      Core.fieldName = (Core.Name "type"),+      Core.fieldTerm = (type_ (Core.typeSchemeType ts))}]}))++typedTerm :: (Core.TypedTerm -> Core.Term)+typedTerm tt = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.TypedTerm"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "term"),+      Core.fieldTerm = (term (Core.typedTermTerm tt))},+    Core.Field {+      Core.fieldName = (Core.Name "type"),+      Core.fieldTerm = (type_ (Core.typedTermType tt))}]}))++wrappedTerm :: (Core.WrappedTerm -> Core.Term)+wrappedTerm n = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.WrappedTerm"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.wrappedTermTypeName n))},+    Core.Field {+      Core.fieldName = (Core.Name "object"),+      Core.fieldTerm = (term (Core.wrappedTermObject n))}]}))++wrappedType :: (Core.WrappedType -> Core.Term)+wrappedType nt = (Core.TermRecord (Core.Record {+  Core.recordTypeName = (Core.Name "hydra.core.WrappedType"),+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "typeName"),+      Core.fieldTerm = (name (Core.wrappedTypeTypeName nt))},+    Core.Field {+      Core.fieldName = (Core.Name "object"),+      Core.fieldTerm = (type_ (Core.wrappedTypeObject nt))}]}))++-- | Determines whether a given term is an encoded type+isEncodedType :: (Core.Term -> Bool)+isEncodedType t = ((\x -> case x of+  Core.TermApplication v1 -> (isEncodedType (Core.applicationFunction v1))+  Core.TermUnion v1 -> (Equality.equal "hydra.core.Type" (Core.unName (Core.injectionTypeName v1)))+  _ -> False) (Rewriting.deannotateTerm t))++isType :: (Core.Type -> Bool)+isType t = ((\x -> case x of+  Core.TypeApplication v1 -> (isType (Core.applicationTypeFunction v1))+  Core.TypeForall v1 -> (isType (Core.forallTypeBody v1))+  Core.TypeUnion v1 -> (Equality.equal "hydra.core.Type" (Core.unName (Core.rowTypeTypeName v1)))+  Core.TypeVariable v1 -> (Equality.equal v1 (Core.Name "hydra.core.Type"))+  _ -> False) (Rewriting.deannotateType t))++isUnitTerm :: (Core.Term -> Bool)+isUnitTerm x = case x of+  Core.TermUnit -> True+  _ -> False++isUnitType :: (Core.Type -> Bool)+isUnitType x = case x of+  Core.TypeUnit -> True+  _ -> False
− src/gen-main/haskell/Hydra/Ext/Csharp/Syntax.hs 
@@ -1,4949 +0,0 @@--- | A C# syntax module based on the ANTLR grammar dated 02/07/2024 and available at:--- |   https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/language-specification/grammar--module Hydra.Ext.Csharp.Syntax where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--newtype Identifier = -  Identifier {-    unIdentifier :: String}-  deriving (Eq, Ord, Read, Show)--_Identifier = (Core.Name "hydra/ext/csharp/syntax.Identifier")--newtype Keyword = -  Keyword {-    unKeyword :: String}-  deriving (Eq, Ord, Read, Show)--_Keyword = (Core.Name "hydra/ext/csharp/syntax.Keyword")--data Literal = -  LiteralBoolean Bool |-  LiteralInteger IntegerLiteral |-  LiteralReal Double |-  LiteralCharacter String |-  LiteralString String |-  LiteralNull -  deriving (Eq, Ord, Read, Show)--_Literal = (Core.Name "hydra/ext/csharp/syntax.Literal")--_Literal_boolean = (Core.Name "boolean")--_Literal_integer = (Core.Name "integer")--_Literal_real = (Core.Name "real")--_Literal_character = (Core.Name "character")--_Literal_string = (Core.Name "string")--_Literal_null = (Core.Name "null")--data IntegerLiteral = -  IntegerLiteralDecimal String |-  IntegerLiteralHexadecimal String |-  IntegerLiteralBinary Integer-  deriving (Eq, Ord, Read, Show)--_IntegerLiteral = (Core.Name "hydra/ext/csharp/syntax.IntegerLiteral")--_IntegerLiteral_decimal = (Core.Name "decimal")--_IntegerLiteral_hexadecimal = (Core.Name "hexadecimal")--_IntegerLiteral_binary = (Core.Name "binary")--newtype NamespaceName = -  NamespaceName {-    unNamespaceName :: NamespaceOrTypeName}-  deriving (Eq, Ord, Read, Show)--_NamespaceName = (Core.Name "hydra/ext/csharp/syntax.NamespaceName")--newtype TypeName = -  TypeName {-    unTypeName :: NamespaceOrTypeName}-  deriving (Eq, Ord, Read, Show)--_TypeName = (Core.Name "hydra/ext/csharp/syntax.TypeName")--data NamespaceOrTypeName = -  NamespaceOrTypeNameIdentifier IdentifierNamespaceOrTypeName |-  NamespaceOrTypeNameQualified QualifiedNamespaceOrTypeName |-  NamespaceOrTypeNameAlias QualifiedAliasMember-  deriving (Eq, Ord, Read, Show)--_NamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.NamespaceOrTypeName")--_NamespaceOrTypeName_identifier = (Core.Name "identifier")--_NamespaceOrTypeName_qualified = (Core.Name "qualified")--_NamespaceOrTypeName_alias = (Core.Name "alias")--data IdentifierNamespaceOrTypeName = -  IdentifierNamespaceOrTypeName {-    identifierNamespaceOrTypeNameIdentifier :: Identifier,-    identifierNamespaceOrTypeNameArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_IdentifierNamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.IdentifierNamespaceOrTypeName")--_IdentifierNamespaceOrTypeName_identifier = (Core.Name "identifier")--_IdentifierNamespaceOrTypeName_arguments = (Core.Name "arguments")--data QualifiedNamespaceOrTypeName = -  QualifiedNamespaceOrTypeName {-    qualifiedNamespaceOrTypeNameNamespaceOrType :: NamespaceOrTypeName,-    qualifiedNamespaceOrTypeNameIdentifier :: Identifier,-    qualifiedNamespaceOrTypeNameArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_QualifiedNamespaceOrTypeName = (Core.Name "hydra/ext/csharp/syntax.QualifiedNamespaceOrTypeName")--_QualifiedNamespaceOrTypeName_namespaceOrType = (Core.Name "namespaceOrType")--_QualifiedNamespaceOrTypeName_identifier = (Core.Name "identifier")--_QualifiedNamespaceOrTypeName_arguments = (Core.Name "arguments")--data Type = -  TypeReference ReferenceType |-  TypeValue ValueType |-  TypeParam TypeParameter |-  TypePointer PointerType-  deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/csharp/syntax.Type")--_Type_reference = (Core.Name "reference")--_Type_value = (Core.Name "value")--_Type_param = (Core.Name "param")--_Type_pointer = (Core.Name "pointer")--data ReferenceType = -  ReferenceTypeClass ClassType |-  ReferenceTypeInterface InterfaceType |-  ReferenceTypeArray ArrayType |-  ReferenceTypeDelegate DelegateType |-  ReferenceTypeDynamic -  deriving (Eq, Ord, Read, Show)--_ReferenceType = (Core.Name "hydra/ext/csharp/syntax.ReferenceType")--_ReferenceType_class = (Core.Name "class")--_ReferenceType_interface = (Core.Name "interface")--_ReferenceType_array = (Core.Name "array")--_ReferenceType_delegate = (Core.Name "delegate")--_ReferenceType_dynamic = (Core.Name "dynamic")--data ClassType = -  ClassTypeTypeName TypeName |-  ClassTypeObject  |-  ClassTypeString -  deriving (Eq, Ord, Read, Show)--_ClassType = (Core.Name "hydra/ext/csharp/syntax.ClassType")--_ClassType_typeName = (Core.Name "typeName")--_ClassType_object = (Core.Name "object")--_ClassType_string = (Core.Name "string")--newtype InterfaceType = -  InterfaceType {-    unInterfaceType :: TypeName}-  deriving (Eq, Ord, Read, Show)--_InterfaceType = (Core.Name "hydra/ext/csharp/syntax.InterfaceType")--data ArrayType = -  ArrayType {-    arrayTypeType :: NonArrayType,-    arrayTypeRank :: [RankSpecifier]}-  deriving (Eq, Ord, Read, Show)--_ArrayType = (Core.Name "hydra/ext/csharp/syntax.ArrayType")--_ArrayType_type = (Core.Name "type")--_ArrayType_rank = (Core.Name "rank")--data NonArrayType = -  NonArrayTypeValue ValueType |-  NonArrayTypeClass ClassType |-  NonArrayTypeInterface InterfaceType |-  NonArrayTypeDelegate DelegateType |-  NonArrayTypeDynamic  |-  NonArrayTypeParameter TypeParameter |-  NonArrayTypePointer PointerType-  deriving (Eq, Ord, Read, Show)--_NonArrayType = (Core.Name "hydra/ext/csharp/syntax.NonArrayType")--_NonArrayType_value = (Core.Name "value")--_NonArrayType_class = (Core.Name "class")--_NonArrayType_interface = (Core.Name "interface")--_NonArrayType_delegate = (Core.Name "delegate")--_NonArrayType_dynamic = (Core.Name "dynamic")--_NonArrayType_parameter = (Core.Name "parameter")--_NonArrayType_pointer = (Core.Name "pointer")--newtype RankSpecifier = -  RankSpecifier {-    unRankSpecifier :: Int}-  deriving (Eq, Ord, Read, Show)--_RankSpecifier = (Core.Name "hydra/ext/csharp/syntax.RankSpecifier")--newtype DelegateType = -  DelegateType {-    unDelegateType :: TypeName}-  deriving (Eq, Ord, Read, Show)--_DelegateType = (Core.Name "hydra/ext/csharp/syntax.DelegateType")--data ValueType = -  ValueTypeNonNullable StructOrEnumType |-  ValueTypeNullable StructOrEnumType-  deriving (Eq, Ord, Read, Show)--_ValueType = (Core.Name "hydra/ext/csharp/syntax.ValueType")--_ValueType_nonNullable = (Core.Name "nonNullable")--_ValueType_nullable = (Core.Name "nullable")--data StructOrEnumType = -  StructOrEnumTypeStruct StructType |-  StructOrEnumTypeEnum EnumType-  deriving (Eq, Ord, Read, Show)--_StructOrEnumType = (Core.Name "hydra/ext/csharp/syntax.StructOrEnumType")--_StructOrEnumType_struct = (Core.Name "struct")--_StructOrEnumType_enum = (Core.Name "enum")--data StructType = -  StructTypeTypeName TypeName |-  StructTypeSimple SimpleType |-  StructTypeTuple TupleType-  deriving (Eq, Ord, Read, Show)--_StructType = (Core.Name "hydra/ext/csharp/syntax.StructType")--_StructType_typeName = (Core.Name "typeName")--_StructType_simple = (Core.Name "simple")--_StructType_tuple = (Core.Name "tuple")--data SimpleType = -  SimpleTypeNumeric NumericType |-  SimpleTypeBool -  deriving (Eq, Ord, Read, Show)--_SimpleType = (Core.Name "hydra/ext/csharp/syntax.SimpleType")--_SimpleType_numeric = (Core.Name "numeric")--_SimpleType_bool = (Core.Name "bool")--data NumericType = -  NumericTypeIntegral IntegralType |-  NumericTypeFloatingPoint FloatingPointType |-  NumericTypeDecimal -  deriving (Eq, Ord, Read, Show)--_NumericType = (Core.Name "hydra/ext/csharp/syntax.NumericType")--_NumericType_integral = (Core.Name "integral")--_NumericType_floatingPoint = (Core.Name "floatingPoint")--_NumericType_decimal = (Core.Name "decimal")--data IntegralType = -  IntegralTypeSbyte  |-  IntegralTypeByte  |-  IntegralTypeShort  |-  IntegralTypeUshort  |-  IntegralTypeInt  |-  IntegralTypeUint  |-  IntegralTypeLong  |-  IntegralTypeUlong  |-  IntegralTypeChar -  deriving (Eq, Ord, Read, Show)--_IntegralType = (Core.Name "hydra/ext/csharp/syntax.IntegralType")--_IntegralType_sbyte = (Core.Name "sbyte")--_IntegralType_byte = (Core.Name "byte")--_IntegralType_short = (Core.Name "short")--_IntegralType_ushort = (Core.Name "ushort")--_IntegralType_int = (Core.Name "int")--_IntegralType_uint = (Core.Name "uint")--_IntegralType_long = (Core.Name "long")--_IntegralType_ulong = (Core.Name "ulong")--_IntegralType_char = (Core.Name "char")--data FloatingPointType = -  FloatingPointTypeFloat  |-  FloatingPointTypeDouble -  deriving (Eq, Ord, Read, Show)--_FloatingPointType = (Core.Name "hydra/ext/csharp/syntax.FloatingPointType")--_FloatingPointType_float = (Core.Name "float")--_FloatingPointType_double = (Core.Name "double")--newtype TupleType = -  TupleType {-    unTupleType :: [TupleTypeElement]}-  deriving (Eq, Ord, Read, Show)--_TupleType = (Core.Name "hydra/ext/csharp/syntax.TupleType")--data TupleTypeElement = -  TupleTypeElement {-    tupleTypeElementType :: Type,-    tupleTypeElementIdentifier :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_TupleTypeElement = (Core.Name "hydra/ext/csharp/syntax.TupleTypeElement")--_TupleTypeElement_type = (Core.Name "type")--_TupleTypeElement_identifier = (Core.Name "identifier")--newtype EnumType = -  EnumType {-    unEnumType :: TypeName}-  deriving (Eq, Ord, Read, Show)--_EnumType = (Core.Name "hydra/ext/csharp/syntax.EnumType")--newtype TypeArgumentList = -  TypeArgumentList {-    unTypeArgumentList :: [Type]}-  deriving (Eq, Ord, Read, Show)--_TypeArgumentList = (Core.Name "hydra/ext/csharp/syntax.TypeArgumentList")--newtype TypeParameter = -  TypeParameter {-    unTypeParameter :: Identifier}-  deriving (Eq, Ord, Read, Show)--_TypeParameter = (Core.Name "hydra/ext/csharp/syntax.TypeParameter")--data UnmanagedType = -  UnmanagedTypeValue ValueType |-  UnmanagedTypePointer PointerType-  deriving (Eq, Ord, Read, Show)--_UnmanagedType = (Core.Name "hydra/ext/csharp/syntax.UnmanagedType")--_UnmanagedType_value = (Core.Name "value")--_UnmanagedType_pointer = (Core.Name "pointer")--newtype VariableReference = -  VariableReference {-    unVariableReference :: Expression}-  deriving (Eq, Ord, Read, Show)--_VariableReference = (Core.Name "hydra/ext/csharp/syntax.VariableReference")--data Pattern = -  PatternDeclaration DeclarationPattern |-  PatternConstant Expression |-  PatternVar Designation-  deriving (Eq, Ord, Read, Show)--_Pattern = (Core.Name "hydra/ext/csharp/syntax.Pattern")--_Pattern_declaration = (Core.Name "declaration")--_Pattern_constant = (Core.Name "constant")--_Pattern_var = (Core.Name "var")--data DeclarationPattern = -  DeclarationPattern {-    declarationPatternType :: Type,-    declarationPatternDesignation :: Designation}-  deriving (Eq, Ord, Read, Show)--_DeclarationPattern = (Core.Name "hydra/ext/csharp/syntax.DeclarationPattern")--_DeclarationPattern_type = (Core.Name "type")--_DeclarationPattern_designation = (Core.Name "designation")--newtype Designation = -  Designation {-    unDesignation :: Identifier}-  deriving (Eq, Ord, Read, Show)--_Designation = (Core.Name "hydra/ext/csharp/syntax.Designation")--newtype ArgumentList = -  ArgumentList {-    unArgumentList :: [Argument]}-  deriving (Eq, Ord, Read, Show)--_ArgumentList = (Core.Name "hydra/ext/csharp/syntax.ArgumentList")--data Argument = -  Argument {-    argumentName :: (Maybe Identifier),-    argumentValue :: ArgumentValue}-  deriving (Eq, Ord, Read, Show)--_Argument = (Core.Name "hydra/ext/csharp/syntax.Argument")--_Argument_name = (Core.Name "name")--_Argument_value = (Core.Name "value")--data ArgumentValue = -  ArgumentValueExpression Expression |-  ArgumentValueIn VariableReference |-  ArgumentValueRef VariableReference |-  ArgumentValueOut VariableReference-  deriving (Eq, Ord, Read, Show)--_ArgumentValue = (Core.Name "hydra/ext/csharp/syntax.ArgumentValue")--_ArgumentValue_expression = (Core.Name "expression")--_ArgumentValue_in = (Core.Name "in")--_ArgumentValue_ref = (Core.Name "ref")--_ArgumentValue_out = (Core.Name "out")--data PrimaryExpression = -  PrimaryExpressionNoArray PrimaryNoArrayCreationExpression |-  PrimaryExpressionArray ArrayCreationExpression-  deriving (Eq, Ord, Read, Show)--_PrimaryExpression = (Core.Name "hydra/ext/csharp/syntax.PrimaryExpression")--_PrimaryExpression_noArray = (Core.Name "noArray")--_PrimaryExpression_array = (Core.Name "array")--data PrimaryNoArrayCreationExpression = -  PrimaryNoArrayCreationExpressionLiteral Literal |-  PrimaryNoArrayCreationExpressionInterpolatedString InterpolatedStringExpression |-  PrimaryNoArrayCreationExpressionSimpleName SimpleName |-  PrimaryNoArrayCreationExpressionParenthesized Expression |-  PrimaryNoArrayCreationExpressionTuple TupleExpression |-  PrimaryNoArrayCreationExpressionMemberAccess MemberAccess |-  PrimaryNoArrayCreationExpressionNullConditionalMemberAccess NullConditionalMemberAccess |-  PrimaryNoArrayCreationExpressionInvocation InvocationExpression |-  PrimaryNoArrayCreationExpressionElementAccess ElementAccess |-  PrimaryNoArrayCreationExpressionNullConditionalElementAccess NullConditionalElementAccess |-  PrimaryNoArrayCreationExpressionThisAccess  |-  PrimaryNoArrayCreationExpressionBaseAccess BaseAccess |-  PrimaryNoArrayCreationExpressionPostIncrement PrimaryExpression |-  PrimaryNoArrayCreationExpressionPostDecrement PrimaryExpression |-  PrimaryNoArrayCreationExpressionObjectCreation ObjectCreationExpression |-  PrimaryNoArrayCreationExpressionDelegateCreation DelegateCreationExpression |-  PrimaryNoArrayCreationExpressionAnonymousObjectCreation (Maybe MemberDeclaratorList) |-  PrimaryNoArrayCreationExpressionTypeof TypeofExpression |-  PrimaryNoArrayCreationExpressionSizeof UnmanagedType |-  PrimaryNoArrayCreationExpressionChecked Expression |-  PrimaryNoArrayCreationExpressionUnchecked Expression |-  PrimaryNoArrayCreationExpressionDefaultValue DefaultValueExpression |-  PrimaryNoArrayCreationExpressionNameof NamedEntity |-  PrimaryNoArrayCreationExpressionAnonymousMethod AnonymousMethodExpression |-  PrimaryNoArrayCreationExpressionPointerMemberAccess PointerMemberAccess |-  PrimaryNoArrayCreationExpressionPointerElementAccess PointerElementAccess |-  PrimaryNoArrayCreationExpressionStackalloc StackallocExpression-  deriving (Eq, Ord, Read, Show)--_PrimaryNoArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.PrimaryNoArrayCreationExpression")--_PrimaryNoArrayCreationExpression_literal = (Core.Name "literal")--_PrimaryNoArrayCreationExpression_interpolatedString = (Core.Name "interpolatedString")--_PrimaryNoArrayCreationExpression_simpleName = (Core.Name "simpleName")--_PrimaryNoArrayCreationExpression_parenthesized = (Core.Name "parenthesized")--_PrimaryNoArrayCreationExpression_tuple = (Core.Name "tuple")--_PrimaryNoArrayCreationExpression_memberAccess = (Core.Name "memberAccess")--_PrimaryNoArrayCreationExpression_nullConditionalMemberAccess = (Core.Name "nullConditionalMemberAccess")--_PrimaryNoArrayCreationExpression_invocation = (Core.Name "invocation")--_PrimaryNoArrayCreationExpression_elementAccess = (Core.Name "elementAccess")--_PrimaryNoArrayCreationExpression_nullConditionalElementAccess = (Core.Name "nullConditionalElementAccess")--_PrimaryNoArrayCreationExpression_thisAccess = (Core.Name "thisAccess")--_PrimaryNoArrayCreationExpression_baseAccess = (Core.Name "baseAccess")--_PrimaryNoArrayCreationExpression_postIncrement = (Core.Name "postIncrement")--_PrimaryNoArrayCreationExpression_postDecrement = (Core.Name "postDecrement")--_PrimaryNoArrayCreationExpression_objectCreation = (Core.Name "objectCreation")--_PrimaryNoArrayCreationExpression_delegateCreation = (Core.Name "delegateCreation")--_PrimaryNoArrayCreationExpression_anonymousObjectCreation = (Core.Name "anonymousObjectCreation")--_PrimaryNoArrayCreationExpression_typeof = (Core.Name "typeof")--_PrimaryNoArrayCreationExpression_sizeof = (Core.Name "sizeof")--_PrimaryNoArrayCreationExpression_checked = (Core.Name "checked")--_PrimaryNoArrayCreationExpression_unchecked = (Core.Name "unchecked")--_PrimaryNoArrayCreationExpression_defaultValue = (Core.Name "defaultValue")--_PrimaryNoArrayCreationExpression_nameof = (Core.Name "nameof")--_PrimaryNoArrayCreationExpression_anonymousMethod = (Core.Name "anonymousMethod")--_PrimaryNoArrayCreationExpression_pointerMemberAccess = (Core.Name "pointerMemberAccess")--_PrimaryNoArrayCreationExpression_pointerElementAccess = (Core.Name "pointerElementAccess")--_PrimaryNoArrayCreationExpression_stackalloc = (Core.Name "stackalloc")--data InterpolatedStringExpression = -  InterpolatedStringExpressionRegular InterpolatedRegularStringExpression |-  InterpolatedStringExpressionVerbatim InterpolatedVerbatimStringExpression-  deriving (Eq, Ord, Read, Show)--_InterpolatedStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedStringExpression")--_InterpolatedStringExpression_regular = (Core.Name "regular")--_InterpolatedStringExpression_verbatim = (Core.Name "verbatim")--newtype InterpolatedRegularStringExpression = -  InterpolatedRegularStringExpression {-    unInterpolatedRegularStringExpression :: String}-  deriving (Eq, Ord, Read, Show)--_InterpolatedRegularStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedRegularStringExpression")--data RegularInterpolation = -  RegularInterpolation {-    regularInterpolationExpression :: Expression,-    regularInterpolationWidth :: (Maybe Expression),-    regularInterpolationFormat :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_RegularInterpolation = (Core.Name "hydra/ext/csharp/syntax.RegularInterpolation")--_RegularInterpolation_expression = (Core.Name "expression")--_RegularInterpolation_width = (Core.Name "width")--_RegularInterpolation_format = (Core.Name "format")--newtype InterpolatedVerbatimStringExpression = -  InterpolatedVerbatimStringExpression {-    unInterpolatedVerbatimStringExpression :: String}-  deriving (Eq, Ord, Read, Show)--_InterpolatedVerbatimStringExpression = (Core.Name "hydra/ext/csharp/syntax.InterpolatedVerbatimStringExpression")--data VerbatimInterpolation = -  VerbatimInterpolation {-    verbatimInterpolationExpression :: Expression,-    verbatimInterpolationWidth :: (Maybe ConstantExpression),-    verbatimInterpolationFormat :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_VerbatimInterpolation = (Core.Name "hydra/ext/csharp/syntax.VerbatimInterpolation")--_VerbatimInterpolation_expression = (Core.Name "expression")--_VerbatimInterpolation_width = (Core.Name "width")--_VerbatimInterpolation_format = (Core.Name "format")--data SimpleName = -  SimpleName {-    simpleNameIdentifier :: Identifier,-    simpleNameTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_SimpleName = (Core.Name "hydra/ext/csharp/syntax.SimpleName")--_SimpleName_identifier = (Core.Name "identifier")--_SimpleName_typeArguments = (Core.Name "typeArguments")--data TupleExpression = -  TupleExpressionElements [TupleElement] |-  TupleExpressionDeconstruction DeconstructionTuple-  deriving (Eq, Ord, Read, Show)--_TupleExpression = (Core.Name "hydra/ext/csharp/syntax.TupleExpression")--_TupleExpression_elements = (Core.Name "elements")--_TupleExpression_deconstruction = (Core.Name "deconstruction")--data TupleElement = -  TupleElement {-    tupleElementName :: (Maybe Identifier),-    tupleElementExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_TupleElement = (Core.Name "hydra/ext/csharp/syntax.TupleElement")--_TupleElement_name = (Core.Name "name")--_TupleElement_expression = (Core.Name "expression")--newtype DeconstructionTuple = -  DeconstructionTuple {-    unDeconstructionTuple :: [DeconstructionElement]}-  deriving (Eq, Ord, Read, Show)--_DeconstructionTuple = (Core.Name "hydra/ext/csharp/syntax.DeconstructionTuple")--data DeconstructionElement = -  DeconstructionElementTuple DeconstructionTuple |-  DeconstructionElementIdentifier Identifier-  deriving (Eq, Ord, Read, Show)--_DeconstructionElement = (Core.Name "hydra/ext/csharp/syntax.DeconstructionElement")--_DeconstructionElement_tuple = (Core.Name "tuple")--_DeconstructionElement_identifier = (Core.Name "identifier")--data MemberAccess = -  MemberAccess {-    memberAccessHead :: MemberAccessHead,-    memberAccessIdentifier :: Identifier,-    memberAccessTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_MemberAccess = (Core.Name "hydra/ext/csharp/syntax.MemberAccess")--_MemberAccess_head = (Core.Name "head")--_MemberAccess_identifier = (Core.Name "identifier")--_MemberAccess_typeArguments = (Core.Name "typeArguments")--data MemberAccessHead = -  MemberAccessHeadPrimary PrimaryExpression |-  MemberAccessHeadPredefined PredefinedType |-  MemberAccessHeadQualifiedAlias QualifiedAliasMember-  deriving (Eq, Ord, Read, Show)--_MemberAccessHead = (Core.Name "hydra/ext/csharp/syntax.MemberAccessHead")--_MemberAccessHead_primary = (Core.Name "primary")--_MemberAccessHead_predefined = (Core.Name "predefined")--_MemberAccessHead_qualifiedAlias = (Core.Name "qualifiedAlias")--data PredefinedType = -  PredefinedTypeBool  |-  PredefinedTypeByte  |-  PredefinedTypeChar  |-  PredefinedTypeDecimal  |-  PredefinedTypeDouble  |-  PredefinedTypeFloat  |-  PredefinedTypeInt  |-  PredefinedTypeLong  |-  PredefinedTypeObject  |-  PredefinedTypeSbyte  |-  PredefinedTypeShort  |-  PredefinedTypeString  |-  PredefinedTypeUint  |-  PredefinedTypeUlong  |-  PredefinedTypeUshort -  deriving (Eq, Ord, Read, Show)--_PredefinedType = (Core.Name "hydra/ext/csharp/syntax.PredefinedType")--_PredefinedType_bool = (Core.Name "bool")--_PredefinedType_byte = (Core.Name "byte")--_PredefinedType_char = (Core.Name "char")--_PredefinedType_decimal = (Core.Name "decimal")--_PredefinedType_double = (Core.Name "double")--_PredefinedType_float = (Core.Name "float")--_PredefinedType_int = (Core.Name "int")--_PredefinedType_long = (Core.Name "long")--_PredefinedType_object = (Core.Name "object")--_PredefinedType_sbyte = (Core.Name "sbyte")--_PredefinedType_short = (Core.Name "short")--_PredefinedType_string = (Core.Name "string")--_PredefinedType_uint = (Core.Name "uint")--_PredefinedType_ulong = (Core.Name "ulong")--_PredefinedType_ushort = (Core.Name "ushort")--data NullConditionalMemberAccess = -  NullConditionalMemberAccess {-    nullConditionalMemberAccessExpression :: PrimaryExpression,-    nullConditionalMemberAccessIdentifier :: Identifier,-    nullConditionalMemberAccessTypeArguments :: (Maybe TypeArgumentList),-    nullConditionalMemberAccessDependentAccess :: [DependentAccess]}-  deriving (Eq, Ord, Read, Show)--_NullConditionalMemberAccess = (Core.Name "hydra/ext/csharp/syntax.NullConditionalMemberAccess")--_NullConditionalMemberAccess_expression = (Core.Name "expression")--_NullConditionalMemberAccess_identifier = (Core.Name "identifier")--_NullConditionalMemberAccess_typeArguments = (Core.Name "typeArguments")--_NullConditionalMemberAccess_dependentAccess = (Core.Name "dependentAccess")--data DependentAccess = -  DependentAccessMemberAccess DependentAccessForMember |-  DependentAccessElementAccess ArgumentList |-  DependentAccessInvocation (Maybe ArgumentList)-  deriving (Eq, Ord, Read, Show)--_DependentAccess = (Core.Name "hydra/ext/csharp/syntax.DependentAccess")--_DependentAccess_memberAccess = (Core.Name "memberAccess")--_DependentAccess_elementAccess = (Core.Name "elementAccess")--_DependentAccess_invocation = (Core.Name "invocation")--data DependentAccessForMember = -  DependentAccessForMember {-    dependentAccessForMemberIdentifier :: Identifier,-    dependentAccessForMemberTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_DependentAccessForMember = (Core.Name "hydra/ext/csharp/syntax.DependentAccessForMember")--_DependentAccessForMember_identifier = (Core.Name "identifier")--_DependentAccessForMember_typeArguments = (Core.Name "typeArguments")--data NullConditionalProjectionInitializer = -  NullConditionalProjectionInitializer {-    nullConditionalProjectionInitializerExpression :: PrimaryExpression,-    nullConditionalProjectionInitializerIdentifier :: Identifier,-    nullConditionalProjectionInitializerTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_NullConditionalProjectionInitializer = (Core.Name "hydra/ext/csharp/syntax.NullConditionalProjectionInitializer")--_NullConditionalProjectionInitializer_expression = (Core.Name "expression")--_NullConditionalProjectionInitializer_identifier = (Core.Name "identifier")--_NullConditionalProjectionInitializer_typeArguments = (Core.Name "typeArguments")--data InvocationExpression = -  InvocationExpression {-    invocationExpressionExpression :: PrimaryExpression,-    invocationExpressionArguments :: (Maybe ArgumentList)}-  deriving (Eq, Ord, Read, Show)--_InvocationExpression = (Core.Name "hydra/ext/csharp/syntax.InvocationExpression")--_InvocationExpression_expression = (Core.Name "expression")--_InvocationExpression_arguments = (Core.Name "arguments")--data NullConditionalInvocationExpression = -  NullConditionalInvocationExpression {-    nullConditionalInvocationExpressionHead :: NullConditionalInvocationExpressionHead,-    nullConditionalInvocationExpressionArguments :: (Maybe ArgumentList)}-  deriving (Eq, Ord, Read, Show)--_NullConditionalInvocationExpression = (Core.Name "hydra/ext/csharp/syntax.NullConditionalInvocationExpression")--_NullConditionalInvocationExpression_head = (Core.Name "head")--_NullConditionalInvocationExpression_arguments = (Core.Name "arguments")--data NullConditionalInvocationExpressionHead = -  NullConditionalInvocationExpressionHeadMember NullConditionalMemberAccess |-  NullConditionalInvocationExpressionHeadElement NullConditionalElementAccess-  deriving (Eq, Ord, Read, Show)--_NullConditionalInvocationExpressionHead = (Core.Name "hydra/ext/csharp/syntax.NullConditionalInvocationExpressionHead")--_NullConditionalInvocationExpressionHead_member = (Core.Name "member")--_NullConditionalInvocationExpressionHead_element = (Core.Name "element")--data ElementAccess = -  ElementAccess {-    elementAccessExpression :: PrimaryNoArrayCreationExpression,-    elementAccessArguments :: ArgumentList}-  deriving (Eq, Ord, Read, Show)--_ElementAccess = (Core.Name "hydra/ext/csharp/syntax.ElementAccess")--_ElementAccess_expression = (Core.Name "expression")--_ElementAccess_arguments = (Core.Name "arguments")--data NullConditionalElementAccess = -  NullConditionalElementAccess {-    nullConditionalElementAccessExpression :: PrimaryNoArrayCreationExpression,-    nullConditionalElementAccessArguments :: ArgumentList,-    nullConditionalElementAccessDependentAccess :: [DependentAccess]}-  deriving (Eq, Ord, Read, Show)--_NullConditionalElementAccess = (Core.Name "hydra/ext/csharp/syntax.NullConditionalElementAccess")--_NullConditionalElementAccess_expression = (Core.Name "expression")--_NullConditionalElementAccess_arguments = (Core.Name "arguments")--_NullConditionalElementAccess_dependentAccess = (Core.Name "dependentAccess")--data BaseAccess = -  BaseAccessIdentifier BaseAccessWithIdentifier |-  BaseAccessArguments ArgumentList-  deriving (Eq, Ord, Read, Show)--_BaseAccess = (Core.Name "hydra/ext/csharp/syntax.BaseAccess")--_BaseAccess_identifier = (Core.Name "identifier")--_BaseAccess_arguments = (Core.Name "arguments")--data BaseAccessWithIdentifier = -  BaseAccessWithIdentifier {-    baseAccessWithIdentifierIdentifier :: Identifier,-    baseAccessWithIdentifierTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_BaseAccessWithIdentifier = (Core.Name "hydra/ext/csharp/syntax.BaseAccessWithIdentifier")--_BaseAccessWithIdentifier_identifier = (Core.Name "identifier")--_BaseAccessWithIdentifier_typeArguments = (Core.Name "typeArguments")--data ObjectCreationExpression = -  ObjectCreationExpression {-    objectCreationExpressionType :: Type,-    objectCreationExpressionArguments :: (Maybe ArgumentList),-    objectCreationExpressionInitializer :: (Maybe ObjectOrCollectionInitializer)}-  deriving (Eq, Ord, Read, Show)--_ObjectCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ObjectCreationExpression")--_ObjectCreationExpression_type = (Core.Name "type")--_ObjectCreationExpression_arguments = (Core.Name "arguments")--_ObjectCreationExpression_initializer = (Core.Name "initializer")--data ObjectOrCollectionInitializer = -  ObjectOrCollectionInitializerObject [MemberInitializer] |-  ObjectOrCollectionInitializerCollection [ElementInitializer]-  deriving (Eq, Ord, Read, Show)--_ObjectOrCollectionInitializer = (Core.Name "hydra/ext/csharp/syntax.ObjectOrCollectionInitializer")--_ObjectOrCollectionInitializer_object = (Core.Name "object")--_ObjectOrCollectionInitializer_collection = (Core.Name "collection")--data MemberInitializer = -  MemberInitializer {-    memberInitializerTarget :: InitializerTarget,-    memberInitializerValue :: InitializerValue}-  deriving (Eq, Ord, Read, Show)--_MemberInitializer = (Core.Name "hydra/ext/csharp/syntax.MemberInitializer")--_MemberInitializer_target = (Core.Name "target")--_MemberInitializer_value = (Core.Name "value")--data InitializerTarget = -  InitializerTargetIdentifier Identifier |-  InitializerTargetArguments ArgumentList-  deriving (Eq, Ord, Read, Show)--_InitializerTarget = (Core.Name "hydra/ext/csharp/syntax.InitializerTarget")--_InitializerTarget_identifier = (Core.Name "identifier")--_InitializerTarget_arguments = (Core.Name "arguments")--data InitializerValue = -  InitializerValueExpression Expression |-  InitializerValueObjectOrCollection ObjectOrCollectionInitializer-  deriving (Eq, Ord, Read, Show)--_InitializerValue = (Core.Name "hydra/ext/csharp/syntax.InitializerValue")--_InitializerValue_expression = (Core.Name "expression")--_InitializerValue_objectOrCollection = (Core.Name "objectOrCollection")--data ElementInitializer = -  ElementInitializerSingle NonAssignmentExpression |-  ElementInitializerList ExpressionList-  deriving (Eq, Ord, Read, Show)--_ElementInitializer = (Core.Name "hydra/ext/csharp/syntax.ElementInitializer")--_ElementInitializer_single = (Core.Name "single")--_ElementInitializer_list = (Core.Name "list")--newtype ExpressionList = -  ExpressionList {-    unExpressionList :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_ExpressionList = (Core.Name "hydra/ext/csharp/syntax.ExpressionList")--data ArrayCreationExpression = -  ArrayCreationExpressionNonArrayType NonArrayTypeArrayCreationExpression |-  ArrayCreationExpressionArrayType ArrayTypeArrayCreationExpression |-  ArrayCreationExpressionRankSpecifier RankSpecifierArrayCreationExpression-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ArrayCreationExpression")--_ArrayCreationExpression_nonArrayType = (Core.Name "nonArrayType")--_ArrayCreationExpression_arrayType = (Core.Name "arrayType")--_ArrayCreationExpression_rankSpecifier = (Core.Name "rankSpecifier")--data NonArrayTypeArrayCreationExpression = -  NonArrayTypeArrayCreationExpression {-    nonArrayTypeArrayCreationExpressionType :: NonArrayType,-    nonArrayTypeArrayCreationExpressionExpressions :: ExpressionList,-    nonArrayTypeArrayCreationExpressionRankSpecifiers :: [RankSpecifier],-    nonArrayTypeArrayCreationExpressionInitializer :: (Maybe ArrayInitializer)}-  deriving (Eq, Ord, Read, Show)--_NonArrayTypeArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.NonArrayTypeArrayCreationExpression")--_NonArrayTypeArrayCreationExpression_type = (Core.Name "type")--_NonArrayTypeArrayCreationExpression_expressions = (Core.Name "expressions")--_NonArrayTypeArrayCreationExpression_rankSpecifiers = (Core.Name "rankSpecifiers")--_NonArrayTypeArrayCreationExpression_initializer = (Core.Name "initializer")--data ArrayTypeArrayCreationExpression = -  ArrayTypeArrayCreationExpression {-    arrayTypeArrayCreationExpressionType :: ArrayType,-    arrayTypeArrayCreationExpressionInitializer :: ArrayInitializer}-  deriving (Eq, Ord, Read, Show)--_ArrayTypeArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.ArrayTypeArrayCreationExpression")--_ArrayTypeArrayCreationExpression_type = (Core.Name "type")--_ArrayTypeArrayCreationExpression_initializer = (Core.Name "initializer")--data RankSpecifierArrayCreationExpression = -  RankSpecifierArrayCreationExpression {-    rankSpecifierArrayCreationExpressionRankSpecifier :: RankSpecifier,-    rankSpecifierArrayCreationExpressionInitializer :: ArrayInitializer}-  deriving (Eq, Ord, Read, Show)--_RankSpecifierArrayCreationExpression = (Core.Name "hydra/ext/csharp/syntax.RankSpecifierArrayCreationExpression")--_RankSpecifierArrayCreationExpression_rankSpecifier = (Core.Name "rankSpecifier")--_RankSpecifierArrayCreationExpression_initializer = (Core.Name "initializer")--data DelegateCreationExpression = -  DelegateCreationExpression {-    delegateCreationExpressionType :: DelegateType,-    delegateCreationExpressionExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_DelegateCreationExpression = (Core.Name "hydra/ext/csharp/syntax.DelegateCreationExpression")--_DelegateCreationExpression_type = (Core.Name "type")--_DelegateCreationExpression_expression = (Core.Name "expression")--newtype MemberDeclaratorList = -  MemberDeclaratorList {-    unMemberDeclaratorList :: [MemberDeclarator]}-  deriving (Eq, Ord, Read, Show)--_MemberDeclaratorList = (Core.Name "hydra/ext/csharp/syntax.MemberDeclaratorList")--data MemberDeclarator = -  MemberDeclaratorName SimpleName |-  MemberDeclaratorMemberAccess MemberAccess |-  MemberDeclaratorNullConditionalProjectionInitializer NullConditionalProjectionInitializer |-  MemberDeclaratorBaseAccess BaseAccess |-  MemberDeclaratorAssignment AssignmentMemberDeclarator-  deriving (Eq, Ord, Read, Show)--_MemberDeclarator = (Core.Name "hydra/ext/csharp/syntax.MemberDeclarator")--_MemberDeclarator_name = (Core.Name "name")--_MemberDeclarator_memberAccess = (Core.Name "memberAccess")--_MemberDeclarator_nullConditionalProjectionInitializer = (Core.Name "nullConditionalProjectionInitializer")--_MemberDeclarator_baseAccess = (Core.Name "baseAccess")--_MemberDeclarator_assignment = (Core.Name "assignment")--data AssignmentMemberDeclarator = -  AssignmentMemberDeclarator {-    assignmentMemberDeclaratorIdentifier :: Identifier,-    assignmentMemberDeclaratorExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_AssignmentMemberDeclarator = (Core.Name "hydra/ext/csharp/syntax.AssignmentMemberDeclarator")--_AssignmentMemberDeclarator_identifier = (Core.Name "identifier")--_AssignmentMemberDeclarator_expression = (Core.Name "expression")--data TypeofExpression = -  TypeofExpressionType Type |-  TypeofExpressionUnboundTypeName UnboundTypeName |-  TypeofExpressionVoid -  deriving (Eq, Ord, Read, Show)--_TypeofExpression = (Core.Name "hydra/ext/csharp/syntax.TypeofExpression")--_TypeofExpression_type = (Core.Name "type")--_TypeofExpression_unboundTypeName = (Core.Name "unboundTypeName")--_TypeofExpression_void = (Core.Name "void")--newtype UnboundTypeName = -  UnboundTypeName {-    unUnboundTypeName :: [UnboundTypeNamePart]}-  deriving (Eq, Ord, Read, Show)--_UnboundTypeName = (Core.Name "hydra/ext/csharp/syntax.UnboundTypeName")--data UnboundTypeNamePart = -  UnboundTypeNamePart {-    unboundTypeNamePartIdentifier :: Identifier,-    unboundTypeNamePartAliased :: Bool,-    unboundTypeNamePartDimension :: (Maybe Int)}-  deriving (Eq, Ord, Read, Show)--_UnboundTypeNamePart = (Core.Name "hydra/ext/csharp/syntax.UnboundTypeNamePart")--_UnboundTypeNamePart_identifier = (Core.Name "identifier")--_UnboundTypeNamePart_aliased = (Core.Name "aliased")--_UnboundTypeNamePart_dimension = (Core.Name "dimension")--data DefaultValueExpression = -  DefaultValueExpressionExplicitlyTyped Type |-  DefaultValueExpressionDefaultLiteral -  deriving (Eq, Ord, Read, Show)--_DefaultValueExpression = (Core.Name "hydra/ext/csharp/syntax.DefaultValueExpression")--_DefaultValueExpression_explicitlyTyped = (Core.Name "explicitlyTyped")--_DefaultValueExpression_defaultLiteral = (Core.Name "defaultLiteral")--data StackallocExpression = -  StackallocExpression {-    stackallocExpressionType :: (Maybe UnmanagedType),-    stackallocExpressionExpression :: (Maybe ConstantExpression),-    stackallocExpressionInitializer :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_StackallocExpression = (Core.Name "hydra/ext/csharp/syntax.StackallocExpression")--_StackallocExpression_type = (Core.Name "type")--_StackallocExpression_expression = (Core.Name "expression")--_StackallocExpression_initializer = (Core.Name "initializer")--data NamedEntity = -  NamedEntity {-    namedEntityTarget :: NamedEntityTarget,-    namedEntityParts :: [NamedEntityPart]}-  deriving (Eq, Ord, Read, Show)--_NamedEntity = (Core.Name "hydra/ext/csharp/syntax.NamedEntity")--_NamedEntity_target = (Core.Name "target")--_NamedEntity_parts = (Core.Name "parts")--data NamedEntityPart = -  NamedEntityPart {-    namedEntityPartIdentifier :: Identifier,-    namedEntityPartTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_NamedEntityPart = (Core.Name "hydra/ext/csharp/syntax.NamedEntityPart")--_NamedEntityPart_identifier = (Core.Name "identifier")--_NamedEntityPart_typeArguments = (Core.Name "typeArguments")--data NamedEntityTarget = -  NamedEntityTargetName SimpleName |-  NamedEntityTargetThis  |-  NamedEntityTargetBase  |-  NamedEntityTargetPredefinedType PredefinedType |-  NamedEntityTargetQualifiedAliasMember QualifiedAliasMember-  deriving (Eq, Ord, Read, Show)--_NamedEntityTarget = (Core.Name "hydra/ext/csharp/syntax.NamedEntityTarget")--_NamedEntityTarget_name = (Core.Name "name")--_NamedEntityTarget_this = (Core.Name "this")--_NamedEntityTarget_base = (Core.Name "base")--_NamedEntityTarget_predefinedType = (Core.Name "predefinedType")--_NamedEntityTarget_qualifiedAliasMember = (Core.Name "qualifiedAliasMember")--data UnaryExpression = -  UnaryExpressionPrimary PrimaryExpression |-  UnaryExpressionPlus UnaryExpression |-  UnaryExpressionMinus UnaryExpression |-  UnaryExpressionNot UnaryExpression |-  UnaryExpressionBitwiseComplement UnaryExpression |-  UnaryExpressionPreIncrement UnaryExpression |-  UnaryExpressionPreDecrement UnaryExpression |-  UnaryExpressionCast CastExpression |-  UnaryExpressionAwait UnaryExpression |-  UnaryExpressionPointerIndirection UnaryExpression |-  UnaryExpressionAddressOf UnaryExpression-  deriving (Eq, Ord, Read, Show)--_UnaryExpression = (Core.Name "hydra/ext/csharp/syntax.UnaryExpression")--_UnaryExpression_primary = (Core.Name "primary")--_UnaryExpression_plus = (Core.Name "plus")--_UnaryExpression_minus = (Core.Name "minus")--_UnaryExpression_not = (Core.Name "not")--_UnaryExpression_bitwiseComplement = (Core.Name "bitwiseComplement")--_UnaryExpression_preIncrement = (Core.Name "preIncrement")--_UnaryExpression_preDecrement = (Core.Name "preDecrement")--_UnaryExpression_cast = (Core.Name "cast")--_UnaryExpression_await = (Core.Name "await")--_UnaryExpression_pointerIndirection = (Core.Name "pointerIndirection")--_UnaryExpression_addressOf = (Core.Name "addressOf")--data CastExpression = -  CastExpression {-    castExpressionType :: Type,-    castExpressionExpression :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_CastExpression = (Core.Name "hydra/ext/csharp/syntax.CastExpression")--_CastExpression_type = (Core.Name "type")--_CastExpression_expression = (Core.Name "expression")--data MultiplicativeExpression = -  MultiplicativeExpressionSimple UnaryExpression |-  MultiplicativeExpressionBinary BinaryMultiplicativeExpression-  deriving (Eq, Ord, Read, Show)--_MultiplicativeExpression = (Core.Name "hydra/ext/csharp/syntax.MultiplicativeExpression")--_MultiplicativeExpression_simple = (Core.Name "simple")--_MultiplicativeExpression_binary = (Core.Name "binary")--data BinaryMultiplicativeExpression = -  BinaryMultiplicativeExpression {-    binaryMultiplicativeExpressionLeft :: MultiplicativeExpression,-    binaryMultiplicativeExpressionOperator :: MultiplicativeOperator,-    binaryMultiplicativeExpressionRight :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryMultiplicativeExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryMultiplicativeExpression")--_BinaryMultiplicativeExpression_left = (Core.Name "left")--_BinaryMultiplicativeExpression_operator = (Core.Name "operator")--_BinaryMultiplicativeExpression_right = (Core.Name "right")--data MultiplicativeOperator = -  MultiplicativeOperatorTimes  |-  MultiplicativeOperatorDivide  |-  MultiplicativeOperatorModulo -  deriving (Eq, Ord, Read, Show)--_MultiplicativeOperator = (Core.Name "hydra/ext/csharp/syntax.MultiplicativeOperator")--_MultiplicativeOperator_times = (Core.Name "times")--_MultiplicativeOperator_divide = (Core.Name "divide")--_MultiplicativeOperator_modulo = (Core.Name "modulo")--data AdditiveExpression = -  AdditiveExpressionSimple MultiplicativeExpression |-  AdditiveExpressionBinary BinaryAdditiveExpression-  deriving (Eq, Ord, Read, Show)--_AdditiveExpression = (Core.Name "hydra/ext/csharp/syntax.AdditiveExpression")--_AdditiveExpression_simple = (Core.Name "simple")--_AdditiveExpression_binary = (Core.Name "binary")--data BinaryAdditiveExpression = -  BinaryAdditiveExpression {-    binaryAdditiveExpressionLeft :: AdditiveExpression,-    binaryAdditiveExpressionOperator :: AdditiveOperator,-    binaryAdditiveExpressionRight :: MultiplicativeExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryAdditiveExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryAdditiveExpression")--_BinaryAdditiveExpression_left = (Core.Name "left")--_BinaryAdditiveExpression_operator = (Core.Name "operator")--_BinaryAdditiveExpression_right = (Core.Name "right")--data AdditiveOperator = -  AdditiveOperatorPlus  |-  AdditiveOperatorMinus -  deriving (Eq, Ord, Read, Show)--_AdditiveOperator = (Core.Name "hydra/ext/csharp/syntax.AdditiveOperator")--_AdditiveOperator_plus = (Core.Name "plus")--_AdditiveOperator_minus = (Core.Name "minus")--data ShiftExpression = -  ShiftExpressionSimple AdditiveExpression |-  ShiftExpressionBinary BinaryShiftExpression-  deriving (Eq, Ord, Read, Show)--_ShiftExpression = (Core.Name "hydra/ext/csharp/syntax.ShiftExpression")--_ShiftExpression_simple = (Core.Name "simple")--_ShiftExpression_binary = (Core.Name "binary")--data BinaryShiftExpression = -  BinaryShiftExpression {-    binaryShiftExpressionLeft :: ShiftExpression,-    binaryShiftExpressionOperator :: ShiftOperator,-    binaryShiftExpressionRight :: AdditiveExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryShiftExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryShiftExpression")--_BinaryShiftExpression_left = (Core.Name "left")--_BinaryShiftExpression_operator = (Core.Name "operator")--_BinaryShiftExpression_right = (Core.Name "right")--data ShiftOperator = -  ShiftOperatorLeft  |-  ShiftOperatorRight -  deriving (Eq, Ord, Read, Show)--_ShiftOperator = (Core.Name "hydra/ext/csharp/syntax.ShiftOperator")--_ShiftOperator_left = (Core.Name "left")--_ShiftOperator_right = (Core.Name "right")--data RelationalExpression = -  RelationalExpressionSimple ShiftExpression |-  RelationalExpressionBinary BinaryRelationalExpression |-  RelationalExpressionIsType IsTypeExpression |-  RelationalExpressionIsPattern IsPatternExpression |-  RelationalExpressionAsType AsTypeExpression-  deriving (Eq, Ord, Read, Show)--_RelationalExpression = (Core.Name "hydra/ext/csharp/syntax.RelationalExpression")--_RelationalExpression_simple = (Core.Name "simple")--_RelationalExpression_binary = (Core.Name "binary")--_RelationalExpression_isType = (Core.Name "isType")--_RelationalExpression_isPattern = (Core.Name "isPattern")--_RelationalExpression_asType = (Core.Name "asType")--data BinaryRelationalExpression = -  BinaryRelationalExpression {-    binaryRelationalExpressionLeft :: RelationalExpression,-    binaryRelationalExpressionOperator :: RelationalOperator,-    binaryRelationalExpressionRight :: ShiftExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryRelationalExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryRelationalExpression")--_BinaryRelationalExpression_left = (Core.Name "left")--_BinaryRelationalExpression_operator = (Core.Name "operator")--_BinaryRelationalExpression_right = (Core.Name "right")--data RelationalOperator = -  RelationalOperatorLessThan  |-  RelationalOperatorGreaterThan  |-  RelationalOperatorLessThanOrEqual  |-  RelationalOperatorGreaterThanOrEqual -  deriving (Eq, Ord, Read, Show)--_RelationalOperator = (Core.Name "hydra/ext/csharp/syntax.RelationalOperator")--_RelationalOperator_lessThan = (Core.Name "lessThan")--_RelationalOperator_greaterThan = (Core.Name "greaterThan")--_RelationalOperator_lessThanOrEqual = (Core.Name "lessThanOrEqual")--_RelationalOperator_greaterThanOrEqual = (Core.Name "greaterThanOrEqual")--data IsTypeExpression = -  IsTypeExpression {-    isTypeExpressionExpression :: RelationalExpression,-    isTypeExpressionType :: Type}-  deriving (Eq, Ord, Read, Show)--_IsTypeExpression = (Core.Name "hydra/ext/csharp/syntax.IsTypeExpression")--_IsTypeExpression_expression = (Core.Name "expression")--_IsTypeExpression_type = (Core.Name "type")--data IsPatternExpression = -  IsPatternExpression {-    isPatternExpressionExpression :: RelationalExpression,-    isPatternExpressionPattern :: Pattern}-  deriving (Eq, Ord, Read, Show)--_IsPatternExpression = (Core.Name "hydra/ext/csharp/syntax.IsPatternExpression")--_IsPatternExpression_expression = (Core.Name "expression")--_IsPatternExpression_pattern = (Core.Name "pattern")--data AsTypeExpression = -  AsTypeExpression {-    asTypeExpressionExpression :: RelationalExpression,-    asTypeExpressionType :: Type}-  deriving (Eq, Ord, Read, Show)--_AsTypeExpression = (Core.Name "hydra/ext/csharp/syntax.AsTypeExpression")--_AsTypeExpression_expression = (Core.Name "expression")--_AsTypeExpression_type = (Core.Name "type")--data EqualityExpression = -  EqualityExpressionSimple RelationalExpression |-  EqualityExpressionBinary BinaryEqualityExpression-  deriving (Eq, Ord, Read, Show)--_EqualityExpression = (Core.Name "hydra/ext/csharp/syntax.EqualityExpression")--_EqualityExpression_simple = (Core.Name "simple")--_EqualityExpression_binary = (Core.Name "binary")--data BinaryEqualityExpression = -  BinaryEqualityExpression {-    binaryEqualityExpressionLeft :: EqualityExpression,-    binaryEqualityExpressionOperator :: EqualityOperator,-    binaryEqualityExpressionRight :: RelationalExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryEqualityExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryEqualityExpression")--_BinaryEqualityExpression_left = (Core.Name "left")--_BinaryEqualityExpression_operator = (Core.Name "operator")--_BinaryEqualityExpression_right = (Core.Name "right")--data EqualityOperator = -  EqualityOperatorEqual  |-  EqualityOperatorNotEqual -  deriving (Eq, Ord, Read, Show)--_EqualityOperator = (Core.Name "hydra/ext/csharp/syntax.EqualityOperator")--_EqualityOperator_equal = (Core.Name "equal")--_EqualityOperator_notEqual = (Core.Name "notEqual")--data AndExpression = -  AndExpressionSimple EqualityExpression |-  AndExpressionBinary BinaryAndExpression-  deriving (Eq, Ord, Read, Show)--_AndExpression = (Core.Name "hydra/ext/csharp/syntax.AndExpression")--_AndExpression_simple = (Core.Name "simple")--_AndExpression_binary = (Core.Name "binary")--data BinaryAndExpression = -  BinaryAndExpression {-    binaryAndExpressionLeft :: AndExpression,-    binaryAndExpressionRight :: EqualityExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryAndExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryAndExpression")--_BinaryAndExpression_left = (Core.Name "left")--_BinaryAndExpression_right = (Core.Name "right")--data ExclusiveOrExpression = -  ExclusiveOrExpressionSimple AndExpression |-  ExclusiveOrExpressionBinary BinaryExclusiveOrExpression-  deriving (Eq, Ord, Read, Show)--_ExclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.ExclusiveOrExpression")--_ExclusiveOrExpression_simple = (Core.Name "simple")--_ExclusiveOrExpression_binary = (Core.Name "binary")--data BinaryExclusiveOrExpression = -  BinaryExclusiveOrExpression {-    binaryExclusiveOrExpressionLeft :: ExclusiveOrExpression,-    binaryExclusiveOrExpressionRight :: AndExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryExclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryExclusiveOrExpression")--_BinaryExclusiveOrExpression_left = (Core.Name "left")--_BinaryExclusiveOrExpression_right = (Core.Name "right")--data InclusiveOrExpression = -  InclusiveOrExpressionSimple ExclusiveOrExpression |-  InclusiveOrExpressionBinary BinaryInclusiveOrExpression-  deriving (Eq, Ord, Read, Show)--_InclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.InclusiveOrExpression")--_InclusiveOrExpression_simple = (Core.Name "simple")--_InclusiveOrExpression_binary = (Core.Name "binary")--data BinaryInclusiveOrExpression = -  BinaryInclusiveOrExpression {-    binaryInclusiveOrExpressionLeft :: InclusiveOrExpression,-    binaryInclusiveOrExpressionRight :: ExclusiveOrExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryInclusiveOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryInclusiveOrExpression")--_BinaryInclusiveOrExpression_left = (Core.Name "left")--_BinaryInclusiveOrExpression_right = (Core.Name "right")--data ConditionalAndExpression = -  ConditionalAndExpressionSimple InclusiveOrExpression |-  ConditionalAndExpressionBinary BinaryConditionalAndExpression-  deriving (Eq, Ord, Read, Show)--_ConditionalAndExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalAndExpression")--_ConditionalAndExpression_simple = (Core.Name "simple")--_ConditionalAndExpression_binary = (Core.Name "binary")--data BinaryConditionalAndExpression = -  BinaryConditionalAndExpression {-    binaryConditionalAndExpressionLeft :: ConditionalAndExpression,-    binaryConditionalAndExpressionRight :: InclusiveOrExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryConditionalAndExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryConditionalAndExpression")--_BinaryConditionalAndExpression_left = (Core.Name "left")--_BinaryConditionalAndExpression_right = (Core.Name "right")--data ConditionalOrExpression = -  ConditionalOrExpressionSimple ConditionalAndExpression |-  ConditionalOrExpressionBinary BinaryConditionalOrExpression-  deriving (Eq, Ord, Read, Show)--_ConditionalOrExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalOrExpression")--_ConditionalOrExpression_simple = (Core.Name "simple")--_ConditionalOrExpression_binary = (Core.Name "binary")--data BinaryConditionalOrExpression = -  BinaryConditionalOrExpression {-    binaryConditionalOrExpressionLeft :: ConditionalOrExpression,-    binaryConditionalOrExpressionRight :: ConditionalAndExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryConditionalOrExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryConditionalOrExpression")--_BinaryConditionalOrExpression_left = (Core.Name "left")--_BinaryConditionalOrExpression_right = (Core.Name "right")--data NullCoalescingExpression = -  NullCoalescingExpressionSimple ConditionalOrExpression |-  NullCoalescingExpressionBinary BinaryNullCoalescingExpression |-  NullCoalescingExpressionThrow NullCoalescingExpression-  deriving (Eq, Ord, Read, Show)--_NullCoalescingExpression = (Core.Name "hydra/ext/csharp/syntax.NullCoalescingExpression")--_NullCoalescingExpression_simple = (Core.Name "simple")--_NullCoalescingExpression_binary = (Core.Name "binary")--_NullCoalescingExpression_throw = (Core.Name "throw")--data BinaryNullCoalescingExpression = -  BinaryNullCoalescingExpression {-    binaryNullCoalescingExpressionLeft :: ConditionalOrExpression,-    binaryNullCoalescingExpressionRight :: NullCoalescingExpression}-  deriving (Eq, Ord, Read, Show)--_BinaryNullCoalescingExpression = (Core.Name "hydra/ext/csharp/syntax.BinaryNullCoalescingExpression")--_BinaryNullCoalescingExpression_left = (Core.Name "left")--_BinaryNullCoalescingExpression_right = (Core.Name "right")--data DeclarationExpression = -  DeclarationExpression {-    declarationExpressionType :: LocalVariableType,-    declarationExpressionIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_DeclarationExpression = (Core.Name "hydra/ext/csharp/syntax.DeclarationExpression")--_DeclarationExpression_type = (Core.Name "type")--_DeclarationExpression_identifier = (Core.Name "identifier")--data LocalVariableType = -  LocalVariableTypeType Type |-  LocalVariableTypeVar -  deriving (Eq, Ord, Read, Show)--_LocalVariableType = (Core.Name "hydra/ext/csharp/syntax.LocalVariableType")--_LocalVariableType_type = (Core.Name "type")--_LocalVariableType_var = (Core.Name "var")--data ConditionalExpression = -  ConditionalExpressionSimple NullCoalescingExpression |-  ConditionalExpressionSimpleConditional SimpleConditionalExpression |-  ConditionalExpressionRefConditional RefConditionalExpression-  deriving (Eq, Ord, Read, Show)--_ConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.ConditionalExpression")--_ConditionalExpression_simple = (Core.Name "simple")--_ConditionalExpression_simpleConditional = (Core.Name "simpleConditional")--_ConditionalExpression_refConditional = (Core.Name "refConditional")--data SimpleConditionalExpression = -  SimpleConditionalExpression {-    simpleConditionalExpressionCondition :: NullCoalescingExpression,-    simpleConditionalExpressionTrue :: Expression,-    simpleConditionalExpressionFalse :: Expression}-  deriving (Eq, Ord, Read, Show)--_SimpleConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.SimpleConditionalExpression")--_SimpleConditionalExpression_condition = (Core.Name "condition")--_SimpleConditionalExpression_true = (Core.Name "true")--_SimpleConditionalExpression_false = (Core.Name "false")--data RefConditionalExpression = -  RefConditionalExpression {-    refConditionalExpressionCondition :: NullCoalescingExpression,-    refConditionalExpressionTrue :: VariableReference,-    refConditionalExpressionFalse :: VariableReference}-  deriving (Eq, Ord, Read, Show)--_RefConditionalExpression = (Core.Name "hydra/ext/csharp/syntax.RefConditionalExpression")--_RefConditionalExpression_condition = (Core.Name "condition")--_RefConditionalExpression_true = (Core.Name "true")--_RefConditionalExpression_false = (Core.Name "false")--data LambdaExpression = -  LambdaExpression {-    lambdaExpressionAsync :: Bool,-    lambdaExpressionSignature :: AnonymousFunctionSignature,-    lambdaExpressionBody :: AnonymousFunctionBody}-  deriving (Eq, Ord, Read, Show)--_LambdaExpression = (Core.Name "hydra/ext/csharp/syntax.LambdaExpression")--_LambdaExpression_async = (Core.Name "async")--_LambdaExpression_signature = (Core.Name "signature")--_LambdaExpression_body = (Core.Name "body")--data AnonymousMethodExpression = -  AnonymousMethodExpression {-    anonymousMethodExpressionAsync :: Bool,-    anonymousMethodExpressionSignature :: [ExplicitAnonymousFunctionParameter],-    anonymousMethodExpressionBody :: Block}-  deriving (Eq, Ord, Read, Show)--_AnonymousMethodExpression = (Core.Name "hydra/ext/csharp/syntax.AnonymousMethodExpression")--_AnonymousMethodExpression_async = (Core.Name "async")--_AnonymousMethodExpression_signature = (Core.Name "signature")--_AnonymousMethodExpression_body = (Core.Name "body")--data AnonymousFunctionSignature = -  AnonymousFunctionSignatureExplicit [ExplicitAnonymousFunctionParameter] |-  AnonymousFunctionSignatureImplicit [Identifier]-  deriving (Eq, Ord, Read, Show)--_AnonymousFunctionSignature = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionSignature")--_AnonymousFunctionSignature_explicit = (Core.Name "explicit")--_AnonymousFunctionSignature_implicit = (Core.Name "implicit")--data ExplicitAnonymousFunctionParameter = -  ExplicitAnonymousFunctionParameter {-    explicitAnonymousFunctionParameterModifier :: (Maybe AnonymousFunctionParameterModifier),-    explicitAnonymousFunctionParameterType :: Type,-    explicitAnonymousFunctionParameterIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_ExplicitAnonymousFunctionParameter = (Core.Name "hydra/ext/csharp/syntax.ExplicitAnonymousFunctionParameter")--_ExplicitAnonymousFunctionParameter_modifier = (Core.Name "modifier")--_ExplicitAnonymousFunctionParameter_type = (Core.Name "type")--_ExplicitAnonymousFunctionParameter_identifier = (Core.Name "identifier")--data AnonymousFunctionParameterModifier = -  AnonymousFunctionParameterModifierRef  |-  AnonymousFunctionParameterModifierOut  |-  AnonymousFunctionParameterModifierIn -  deriving (Eq, Ord, Read, Show)--_AnonymousFunctionParameterModifier = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionParameterModifier")--_AnonymousFunctionParameterModifier_ref = (Core.Name "ref")--_AnonymousFunctionParameterModifier_out = (Core.Name "out")--_AnonymousFunctionParameterModifier_in = (Core.Name "in")--data AnonymousFunctionBody = -  AnonymousFunctionBodyNullConditionalInvocation NullConditionalInvocationExpression |-  AnonymousFunctionBodyExpression Expression |-  AnonymousFunctionBodyRef VariableReference |-  AnonymousFunctionBodyBlock Block-  deriving (Eq, Ord, Read, Show)--_AnonymousFunctionBody = (Core.Name "hydra/ext/csharp/syntax.AnonymousFunctionBody")--_AnonymousFunctionBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation")--_AnonymousFunctionBody_expression = (Core.Name "expression")--_AnonymousFunctionBody_ref = (Core.Name "ref")--_AnonymousFunctionBody_block = (Core.Name "block")--data QueryExpression = -  QueryExpression {-    queryExpressionFrom :: FromClause,-    queryExpressionBody :: QueryBody}-  deriving (Eq, Ord, Read, Show)--_QueryExpression = (Core.Name "hydra/ext/csharp/syntax.QueryExpression")--_QueryExpression_from = (Core.Name "from")--_QueryExpression_body = (Core.Name "body")--data FromClause = -  FromClause {-    fromClauseType :: (Maybe Type),-    fromClauseIdentifier :: Identifier,-    fromClauseIn :: Expression}-  deriving (Eq, Ord, Read, Show)--_FromClause = (Core.Name "hydra/ext/csharp/syntax.FromClause")--_FromClause_type = (Core.Name "type")--_FromClause_identifier = (Core.Name "identifier")--_FromClause_in = (Core.Name "in")--data QueryBody = -  QueryBody {-    queryBodyClauses :: [QueryBodyClause],-    queryBodySelectOrGroup :: SelectOrGroupClause,-    queryBodyContinuation :: (Maybe QueryContinuation)}-  deriving (Eq, Ord, Read, Show)--_QueryBody = (Core.Name "hydra/ext/csharp/syntax.QueryBody")--_QueryBody_clauses = (Core.Name "clauses")--_QueryBody_selectOrGroup = (Core.Name "selectOrGroup")--_QueryBody_continuation = (Core.Name "continuation")--data QueryBodyClause = -  QueryBodyClauseFrom FromClause |-  QueryBodyClauseLet LetClause |-  QueryBodyClauseWhere BooleanExpression |-  QueryBodyClauseJoin JoinClause |-  QueryBodyClauseOrderby [Ordering_]-  deriving (Eq, Ord, Read, Show)--_QueryBodyClause = (Core.Name "hydra/ext/csharp/syntax.QueryBodyClause")--_QueryBodyClause_from = (Core.Name "from")--_QueryBodyClause_let = (Core.Name "let")--_QueryBodyClause_where = (Core.Name "where")--_QueryBodyClause_join = (Core.Name "join")--_QueryBodyClause_orderby = (Core.Name "orderby")--data LetClause = -  LetClause {-    letClauseLeft :: Identifier,-    letClauseRight :: Expression}-  deriving (Eq, Ord, Read, Show)--_LetClause = (Core.Name "hydra/ext/csharp/syntax.LetClause")--_LetClause_left = (Core.Name "left")--_LetClause_right = (Core.Name "right")--data JoinClause = -  JoinClause {-    joinClauseType :: (Maybe Type),-    joinClauseIdentifier :: Identifier,-    joinClauseIn :: Expression,-    joinClauseOn :: Expression,-    joinClauseEquals :: Expression,-    joinClauseInto :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_JoinClause = (Core.Name "hydra/ext/csharp/syntax.JoinClause")--_JoinClause_type = (Core.Name "type")--_JoinClause_identifier = (Core.Name "identifier")--_JoinClause_in = (Core.Name "in")--_JoinClause_on = (Core.Name "on")--_JoinClause_equals = (Core.Name "equals")--_JoinClause_into = (Core.Name "into")--data Ordering_ = -  Ordering_ {-    orderingExpression :: Expression,-    orderingDirection :: (Maybe OrderingDirection)}-  deriving (Eq, Ord, Read, Show)--_Ordering = (Core.Name "hydra/ext/csharp/syntax.Ordering")--_Ordering_expression = (Core.Name "expression")--_Ordering_direction = (Core.Name "direction")--data OrderingDirection = -  OrderingDirectionAscending  |-  OrderingDirectionDescending -  deriving (Eq, Ord, Read, Show)--_OrderingDirection = (Core.Name "hydra/ext/csharp/syntax.OrderingDirection")--_OrderingDirection_ascending = (Core.Name "ascending")--_OrderingDirection_descending = (Core.Name "descending")--data SelectOrGroupClause = -  SelectOrGroupClauseSelect Expression |-  SelectOrGroupClauseGroup GroupClause-  deriving (Eq, Ord, Read, Show)--_SelectOrGroupClause = (Core.Name "hydra/ext/csharp/syntax.SelectOrGroupClause")--_SelectOrGroupClause_select = (Core.Name "select")--_SelectOrGroupClause_group = (Core.Name "group")--data GroupClause = -  GroupClause {-    groupClauseGrouped :: Expression,-    groupClauseBy :: Expression}-  deriving (Eq, Ord, Read, Show)--_GroupClause = (Core.Name "hydra/ext/csharp/syntax.GroupClause")--_GroupClause_grouped = (Core.Name "grouped")--_GroupClause_by = (Core.Name "by")--data QueryContinuation = -  QueryContinuation {-    queryContinuationInto :: Identifier,-    queryContinuationBody :: QueryBody}-  deriving (Eq, Ord, Read, Show)--_QueryContinuation = (Core.Name "hydra/ext/csharp/syntax.QueryContinuation")--_QueryContinuation_into = (Core.Name "into")--_QueryContinuation_body = (Core.Name "body")--data Assignment = -  Assignment {-    assignmentLeft :: UnaryExpression,-    assignmentOperator :: AssignmentOperator,-    assignmentRight :: Expression}-  deriving (Eq, Ord, Read, Show)--_Assignment = (Core.Name "hydra/ext/csharp/syntax.Assignment")--_Assignment_left = (Core.Name "left")--_Assignment_operator = (Core.Name "operator")--_Assignment_right = (Core.Name "right")--data AssignmentOperator = -  AssignmentOperatorSimple Bool |-  AssignmentOperatorPlusEquals  |-  AssignmentOperatorMinusEquals  |-  AssignmentOperatorTimesEquals  |-  AssignmentOperatorDivideEquals  |-  AssignmentOperatorModEquals  |-  AssignmentOperatorAndEquals  |-  AssignmentOperatorOrEquals  |-  AssignmentOperatorXorEquals  |-  AssignmentOperatorLeftShiftEquals  |-  AssignmentOperatorRightShiftEquals -  deriving (Eq, Ord, Read, Show)--_AssignmentOperator = (Core.Name "hydra/ext/csharp/syntax.AssignmentOperator")--_AssignmentOperator_simple = (Core.Name "simple")--_AssignmentOperator_plusEquals = (Core.Name "plusEquals")--_AssignmentOperator_minusEquals = (Core.Name "minusEquals")--_AssignmentOperator_timesEquals = (Core.Name "timesEquals")--_AssignmentOperator_divideEquals = (Core.Name "divideEquals")--_AssignmentOperator_modEquals = (Core.Name "modEquals")--_AssignmentOperator_andEquals = (Core.Name "andEquals")--_AssignmentOperator_orEquals = (Core.Name "orEquals")--_AssignmentOperator_xorEquals = (Core.Name "xorEquals")--_AssignmentOperator_leftShiftEquals = (Core.Name "leftShiftEquals")--_AssignmentOperator_rightShiftEquals = (Core.Name "rightShiftEquals")--data Expression = -  ExpressionNonAssignment NonAssignmentExpression |-  ExpressionAssignment Assignment-  deriving (Eq, Ord, Read, Show)--_Expression = (Core.Name "hydra/ext/csharp/syntax.Expression")--_Expression_nonAssignment = (Core.Name "nonAssignment")--_Expression_assignment = (Core.Name "assignment")--data NonAssignmentExpression = -  NonAssignmentExpressionDeclaration DeclarationExpression |-  NonAssignmentExpressionConditional ConditionalExpression |-  NonAssignmentExpressionLambda LambdaExpression |-  NonAssignmentExpressionQuery QueryExpression-  deriving (Eq, Ord, Read, Show)--_NonAssignmentExpression = (Core.Name "hydra/ext/csharp/syntax.NonAssignmentExpression")--_NonAssignmentExpression_declaration = (Core.Name "declaration")--_NonAssignmentExpression_conditional = (Core.Name "conditional")--_NonAssignmentExpression_lambda = (Core.Name "lambda")--_NonAssignmentExpression_query = (Core.Name "query")--newtype ConstantExpression = -  ConstantExpression {-    unConstantExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_ConstantExpression = (Core.Name "hydra/ext/csharp/syntax.ConstantExpression")--newtype BooleanExpression = -  BooleanExpression {-    unBooleanExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_BooleanExpression = (Core.Name "hydra/ext/csharp/syntax.BooleanExpression")--data Statement = -  StatementLabeled LabeledStatement |-  StatementDeclaration DeclarationStatement |-  StatementEmbedded EmbeddedStatement-  deriving (Eq, Ord, Read, Show)--_Statement = (Core.Name "hydra/ext/csharp/syntax.Statement")--_Statement_labeled = (Core.Name "labeled")--_Statement_declaration = (Core.Name "declaration")--_Statement_embedded = (Core.Name "embedded")--data EmbeddedStatement = -  EmbeddedStatementBlock Block |-  EmbeddedStatementEmpty  |-  EmbeddedStatementExpression StatementExpression |-  EmbeddedStatementSelection SelectionStatement |-  EmbeddedStatementIteration IterationStatement |-  EmbeddedStatementJump JumpStatement |-  EmbeddedStatementTry TryStatement |-  EmbeddedStatementChecked Block |-  EmbeddedStatementUnchecked Block |-  EmbeddedStatementLock LockStatement |-  EmbeddedStatementUsing UsingStatement |-  EmbeddedStatementYield YieldStatement |-  EmbeddedStatementUnsafe Block |-  EmbeddedStatementFixed FixedStatement-  deriving (Eq, Ord, Read, Show)--_EmbeddedStatement = (Core.Name "hydra/ext/csharp/syntax.EmbeddedStatement")--_EmbeddedStatement_block = (Core.Name "block")--_EmbeddedStatement_empty = (Core.Name "empty")--_EmbeddedStatement_expression = (Core.Name "expression")--_EmbeddedStatement_selection = (Core.Name "selection")--_EmbeddedStatement_iteration = (Core.Name "iteration")--_EmbeddedStatement_jump = (Core.Name "jump")--_EmbeddedStatement_try = (Core.Name "try")--_EmbeddedStatement_checked = (Core.Name "checked")--_EmbeddedStatement_unchecked = (Core.Name "unchecked")--_EmbeddedStatement_lock = (Core.Name "lock")--_EmbeddedStatement_using = (Core.Name "using")--_EmbeddedStatement_yield = (Core.Name "yield")--_EmbeddedStatement_unsafe = (Core.Name "unsafe")--_EmbeddedStatement_fixed = (Core.Name "fixed")--newtype Block = -  Block {-    unBlock :: [Statement]}-  deriving (Eq, Ord, Read, Show)--_Block = (Core.Name "hydra/ext/csharp/syntax.Block")--data LabeledStatement = -  LabeledStatement {-    labeledStatementLabel :: Identifier,-    labeledStatementStatement :: Statement}-  deriving (Eq, Ord, Read, Show)--_LabeledStatement = (Core.Name "hydra/ext/csharp/syntax.LabeledStatement")--_LabeledStatement_label = (Core.Name "label")--_LabeledStatement_statement = (Core.Name "statement")--data DeclarationStatement = -  DeclarationStatementVariable LocalVariableDeclaration |-  DeclarationStatementConstant LocalConstantDeclaration |-  DeclarationStatementFunction LocalFunctionDeclaration-  deriving (Eq, Ord, Read, Show)--_DeclarationStatement = (Core.Name "hydra/ext/csharp/syntax.DeclarationStatement")--_DeclarationStatement_variable = (Core.Name "variable")--_DeclarationStatement_constant = (Core.Name "constant")--_DeclarationStatement_function = (Core.Name "function")--data LocalVariableDeclaration = -  LocalVariableDeclarationImplicitlyTyped ImplicitlyTypedLocalVariableDeclaration |-  LocalVariableDeclarationExplicitlyTyped ExplicitlyTypedLocalVariableDeclaration |-  LocalVariableDeclarationRef RefLocalVariableDeclaration-  deriving (Eq, Ord, Read, Show)--_LocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalVariableDeclaration")--_LocalVariableDeclaration_implicitlyTyped = (Core.Name "implicitlyTyped")--_LocalVariableDeclaration_explicitlyTyped = (Core.Name "explicitlyTyped")--_LocalVariableDeclaration_ref = (Core.Name "ref")--data ImplicitlyTypedLocalVariableDeclaration = -  ImplicitlyTypedLocalVariableDeclarationVar ImplicitlyTypedLocalVariableDeclarator |-  ImplicitlyTypedLocalVariableDeclarationRefVar RefVarImplicitlyTypedLocalVariableDeclaration-  deriving (Eq, Ord, Read, Show)--_ImplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.ImplicitlyTypedLocalVariableDeclaration")--_ImplicitlyTypedLocalVariableDeclaration_var = (Core.Name "var")--_ImplicitlyTypedLocalVariableDeclaration_refVar = (Core.Name "refVar")--data RefVarImplicitlyTypedLocalVariableDeclaration = -  RefVarImplicitlyTypedLocalVariableDeclaration {-    refVarImplicitlyTypedLocalVariableDeclarationRefKind :: RefKind,-    refVarImplicitlyTypedLocalVariableDeclarationDeclarator :: RefLocalVariableDeclarator}-  deriving (Eq, Ord, Read, Show)--_RefVarImplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefVarImplicitlyTypedLocalVariableDeclaration")--_RefVarImplicitlyTypedLocalVariableDeclaration_refKind = (Core.Name "refKind")--_RefVarImplicitlyTypedLocalVariableDeclaration_declarator = (Core.Name "declarator")--data ImplicitlyTypedLocalVariableDeclarator = -  ImplicitlyTypedLocalVariableDeclarator {-    implicitlyTypedLocalVariableDeclaratorIdentifier :: Identifier,-    implicitlyTypedLocalVariableDeclaratorExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_ImplicitlyTypedLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.ImplicitlyTypedLocalVariableDeclarator")--_ImplicitlyTypedLocalVariableDeclarator_identifier = (Core.Name "identifier")--_ImplicitlyTypedLocalVariableDeclarator_expression = (Core.Name "expression")--data ExplicitlyTypedLocalVariableDeclaration = -  ExplicitlyTypedLocalVariableDeclaration {-    explicitlyTypedLocalVariableDeclarationType :: Type,-    explicitlyTypedLocalVariableDeclarationDeclarators :: [ExplicitlyTypedLocalVariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_ExplicitlyTypedLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.ExplicitlyTypedLocalVariableDeclaration")--_ExplicitlyTypedLocalVariableDeclaration_type = (Core.Name "type")--_ExplicitlyTypedLocalVariableDeclaration_declarators = (Core.Name "declarators")--data ExplicitlyTypedLocalVariableDeclarator = -  ExplicitlyTypedLocalVariableDeclarator {-    explicitlyTypedLocalVariableDeclaratorIdentifier :: Identifier,-    explicitlyTypedLocalVariableDeclaratorInitializer :: (Maybe LocalVariableInitializer)}-  deriving (Eq, Ord, Read, Show)--_ExplicitlyTypedLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.ExplicitlyTypedLocalVariableDeclarator")--_ExplicitlyTypedLocalVariableDeclarator_identifier = (Core.Name "identifier")--_ExplicitlyTypedLocalVariableDeclarator_initializer = (Core.Name "initializer")--data LocalVariableInitializer = -  LocalVariableInitializerExpression Expression |-  LocalVariableInitializerInitializer ArrayInitializer-  deriving (Eq, Ord, Read, Show)--_LocalVariableInitializer = (Core.Name "hydra/ext/csharp/syntax.LocalVariableInitializer")--_LocalVariableInitializer_expression = (Core.Name "expression")--_LocalVariableInitializer_initializer = (Core.Name "initializer")--data RefLocalVariableDeclaration = -  RefLocalVariableDeclaration {-    refLocalVariableDeclarationRefKind :: RefKind,-    refLocalVariableDeclarationType :: Type,-    refLocalVariableDeclarationDeclarators :: [RefLocalVariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_RefLocalVariableDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefLocalVariableDeclaration")--_RefLocalVariableDeclaration_refKind = (Core.Name "refKind")--_RefLocalVariableDeclaration_type = (Core.Name "type")--_RefLocalVariableDeclaration_declarators = (Core.Name "declarators")--data RefLocalVariableDeclarator = -  RefLocalVariableDeclarator {-    refLocalVariableDeclaratorLeft :: Identifier,-    refLocalVariableDeclaratorRight :: VariableReference}-  deriving (Eq, Ord, Read, Show)--_RefLocalVariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.RefLocalVariableDeclarator")--_RefLocalVariableDeclarator_left = (Core.Name "left")--_RefLocalVariableDeclarator_right = (Core.Name "right")--data LocalConstantDeclaration = -  LocalConstantDeclaration {-    localConstantDeclarationType :: Type,-    localConstantDeclarationDeclarators :: [ConstantDeclarator]}-  deriving (Eq, Ord, Read, Show)--_LocalConstantDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalConstantDeclaration")--_LocalConstantDeclaration_type = (Core.Name "type")--_LocalConstantDeclaration_declarators = (Core.Name "declarators")--data ConstantDeclarator = -  ConstantDeclarator {-    constantDeclaratorIdentifier :: Identifier,-    constantDeclaratorExpression :: ConstantExpression}-  deriving (Eq, Ord, Read, Show)--_ConstantDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConstantDeclarator")--_ConstantDeclarator_identifier = (Core.Name "identifier")--_ConstantDeclarator_expression = (Core.Name "expression")--data LocalFunctionDeclaration = -  LocalFunctionDeclarationStandard StandardLocalFunctionDeclaration |-  LocalFunctionDeclarationRef RefLocalFunctionDeclaration-  deriving (Eq, Ord, Read, Show)--_LocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionDeclaration")--_LocalFunctionDeclaration_standard = (Core.Name "standard")--_LocalFunctionDeclaration_ref = (Core.Name "ref")--data StandardLocalFunctionDeclaration = -  StandardLocalFunctionDeclaration {-    standardLocalFunctionDeclarationModifiers :: [LocalFunctionModifier],-    standardLocalFunctionDeclarationReturnType :: ReturnType,-    standardLocalFunctionDeclarationHeader :: LocalFunctionHeader,-    standardLocalFunctionDeclarationBody :: LocalFunctionBody}-  deriving (Eq, Ord, Read, Show)--_StandardLocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardLocalFunctionDeclaration")--_StandardLocalFunctionDeclaration_modifiers = (Core.Name "modifiers")--_StandardLocalFunctionDeclaration_returnType = (Core.Name "returnType")--_StandardLocalFunctionDeclaration_header = (Core.Name "header")--_StandardLocalFunctionDeclaration_body = (Core.Name "body")--data RefLocalFunctionDeclaration = -  RefLocalFunctionDeclaration {-    refLocalFunctionDeclarationModifiers :: [RefLocalFunctionModifier],-    refLocalFunctionDeclarationRefKind :: RefKind,-    refLocalFunctionDeclarationReturnType :: Type,-    refLocalFunctionDeclarationHeader :: LocalFunctionHeader,-    refLocalFunctionDeclarationBody :: RefLocalFunctionBody}-  deriving (Eq, Ord, Read, Show)--_RefLocalFunctionDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionDeclaration")--_RefLocalFunctionDeclaration_modifiers = (Core.Name "modifiers")--_RefLocalFunctionDeclaration_refKind = (Core.Name "refKind")--_RefLocalFunctionDeclaration_returnType = (Core.Name "returnType")--_RefLocalFunctionDeclaration_header = (Core.Name "header")--_RefLocalFunctionDeclaration_body = (Core.Name "body")--data LocalFunctionHeader = -  LocalFunctionHeader {-    localFunctionHeaderIdentifier :: Identifier,-    localFunctionHeaderTypeParameters :: (Maybe TypeParameterList),-    localFunctionHeaderParameters :: FormalParameterList,-    localFunctionHeaderConstraints :: [TypeParameterConstraintsClause]}-  deriving (Eq, Ord, Read, Show)--_LocalFunctionHeader = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionHeader")--_LocalFunctionHeader_identifier = (Core.Name "identifier")--_LocalFunctionHeader_typeParameters = (Core.Name "typeParameters")--_LocalFunctionHeader_parameters = (Core.Name "parameters")--_LocalFunctionHeader_constraints = (Core.Name "constraints")--data LocalFunctionModifier = -  LocalFunctionModifierRef RefLocalFunctionModifier |-  LocalFunctionModifierAsync -  deriving (Eq, Ord, Read, Show)--_LocalFunctionModifier = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionModifier")--_LocalFunctionModifier_ref = (Core.Name "ref")--_LocalFunctionModifier_async = (Core.Name "async")--data RefLocalFunctionModifier = -  RefLocalFunctionModifierStatic  |-  RefLocalFunctionModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_RefLocalFunctionModifier = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionModifier")--_RefLocalFunctionModifier_static = (Core.Name "static")--_RefLocalFunctionModifier_unsafe = (Core.Name "unsafe")--data LocalFunctionBody = -  LocalFunctionBodyBlock Block |-  LocalFunctionBodyNullConditionalInvocation NullConditionalInvocationExpression |-  LocalFunctionBodyExpression Expression-  deriving (Eq, Ord, Read, Show)--_LocalFunctionBody = (Core.Name "hydra/ext/csharp/syntax.LocalFunctionBody")--_LocalFunctionBody_block = (Core.Name "block")--_LocalFunctionBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation")--_LocalFunctionBody_expression = (Core.Name "expression")--data RefLocalFunctionBody = -  RefLocalFunctionBodyBlock Block |-  RefLocalFunctionBodyRef VariableReference-  deriving (Eq, Ord, Read, Show)--_RefLocalFunctionBody = (Core.Name "hydra/ext/csharp/syntax.RefLocalFunctionBody")--_RefLocalFunctionBody_block = (Core.Name "block")--_RefLocalFunctionBody_ref = (Core.Name "ref")--data StatementExpression = -  StatementExpressionNullConditionalInvocation NullConditionalInvocationExpression |-  StatementExpressionInvocation InvocationExpression |-  StatementExpressionObjectCreation ObjectCreationExpression |-  StatementExpressionAssignment Assignment |-  StatementExpressionPostIncrement PrimaryExpression |-  StatementExpressionPostDecrement PrimaryExpression |-  StatementExpressionPreIncrement UnaryExpression |-  StatementExpressionPreDecrement UnaryExpression |-  StatementExpressionAwait UnaryExpression-  deriving (Eq, Ord, Read, Show)--_StatementExpression = (Core.Name "hydra/ext/csharp/syntax.StatementExpression")--_StatementExpression_nullConditionalInvocation = (Core.Name "nullConditionalInvocation")--_StatementExpression_invocation = (Core.Name "invocation")--_StatementExpression_objectCreation = (Core.Name "objectCreation")--_StatementExpression_assignment = (Core.Name "assignment")--_StatementExpression_postIncrement = (Core.Name "postIncrement")--_StatementExpression_postDecrement = (Core.Name "postDecrement")--_StatementExpression_preIncrement = (Core.Name "preIncrement")--_StatementExpression_preDecrement = (Core.Name "preDecrement")--_StatementExpression_await = (Core.Name "await")--data SelectionStatement = -  SelectionStatementIf IfStatement |-  SelectionStatementSwitch SwitchStatement-  deriving (Eq, Ord, Read, Show)--_SelectionStatement = (Core.Name "hydra/ext/csharp/syntax.SelectionStatement")--_SelectionStatement_if = (Core.Name "if")--_SelectionStatement_switch = (Core.Name "switch")--data IfStatement = -  IfStatement {-    ifStatementCondition :: BooleanExpression,-    ifStatementIfBranch :: EmbeddedStatement,-    ifStatementElseBranch :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_IfStatement = (Core.Name "hydra/ext/csharp/syntax.IfStatement")--_IfStatement_condition = (Core.Name "condition")--_IfStatement_ifBranch = (Core.Name "ifBranch")--_IfStatement_elseBranch = (Core.Name "elseBranch")--data SwitchStatement = -  SwitchStatement {-    switchStatementExpression :: Expression,-    switchStatementBranches :: [SwitchSection]}-  deriving (Eq, Ord, Read, Show)--_SwitchStatement = (Core.Name "hydra/ext/csharp/syntax.SwitchStatement")--_SwitchStatement_expression = (Core.Name "expression")--_SwitchStatement_branches = (Core.Name "branches")--data SwitchSection = -  SwitchSection {-    switchSectionLabels :: [SwitchLabel],-    switchSectionStatements :: [Statement]}-  deriving (Eq, Ord, Read, Show)--_SwitchSection = (Core.Name "hydra/ext/csharp/syntax.SwitchSection")--_SwitchSection_labels = (Core.Name "labels")--_SwitchSection_statements = (Core.Name "statements")--data SwitchLabel = -  SwitchLabelBranch SwitchBranch |-  SwitchLabelDefault -  deriving (Eq, Ord, Read, Show)--_SwitchLabel = (Core.Name "hydra/ext/csharp/syntax.SwitchLabel")--_SwitchLabel_branch = (Core.Name "branch")--_SwitchLabel_default = (Core.Name "default")--data SwitchBranch = -  SwitchBranch {-    switchBranchPattern :: Pattern,-    switchBranchGuard :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_SwitchBranch = (Core.Name "hydra/ext/csharp/syntax.SwitchBranch")--_SwitchBranch_pattern = (Core.Name "pattern")--_SwitchBranch_guard = (Core.Name "guard")--data IterationStatement = -  IterationStatementWhile WhileStatement |-  IterationStatementDo DoStatement |-  IterationStatementFor ForStatement |-  IterationStatementForeach ForeachStatement-  deriving (Eq, Ord, Read, Show)--_IterationStatement = (Core.Name "hydra/ext/csharp/syntax.IterationStatement")--_IterationStatement_while = (Core.Name "while")--_IterationStatement_do = (Core.Name "do")--_IterationStatement_for = (Core.Name "for")--_IterationStatement_foreach = (Core.Name "foreach")--data WhileStatement = -  WhileStatement {-    whileStatementCondition :: BooleanExpression,-    whileStatementBody :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_WhileStatement = (Core.Name "hydra/ext/csharp/syntax.WhileStatement")--_WhileStatement_condition = (Core.Name "condition")--_WhileStatement_body = (Core.Name "body")--data DoStatement = -  DoStatement {-    doStatementBody :: EmbeddedStatement,-    doStatementWhile :: BooleanExpression}-  deriving (Eq, Ord, Read, Show)--_DoStatement = (Core.Name "hydra/ext/csharp/syntax.DoStatement")--_DoStatement_body = (Core.Name "body")--_DoStatement_while = (Core.Name "while")--data ForStatement = -  ForStatement {-    forStatementInitializer :: (Maybe ForInitializer),-    forStatementCondition :: (Maybe BooleanExpression),-    forStatementIterator :: (Maybe StatementExpressionList),-    forStatementBody :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_ForStatement = (Core.Name "hydra/ext/csharp/syntax.ForStatement")--_ForStatement_initializer = (Core.Name "initializer")--_ForStatement_condition = (Core.Name "condition")--_ForStatement_iterator = (Core.Name "iterator")--_ForStatement_body = (Core.Name "body")--data ForInitializer = -  ForInitializerVariable LocalVariableDeclaration |-  ForInitializerStatements StatementExpressionList-  deriving (Eq, Ord, Read, Show)--_ForInitializer = (Core.Name "hydra/ext/csharp/syntax.ForInitializer")--_ForInitializer_variable = (Core.Name "variable")--_ForInitializer_statements = (Core.Name "statements")--newtype StatementExpressionList = -  StatementExpressionList {-    unStatementExpressionList :: [StatementExpression]}-  deriving (Eq, Ord, Read, Show)--_StatementExpressionList = (Core.Name "hydra/ext/csharp/syntax.StatementExpressionList")--data ForeachStatement = -  ForeachStatement {-    foreachStatementKind :: (Maybe RefKind),-    foreachStatementType :: LocalVariableType,-    foreachStatementIdentifier :: Identifier,-    foreachStatementExpression :: Expression,-    foreachStatementBody :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_ForeachStatement = (Core.Name "hydra/ext/csharp/syntax.ForeachStatement")--_ForeachStatement_kind = (Core.Name "kind")--_ForeachStatement_type = (Core.Name "type")--_ForeachStatement_identifier = (Core.Name "identifier")--_ForeachStatement_expression = (Core.Name "expression")--_ForeachStatement_body = (Core.Name "body")--data JumpStatement = -  JumpStatementBreak  |-  JumpStatementContinue  |-  JumpStatementGoto GotoStatement |-  JumpStatementReturn ReturnStatement |-  JumpStatementThrow (Maybe Expression)-  deriving (Eq, Ord, Read, Show)--_JumpStatement = (Core.Name "hydra/ext/csharp/syntax.JumpStatement")--_JumpStatement_break = (Core.Name "break")--_JumpStatement_continue = (Core.Name "continue")--_JumpStatement_goto = (Core.Name "goto")--_JumpStatement_return = (Core.Name "return")--_JumpStatement_throw = (Core.Name "throw")--data GotoStatement = -  GotoStatementIdentifier Identifier |-  GotoStatementCase ConstantExpression |-  GotoStatementDefault -  deriving (Eq, Ord, Read, Show)--_GotoStatement = (Core.Name "hydra/ext/csharp/syntax.GotoStatement")--_GotoStatement_identifier = (Core.Name "identifier")--_GotoStatement_case = (Core.Name "case")--_GotoStatement_default = (Core.Name "default")--data ReturnStatement = -  ReturnStatementSimple  |-  ReturnStatementValue Expression |-  ReturnStatementRef VariableReference-  deriving (Eq, Ord, Read, Show)--_ReturnStatement = (Core.Name "hydra/ext/csharp/syntax.ReturnStatement")--_ReturnStatement_simple = (Core.Name "simple")--_ReturnStatement_value = (Core.Name "value")--_ReturnStatement_ref = (Core.Name "ref")--data TryStatement = -  TryStatement {-    tryStatementBody :: Block,-    tryStatementCatches :: CatchClauses,-    tryStatementFinally :: (Maybe Block)}-  deriving (Eq, Ord, Read, Show)--_TryStatement = (Core.Name "hydra/ext/csharp/syntax.TryStatement")--_TryStatement_body = (Core.Name "body")--_TryStatement_catches = (Core.Name "catches")--_TryStatement_finally = (Core.Name "finally")--data CatchClauses = -  CatchClausesSpecific [SpecificCatchClause] |-  CatchClausesGeneral Block-  deriving (Eq, Ord, Read, Show)--_CatchClauses = (Core.Name "hydra/ext/csharp/syntax.CatchClauses")--_CatchClauses_specific = (Core.Name "specific")--_CatchClauses_general = (Core.Name "general")--data SpecificCatchClause = -  SpecificCatchClause {-    specificCatchClauseSpecifier :: (Maybe ExceptionSpecifier),-    specificCatchClauseFilter :: (Maybe BooleanExpression),-    specificCatchClauseBody :: Block}-  deriving (Eq, Ord, Read, Show)--_SpecificCatchClause = (Core.Name "hydra/ext/csharp/syntax.SpecificCatchClause")--_SpecificCatchClause_specifier = (Core.Name "specifier")--_SpecificCatchClause_filter = (Core.Name "filter")--_SpecificCatchClause_body = (Core.Name "body")--data ExceptionSpecifier = -  ExceptionSpecifier {-    exceptionSpecifierType :: Type,-    exceptionSpecifierIdentifier :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_ExceptionSpecifier = (Core.Name "hydra/ext/csharp/syntax.ExceptionSpecifier")--_ExceptionSpecifier_type = (Core.Name "type")--_ExceptionSpecifier_identifier = (Core.Name "identifier")--data LockStatement = -  LockStatement {-    lockStatementExpression :: Expression,-    lockStatementBody :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_LockStatement = (Core.Name "hydra/ext/csharp/syntax.LockStatement")--_LockStatement_expression = (Core.Name "expression")--_LockStatement_body = (Core.Name "body")--data UsingStatement = -  UsingStatement {-    usingStatementAcquisition :: ResourceAcquisition,-    usingStatementBody :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_UsingStatement = (Core.Name "hydra/ext/csharp/syntax.UsingStatement")--_UsingStatement_acquisition = (Core.Name "acquisition")--_UsingStatement_body = (Core.Name "body")--data ResourceAcquisition = -  ResourceAcquisitionLocal LocalVariableDeclaration |-  ResourceAcquisitionExpression Expression-  deriving (Eq, Ord, Read, Show)--_ResourceAcquisition = (Core.Name "hydra/ext/csharp/syntax.ResourceAcquisition")--_ResourceAcquisition_local = (Core.Name "local")--_ResourceAcquisition_expression = (Core.Name "expression")--data YieldStatement = -  YieldStatementReturn Expression |-  YieldStatementBreak -  deriving (Eq, Ord, Read, Show)--_YieldStatement = (Core.Name "hydra/ext/csharp/syntax.YieldStatement")--_YieldStatement_return = (Core.Name "return")--_YieldStatement_break = (Core.Name "break")--data CompilationUnit = -  CompilationUnit {-    compilationUnitExterns :: [Identifier],-    compilationUnitUsings :: [UsingDirective],-    compilationUnitAttributes :: [GlobalAttributeSection],-    compilationUnitMembers :: [NamespaceMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_CompilationUnit = (Core.Name "hydra/ext/csharp/syntax.CompilationUnit")--_CompilationUnit_externs = (Core.Name "externs")--_CompilationUnit_usings = (Core.Name "usings")--_CompilationUnit_attributes = (Core.Name "attributes")--_CompilationUnit_members = (Core.Name "members")--data NamespaceDeclaration = -  NamespaceDeclaration {-    namespaceDeclarationName :: [Identifier],-    namespaceDeclarationBody :: NamespaceBody}-  deriving (Eq, Ord, Read, Show)--_NamespaceDeclaration = (Core.Name "hydra/ext/csharp/syntax.NamespaceDeclaration")--_NamespaceDeclaration_name = (Core.Name "name")--_NamespaceDeclaration_body = (Core.Name "body")--data NamespaceBody = -  NamespaceBody {-    namespaceBodyExterns :: [Identifier],-    namespaceBodyUsings :: [UsingDirective],-    namespaceBodyMembers :: [NamespaceMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_NamespaceBody = (Core.Name "hydra/ext/csharp/syntax.NamespaceBody")--_NamespaceBody_externs = (Core.Name "externs")--_NamespaceBody_usings = (Core.Name "usings")--_NamespaceBody_members = (Core.Name "members")--data UsingDirective = -  UsingDirectiveAlias UsingAliasDirective |-  UsingDirectiveNamespace NamespaceName |-  UsingDirectiveStatic TypeName-  deriving (Eq, Ord, Read, Show)--_UsingDirective = (Core.Name "hydra/ext/csharp/syntax.UsingDirective")--_UsingDirective_alias = (Core.Name "alias")--_UsingDirective_namespace = (Core.Name "namespace")--_UsingDirective_static = (Core.Name "static")--data UsingAliasDirective = -  UsingAliasDirective {-    usingAliasDirectiveAlias :: Identifier,-    usingAliasDirectiveName :: NamespaceOrTypeName}-  deriving (Eq, Ord, Read, Show)--_UsingAliasDirective = (Core.Name "hydra/ext/csharp/syntax.UsingAliasDirective")--_UsingAliasDirective_alias = (Core.Name "alias")--_UsingAliasDirective_name = (Core.Name "name")--data NamespaceMemberDeclaration = -  NamespaceMemberDeclarationNamespace NamespaceDeclaration |-  NamespaceMemberDeclarationType TypeDeclaration-  deriving (Eq, Ord, Read, Show)--_NamespaceMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.NamespaceMemberDeclaration")--_NamespaceMemberDeclaration_namespace = (Core.Name "namespace")--_NamespaceMemberDeclaration_type = (Core.Name "type")--data TypeDeclaration = -  TypeDeclarationClass ClassDeclaration |-  TypeDeclarationStruct StructDeclaration |-  TypeDeclarationInterface InterfaceDeclaration |-  TypeDeclarationEnum EnumDeclaration |-  TypeDeclarationDelegate DelegateDeclaration-  deriving (Eq, Ord, Read, Show)--_TypeDeclaration = (Core.Name "hydra/ext/csharp/syntax.TypeDeclaration")--_TypeDeclaration_class = (Core.Name "class")--_TypeDeclaration_struct = (Core.Name "struct")--_TypeDeclaration_interface = (Core.Name "interface")--_TypeDeclaration_enum = (Core.Name "enum")--_TypeDeclaration_delegate = (Core.Name "delegate")--data QualifiedAliasMember = -  QualifiedAliasMember {-    qualifiedAliasMemberAlias :: Identifier,-    qualifiedAliasMemberMember :: Identifier,-    qualifiedAliasMemberArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_QualifiedAliasMember = (Core.Name "hydra/ext/csharp/syntax.QualifiedAliasMember")--_QualifiedAliasMember_alias = (Core.Name "alias")--_QualifiedAliasMember_member = (Core.Name "member")--_QualifiedAliasMember_arguments = (Core.Name "arguments")--data ClassDeclaration = -  ClassDeclaration {-    classDeclarationAttributes :: (Maybe Attributes),-    classDeclarationModifiers :: [ClassModifier],-    classDeclarationPartial :: (),-    classDeclarationName :: Identifier,-    classDeclarationParameters :: (Maybe TypeParameterList),-    classDeclarationBase :: (Maybe ClassBase),-    classDeclarationConstraints :: [TypeParameterConstraintsClause],-    classDeclarationBody :: ClassBody}-  deriving (Eq, Ord, Read, Show)--_ClassDeclaration = (Core.Name "hydra/ext/csharp/syntax.ClassDeclaration")--_ClassDeclaration_attributes = (Core.Name "attributes")--_ClassDeclaration_modifiers = (Core.Name "modifiers")--_ClassDeclaration_partial = (Core.Name "partial")--_ClassDeclaration_name = (Core.Name "name")--_ClassDeclaration_parameters = (Core.Name "parameters")--_ClassDeclaration_base = (Core.Name "base")--_ClassDeclaration_constraints = (Core.Name "constraints")--_ClassDeclaration_body = (Core.Name "body")--data ClassModifier = -  ClassModifierNew  |-  ClassModifierPublic  |-  ClassModifierProtected  |-  ClassModifierInternal  |-  ClassModifierPrivate  |-  ClassModifierAbstract  |-  ClassModifierSealed  |-  ClassModifierStatic  |-  ClassModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_ClassModifier = (Core.Name "hydra/ext/csharp/syntax.ClassModifier")--_ClassModifier_new = (Core.Name "new")--_ClassModifier_public = (Core.Name "public")--_ClassModifier_protected = (Core.Name "protected")--_ClassModifier_internal = (Core.Name "internal")--_ClassModifier_private = (Core.Name "private")--_ClassModifier_abstract = (Core.Name "abstract")--_ClassModifier_sealed = (Core.Name "sealed")--_ClassModifier_static = (Core.Name "static")--_ClassModifier_unsafe = (Core.Name "unsafe")--newtype TypeParameterList = -  TypeParameterList {-    unTypeParameterList :: [TypeParameterPart]}-  deriving (Eq, Ord, Read, Show)--_TypeParameterList = (Core.Name "hydra/ext/csharp/syntax.TypeParameterList")--data TypeParameterPart = -  TypeParameterPart {-    typeParameterPartAttributes :: (Maybe Attributes),-    typeParameterPartName :: TypeParameter}-  deriving (Eq, Ord, Read, Show)--_TypeParameterPart = (Core.Name "hydra/ext/csharp/syntax.TypeParameterPart")--_TypeParameterPart_attributes = (Core.Name "attributes")--_TypeParameterPart_name = (Core.Name "name")--data ClassBase = -  ClassBaseClass (Maybe ClassType) |-  ClassBaseInterfaces [InterfaceType]-  deriving (Eq, Ord, Read, Show)--_ClassBase = (Core.Name "hydra/ext/csharp/syntax.ClassBase")--_ClassBase_class = (Core.Name "class")--_ClassBase_interfaces = (Core.Name "interfaces")--data TypeParameterConstraintsClause = -  TypeParameterConstraintsClause {-    typeParameterConstraintsClauseParameter :: TypeParameter,-    typeParameterConstraintsClauseConstraints :: [TypeParameterConstraints]}-  deriving (Eq, Ord, Read, Show)--_TypeParameterConstraintsClause = (Core.Name "hydra/ext/csharp/syntax.TypeParameterConstraintsClause")--_TypeParameterConstraintsClause_parameter = (Core.Name "parameter")--_TypeParameterConstraintsClause_constraints = (Core.Name "constraints")--data TypeParameterConstraints = -  TypeParameterConstraints {-    typeParameterConstraintsPrimary :: (Maybe PrimaryConstraint),-    typeParameterConstraintsSecondary :: (Maybe SecondaryConstraints),-    typeParameterConstraintsConstructor :: Bool}-  deriving (Eq, Ord, Read, Show)--_TypeParameterConstraints = (Core.Name "hydra/ext/csharp/syntax.TypeParameterConstraints")--_TypeParameterConstraints_primary = (Core.Name "primary")--_TypeParameterConstraints_secondary = (Core.Name "secondary")--_TypeParameterConstraints_constructor = (Core.Name "constructor")--data PrimaryConstraint = -  PrimaryConstraintClassType ClassType |-  PrimaryConstraintClass  |-  PrimaryConstraintStruct  |-  PrimaryConstraintUnmanaged -  deriving (Eq, Ord, Read, Show)--_PrimaryConstraint = (Core.Name "hydra/ext/csharp/syntax.PrimaryConstraint")--_PrimaryConstraint_classType = (Core.Name "classType")--_PrimaryConstraint_class = (Core.Name "class")--_PrimaryConstraint_struct = (Core.Name "struct")--_PrimaryConstraint_unmanaged = (Core.Name "unmanaged")--newtype SecondaryConstraints = -  SecondaryConstraints {-    unSecondaryConstraints :: [SecondaryConstraint]}-  deriving (Eq, Ord, Read, Show)--_SecondaryConstraints = (Core.Name "hydra/ext/csharp/syntax.SecondaryConstraints")--data SecondaryConstraint = -  SecondaryConstraintInterface InterfaceType |-  SecondaryConstraintParameter TypeParameter-  deriving (Eq, Ord, Read, Show)--_SecondaryConstraint = (Core.Name "hydra/ext/csharp/syntax.SecondaryConstraint")--_SecondaryConstraint_interface = (Core.Name "interface")--_SecondaryConstraint_parameter = (Core.Name "parameter")--newtype ClassBody = -  ClassBody {-    unClassBody :: [ClassMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_ClassBody = (Core.Name "hydra/ext/csharp/syntax.ClassBody")--data ClassMemberDeclaration = -  ClassMemberDeclarationConstant ConstantDeclaration |-  ClassMemberDeclarationField FieldDeclaration |-  ClassMemberDeclarationMethod MethodDeclaration |-  ClassMemberDeclarationProperty PropertyDeclaration |-  ClassMemberDeclarationEvent EventDeclaration |-  ClassMemberDeclarationIndexer IndexerDeclaration |-  ClassMemberDeclarationOperator OperatorDeclaration |-  ClassMemberDeclarationConstructor ConstructorDeclaration |-  ClassMemberDeclarationFinalizer FinalizerDeclaration |-  ClassMemberDeclarationStaticConstructor StaticConstructorDeclaration |-  ClassMemberDeclarationType TypeDeclaration-  deriving (Eq, Ord, Read, Show)--_ClassMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.ClassMemberDeclaration")--_ClassMemberDeclaration_constant = (Core.Name "constant")--_ClassMemberDeclaration_field = (Core.Name "field")--_ClassMemberDeclaration_method = (Core.Name "method")--_ClassMemberDeclaration_property = (Core.Name "property")--_ClassMemberDeclaration_event = (Core.Name "event")--_ClassMemberDeclaration_indexer = (Core.Name "indexer")--_ClassMemberDeclaration_operator = (Core.Name "operator")--_ClassMemberDeclaration_constructor = (Core.Name "constructor")--_ClassMemberDeclaration_finalizer = (Core.Name "finalizer")--_ClassMemberDeclaration_staticConstructor = (Core.Name "staticConstructor")--_ClassMemberDeclaration_type = (Core.Name "type")--data ConstantDeclaration = -  ConstantDeclaration {-    constantDeclarationAttributes :: (Maybe Attributes),-    constantDeclarationModifiers :: [ConstantModifier],-    constantDeclarationType :: Type,-    constantDeclarationDeclarators :: [ConstantDeclarator]}-  deriving (Eq, Ord, Read, Show)--_ConstantDeclaration = (Core.Name "hydra/ext/csharp/syntax.ConstantDeclaration")--_ConstantDeclaration_attributes = (Core.Name "attributes")--_ConstantDeclaration_modifiers = (Core.Name "modifiers")--_ConstantDeclaration_type = (Core.Name "type")--_ConstantDeclaration_declarators = (Core.Name "declarators")--data ConstantModifier = -  ConstantModifierNew  |-  ConstantModifierPublic  |-  ConstantModifierProtected  |-  ConstantModifierInternal  |-  ConstantModifierPrivate -  deriving (Eq, Ord, Read, Show)--_ConstantModifier = (Core.Name "hydra/ext/csharp/syntax.ConstantModifier")--_ConstantModifier_new = (Core.Name "new")--_ConstantModifier_public = (Core.Name "public")--_ConstantModifier_protected = (Core.Name "protected")--_ConstantModifier_internal = (Core.Name "internal")--_ConstantModifier_private = (Core.Name "private")--data FieldDeclaration = -  FieldDeclaration {-    fieldDeclarationAttributes :: (Maybe Attributes),-    fieldDeclarationModifiers :: [FieldModifier],-    fieldDeclarationType :: Type,-    fieldDeclarationDeclarators :: [VariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_FieldDeclaration = (Core.Name "hydra/ext/csharp/syntax.FieldDeclaration")--_FieldDeclaration_attributes = (Core.Name "attributes")--_FieldDeclaration_modifiers = (Core.Name "modifiers")--_FieldDeclaration_type = (Core.Name "type")--_FieldDeclaration_declarators = (Core.Name "declarators")--data FieldModifier = -  FieldModifierNew  |-  FieldModifierPublic  |-  FieldModifierProtected  |-  FieldModifierInternal  |-  FieldModifierPrivate  |-  FieldModifierStatic  |-  FieldModifierReadonly  |-  FieldModifierVolatile  |-  FieldModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_FieldModifier = (Core.Name "hydra/ext/csharp/syntax.FieldModifier")--_FieldModifier_new = (Core.Name "new")--_FieldModifier_public = (Core.Name "public")--_FieldModifier_protected = (Core.Name "protected")--_FieldModifier_internal = (Core.Name "internal")--_FieldModifier_private = (Core.Name "private")--_FieldModifier_static = (Core.Name "static")--_FieldModifier_readonly = (Core.Name "readonly")--_FieldModifier_volatile = (Core.Name "volatile")--_FieldModifier_unsafe = (Core.Name "unsafe")--newtype VariableDeclarators = -  VariableDeclarators {-    unVariableDeclarators :: [VariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_VariableDeclarators = (Core.Name "hydra/ext/csharp/syntax.VariableDeclarators")--data VariableDeclarator = -  VariableDeclarator {-    variableDeclaratorIdentifier :: Identifier,-    variableDeclaratorInitializer :: (Maybe VariableInitializer)}-  deriving (Eq, Ord, Read, Show)--_VariableDeclarator = (Core.Name "hydra/ext/csharp/syntax.VariableDeclarator")--_VariableDeclarator_identifier = (Core.Name "identifier")--_VariableDeclarator_initializer = (Core.Name "initializer")--data MethodDeclaration = -  MethodDeclarationStandard StandardMethodDeclaration |-  MethodDeclarationRefReturn RefReturnMethodDeclaration-  deriving (Eq, Ord, Read, Show)--_MethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.MethodDeclaration")--_MethodDeclaration_standard = (Core.Name "standard")--_MethodDeclaration_refReturn = (Core.Name "refReturn")--data StandardMethodDeclaration = -  StandardMethodDeclaration {-    standardMethodDeclarationAttributes :: (Maybe Attributes),-    standardMethodDeclarationModifiers :: [MethodModifier],-    standardMethodDeclarationReturnType :: ReturnType,-    standardMethodDeclarationHeader :: MethodHeader,-    standardMethodDeclarationBody :: MethodBody}-  deriving (Eq, Ord, Read, Show)--_StandardMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardMethodDeclaration")--_StandardMethodDeclaration_attributes = (Core.Name "attributes")--_StandardMethodDeclaration_modifiers = (Core.Name "modifiers")--_StandardMethodDeclaration_returnType = (Core.Name "returnType")--_StandardMethodDeclaration_header = (Core.Name "header")--_StandardMethodDeclaration_body = (Core.Name "body")--data RefReturnMethodDeclaration = -  RefReturnMethodDeclaration {-    refReturnMethodDeclarationAttributes :: (Maybe Attributes),-    refReturnMethodDeclarationModifiers :: [RefMethodModifier],-    refReturnMethodDeclarationKind :: RefKind,-    refReturnMethodDeclarationReturnType :: ReturnType,-    refReturnMethodDeclarationHeader :: MethodHeader,-    refReturnMethodDeclarationBody :: RefMethodBody}-  deriving (Eq, Ord, Read, Show)--_RefReturnMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefReturnMethodDeclaration")--_RefReturnMethodDeclaration_attributes = (Core.Name "attributes")--_RefReturnMethodDeclaration_modifiers = (Core.Name "modifiers")--_RefReturnMethodDeclaration_kind = (Core.Name "kind")--_RefReturnMethodDeclaration_returnType = (Core.Name "returnType")--_RefReturnMethodDeclaration_header = (Core.Name "header")--_RefReturnMethodDeclaration_body = (Core.Name "body")--data MethodModifiers = -  MethodModifiers {-    methodModifiersModifiers :: [MethodModifier],-    methodModifiersPartial :: Bool}-  deriving (Eq, Ord, Read, Show)--_MethodModifiers = (Core.Name "hydra/ext/csharp/syntax.MethodModifiers")--_MethodModifiers_modifiers = (Core.Name "modifiers")--_MethodModifiers_partial = (Core.Name "partial")--data RefKind = -  RefKindRef  |-  RefKindRefReadonly -  deriving (Eq, Ord, Read, Show)--_RefKind = (Core.Name "hydra/ext/csharp/syntax.RefKind")--_RefKind_ref = (Core.Name "ref")--_RefKind_refReadonly = (Core.Name "refReadonly")--data MethodHeader = -  MethodHeader {-    methodHeaderName :: MemberName,-    methodHeaderTypeParameters :: (Maybe TypeParameterList),-    methodHeaderParameters :: (Maybe FormalParameterList),-    methodHeaderConstraints :: [TypeParameterConstraintsClause]}-  deriving (Eq, Ord, Read, Show)--_MethodHeader = (Core.Name "hydra/ext/csharp/syntax.MethodHeader")--_MethodHeader_name = (Core.Name "name")--_MethodHeader_typeParameters = (Core.Name "typeParameters")--_MethodHeader_parameters = (Core.Name "parameters")--_MethodHeader_constraints = (Core.Name "constraints")--data MethodModifier = -  MethodModifierRef RefMethodModifier |-  MethodModifierAsync -  deriving (Eq, Ord, Read, Show)--_MethodModifier = (Core.Name "hydra/ext/csharp/syntax.MethodModifier")--_MethodModifier_ref = (Core.Name "ref")--_MethodModifier_async = (Core.Name "async")--data RefMethodModifier = -  RefMethodModifierNew  |-  RefMethodModifierPublic  |-  RefMethodModifierProtected  |-  RefMethodModifierInternal  |-  RefMethodModifierPrivate  |-  RefMethodModifierStatic  |-  RefMethodModifierVirtual  |-  RefMethodModifierSealed  |-  RefMethodModifierOverride  |-  RefMethodModifierAbstract  |-  RefMethodModifierExtern  |-  RefMethodModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_RefMethodModifier = (Core.Name "hydra/ext/csharp/syntax.RefMethodModifier")--_RefMethodModifier_new = (Core.Name "new")--_RefMethodModifier_public = (Core.Name "public")--_RefMethodModifier_protected = (Core.Name "protected")--_RefMethodModifier_internal = (Core.Name "internal")--_RefMethodModifier_private = (Core.Name "private")--_RefMethodModifier_static = (Core.Name "static")--_RefMethodModifier_virtual = (Core.Name "virtual")--_RefMethodModifier_sealed = (Core.Name "sealed")--_RefMethodModifier_override = (Core.Name "override")--_RefMethodModifier_abstract = (Core.Name "abstract")--_RefMethodModifier_extern = (Core.Name "extern")--_RefMethodModifier_unsafe = (Core.Name "unsafe")--data ReturnType = -  ReturnTypeRef Type |-  ReturnTypeVoid -  deriving (Eq, Ord, Read, Show)--_ReturnType = (Core.Name "hydra/ext/csharp/syntax.ReturnType")--_ReturnType_ref = (Core.Name "ref")--_ReturnType_void = (Core.Name "void")--data MemberName = -  MemberName {-    memberNameInterfaceType :: (Maybe TypeName),-    memberNameIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MemberName = (Core.Name "hydra/ext/csharp/syntax.MemberName")--_MemberName_interfaceType = (Core.Name "interfaceType")--_MemberName_identifier = (Core.Name "identifier")--data MethodBody = -  MethodBodyBlock Block |-  MethodBodyNullConditionalInvocation NullConditionalInvocationExpression |-  MethodBodyExpression Expression |-  MethodBodyEmpty -  deriving (Eq, Ord, Read, Show)--_MethodBody = (Core.Name "hydra/ext/csharp/syntax.MethodBody")--_MethodBody_block = (Core.Name "block")--_MethodBody_nullConditionalInvocation = (Core.Name "nullConditionalInvocation")--_MethodBody_expression = (Core.Name "expression")--_MethodBody_empty = (Core.Name "empty")--data RefMethodBody = -  RefMethodBodyBlock Block |-  RefMethodBodyRef VariableReference |-  RefMethodBodyEmpty -  deriving (Eq, Ord, Read, Show)--_RefMethodBody = (Core.Name "hydra/ext/csharp/syntax.RefMethodBody")--_RefMethodBody_block = (Core.Name "block")--_RefMethodBody_ref = (Core.Name "ref")--_RefMethodBody_empty = (Core.Name "empty")--data FormalParameterList = -  FormalParameterList {-    formalParameterListFixed :: [FixedParameter],-    formalParameterListArray :: (Maybe ParameterArray)}-  deriving (Eq, Ord, Read, Show)--_FormalParameterList = (Core.Name "hydra/ext/csharp/syntax.FormalParameterList")--_FormalParameterList_fixed = (Core.Name "fixed")--_FormalParameterList_array = (Core.Name "array")--data FixedParameter = -  FixedParameter {-    fixedParameterAttributes :: (Maybe Attributes),-    fixedParameterModifier :: (Maybe ParameterModifier),-    fixedParameterType :: Type,-    fixedParameterIdentifier :: Identifier,-    fixedParameterDefaultArgument :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_FixedParameter = (Core.Name "hydra/ext/csharp/syntax.FixedParameter")--_FixedParameter_attributes = (Core.Name "attributes")--_FixedParameter_modifier = (Core.Name "modifier")--_FixedParameter_type = (Core.Name "type")--_FixedParameter_identifier = (Core.Name "identifier")--_FixedParameter_defaultArgument = (Core.Name "defaultArgument")--data ParameterModifier = -  ParameterModifierMode ParameterModeModifier |-  ParameterModifierThis -  deriving (Eq, Ord, Read, Show)--_ParameterModifier = (Core.Name "hydra/ext/csharp/syntax.ParameterModifier")--_ParameterModifier_mode = (Core.Name "mode")--_ParameterModifier_this = (Core.Name "this")--data ParameterModeModifier = -  ParameterModeModifierRef  |-  ParameterModeModifierOut  |-  ParameterModeModifierIn -  deriving (Eq, Ord, Read, Show)--_ParameterModeModifier = (Core.Name "hydra/ext/csharp/syntax.ParameterModeModifier")--_ParameterModeModifier_ref = (Core.Name "ref")--_ParameterModeModifier_out = (Core.Name "out")--_ParameterModeModifier_in = (Core.Name "in")--data ParameterArray = -  ParameterArray {-    parameterArrayAttributes :: (Maybe Attributes),-    parameterArrayType :: ArrayType,-    parameterArrayIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_ParameterArray = (Core.Name "hydra/ext/csharp/syntax.ParameterArray")--_ParameterArray_attributes = (Core.Name "attributes")--_ParameterArray_type = (Core.Name "type")--_ParameterArray_identifier = (Core.Name "identifier")--data PropertyDeclaration = -  PropertyDeclarationStandard StandardPropertyDeclaration |-  PropertyDeclarationRefReturn RefReturnPropertyDeclaration-  deriving (Eq, Ord, Read, Show)--_PropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.PropertyDeclaration")--_PropertyDeclaration_standard = (Core.Name "standard")--_PropertyDeclaration_refReturn = (Core.Name "refReturn")--data StandardPropertyDeclaration = -  StandardPropertyDeclaration {-    standardPropertyDeclarationAttributes :: (Maybe Attributes),-    standardPropertyDeclarationModifiers :: [PropertyModifier],-    standardPropertyDeclarationType :: Type,-    standardPropertyDeclarationName :: MemberName,-    standardPropertyDeclarationBody :: PropertyBody}-  deriving (Eq, Ord, Read, Show)--_StandardPropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardPropertyDeclaration")--_StandardPropertyDeclaration_attributes = (Core.Name "attributes")--_StandardPropertyDeclaration_modifiers = (Core.Name "modifiers")--_StandardPropertyDeclaration_type = (Core.Name "type")--_StandardPropertyDeclaration_name = (Core.Name "name")--_StandardPropertyDeclaration_body = (Core.Name "body")--data RefReturnPropertyDeclaration = -  RefReturnPropertyDeclaration {-    refReturnPropertyDeclarationAttributes :: (Maybe Attributes),-    refReturnPropertyDeclarationModifiers :: [PropertyModifier],-    refReturnPropertyDeclarationRefKind :: RefKind,-    refReturnPropertyDeclarationType :: Type,-    refReturnPropertyDeclarationName :: MemberName,-    refReturnPropertyDeclarationBody :: RefPropertyBody}-  deriving (Eq, Ord, Read, Show)--_RefReturnPropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefReturnPropertyDeclaration")--_RefReturnPropertyDeclaration_attributes = (Core.Name "attributes")--_RefReturnPropertyDeclaration_modifiers = (Core.Name "modifiers")--_RefReturnPropertyDeclaration_refKind = (Core.Name "refKind")--_RefReturnPropertyDeclaration_type = (Core.Name "type")--_RefReturnPropertyDeclaration_name = (Core.Name "name")--_RefReturnPropertyDeclaration_body = (Core.Name "body")--data PropertyModifier = -  PropertyModifierNew  |-  PropertyModifierPublic  |-  PropertyModifierProtected  |-  PropertyModifierInternal  |-  PropertyModifierPrivate  |-  PropertyModifierStatic  |-  PropertyModifierVirtual  |-  PropertyModifierSealed  |-  PropertyModifierOverride  |-  PropertyModifierAbstract  |-  PropertyModifierExtern  |-  PropertyModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_PropertyModifier = (Core.Name "hydra/ext/csharp/syntax.PropertyModifier")--_PropertyModifier_new = (Core.Name "new")--_PropertyModifier_public = (Core.Name "public")--_PropertyModifier_protected = (Core.Name "protected")--_PropertyModifier_internal = (Core.Name "internal")--_PropertyModifier_private = (Core.Name "private")--_PropertyModifier_static = (Core.Name "static")--_PropertyModifier_virtual = (Core.Name "virtual")--_PropertyModifier_sealed = (Core.Name "sealed")--_PropertyModifier_override = (Core.Name "override")--_PropertyModifier_abstract = (Core.Name "abstract")--_PropertyModifier_extern = (Core.Name "extern")--_PropertyModifier_unsafe = (Core.Name "unsafe")--data PropertyBody = -  PropertyBodyBlock BlockPropertyBody |-  PropertyBodyExpression Expression-  deriving (Eq, Ord, Read, Show)--_PropertyBody = (Core.Name "hydra/ext/csharp/syntax.PropertyBody")--_PropertyBody_block = (Core.Name "block")--_PropertyBody_expression = (Core.Name "expression")--data BlockPropertyBody = -  BlockPropertyBody {-    blockPropertyBodyAccessors :: AccessorDeclarations,-    blockPropertyBodyInitializer :: (Maybe VariableInitializer)}-  deriving (Eq, Ord, Read, Show)--_BlockPropertyBody = (Core.Name "hydra/ext/csharp/syntax.BlockPropertyBody")--_BlockPropertyBody_accessors = (Core.Name "accessors")--_BlockPropertyBody_initializer = (Core.Name "initializer")--data RefPropertyBody = -  RefPropertyBodyBlock RefGetAccessorDeclaration |-  RefPropertyBodyRef VariableReference-  deriving (Eq, Ord, Read, Show)--_RefPropertyBody = (Core.Name "hydra/ext/csharp/syntax.RefPropertyBody")--_RefPropertyBody_block = (Core.Name "block")--_RefPropertyBody_ref = (Core.Name "ref")--data AccessorDeclarations = -  AccessorDeclarationsGet (Maybe AccessorDeclaration) |-  AccessorDeclarationsSet (Maybe AccessorDeclaration)-  deriving (Eq, Ord, Read, Show)--_AccessorDeclarations = (Core.Name "hydra/ext/csharp/syntax.AccessorDeclarations")--_AccessorDeclarations_get = (Core.Name "get")--_AccessorDeclarations_set = (Core.Name "set")--data AccessorDeclaration = -  AccessorDeclaration {-    accessorDeclarationAttributes :: (Maybe Attributes),-    accessorDeclarationModifier :: (Maybe AccessorModifier),-    accessorDeclarationBody :: AccessorBody}-  deriving (Eq, Ord, Read, Show)--_AccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.AccessorDeclaration")--_AccessorDeclaration_attributes = (Core.Name "attributes")--_AccessorDeclaration_modifier = (Core.Name "modifier")--_AccessorDeclaration_body = (Core.Name "body")--data AccessorModifier = -  AccessorModifierProtected  |-  AccessorModifierInternal  |-  AccessorModifierPrivate  |-  AccessorModifierProtectedInternal  |-  AccessorModifierInternalProtected  |-  AccessorModifierProtectedPrivate  |-  AccessorModifierPrivateProtected -  deriving (Eq, Ord, Read, Show)--_AccessorModifier = (Core.Name "hydra/ext/csharp/syntax.AccessorModifier")--_AccessorModifier_protected = (Core.Name "protected")--_AccessorModifier_internal = (Core.Name "internal")--_AccessorModifier_private = (Core.Name "private")--_AccessorModifier_protectedInternal = (Core.Name "protectedInternal")--_AccessorModifier_internalProtected = (Core.Name "internalProtected")--_AccessorModifier_protectedPrivate = (Core.Name "protectedPrivate")--_AccessorModifier_privateProtected = (Core.Name "privateProtected")--data AccessorBody = -  AccessorBodyBlock Block |-  AccessorBodyExpression Expression |-  AccessorBodyEmpty -  deriving (Eq, Ord, Read, Show)--_AccessorBody = (Core.Name "hydra/ext/csharp/syntax.AccessorBody")--_AccessorBody_block = (Core.Name "block")--_AccessorBody_expression = (Core.Name "expression")--_AccessorBody_empty = (Core.Name "empty")--data RefGetAccessorDeclaration = -  RefGetAccessorDeclaration {-    refGetAccessorDeclarationAttributes :: (Maybe Attributes),-    refGetAccessorDeclarationModifier :: (Maybe AccessorModifier),-    refGetAccessorDeclarationBody :: RefAccessorBody}-  deriving (Eq, Ord, Read, Show)--_RefGetAccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefGetAccessorDeclaration")--_RefGetAccessorDeclaration_attributes = (Core.Name "attributes")--_RefGetAccessorDeclaration_modifier = (Core.Name "modifier")--_RefGetAccessorDeclaration_body = (Core.Name "body")--data RefAccessorBody = -  RefAccessorBodyBlock Block |-  RefAccessorBodyRef VariableReference |-  RefAccessorBodyEmpty -  deriving (Eq, Ord, Read, Show)--_RefAccessorBody = (Core.Name "hydra/ext/csharp/syntax.RefAccessorBody")--_RefAccessorBody_block = (Core.Name "block")--_RefAccessorBody_ref = (Core.Name "ref")--_RefAccessorBody_empty = (Core.Name "empty")--data EventDeclaration = -  EventDeclarationStandard StandardEventDeclaration |-  EventDeclarationAccessors AccessorsEventDeclaration-  deriving (Eq, Ord, Read, Show)--_EventDeclaration = (Core.Name "hydra/ext/csharp/syntax.EventDeclaration")--_EventDeclaration_standard = (Core.Name "standard")--_EventDeclaration_accessors = (Core.Name "accessors")--data StandardEventDeclaration = -  StandardEventDeclaration {-    standardEventDeclarationAttributes :: (Maybe Attributes),-    standardEventDeclarationModifiers :: [EventModifier],-    standardEventDeclarationType :: Type,-    standardEventDeclarationDeclarators :: VariableDeclarators}-  deriving (Eq, Ord, Read, Show)--_StandardEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardEventDeclaration")--_StandardEventDeclaration_attributes = (Core.Name "attributes")--_StandardEventDeclaration_modifiers = (Core.Name "modifiers")--_StandardEventDeclaration_type = (Core.Name "type")--_StandardEventDeclaration_declarators = (Core.Name "declarators")--data AccessorsEventDeclaration = -  AccessorsEventDeclaration {-    accessorsEventDeclarationAttributes :: (Maybe Attributes),-    accessorsEventDeclarationModifiers :: [EventModifier],-    accessorsEventDeclarationType :: Type,-    accessorsEventDeclarationName :: MemberName,-    accessorsEventDeclarationAccessors :: EventAccessorDeclarations}-  deriving (Eq, Ord, Read, Show)--_AccessorsEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.AccessorsEventDeclaration")--_AccessorsEventDeclaration_attributes = (Core.Name "attributes")--_AccessorsEventDeclaration_modifiers = (Core.Name "modifiers")--_AccessorsEventDeclaration_type = (Core.Name "type")--_AccessorsEventDeclaration_name = (Core.Name "name")--_AccessorsEventDeclaration_accessors = (Core.Name "accessors")--data EventModifier = -  EventModifierNew  |-  EventModifierPublic  |-  EventModifierProtected  |-  EventModifierInternal  |-  EventModifierPrivate  |-  EventModifierStatic  |-  EventModifierVirtual  |-  EventModifierSealed  |-  EventModifierOverride  |-  EventModifierAbstract  |-  EventModifierExtern  |-  EventModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_EventModifier = (Core.Name "hydra/ext/csharp/syntax.EventModifier")--_EventModifier_new = (Core.Name "new")--_EventModifier_public = (Core.Name "public")--_EventModifier_protected = (Core.Name "protected")--_EventModifier_internal = (Core.Name "internal")--_EventModifier_private = (Core.Name "private")--_EventModifier_static = (Core.Name "static")--_EventModifier_virtual = (Core.Name "virtual")--_EventModifier_sealed = (Core.Name "sealed")--_EventModifier_override = (Core.Name "override")--_EventModifier_abstract = (Core.Name "abstract")--_EventModifier_extern = (Core.Name "extern")--_EventModifier_unsafe = (Core.Name "unsafe")--data EventAccessorDeclarations = -  EventAccessorDeclarationsAdd AddRemoveAccessorDeclaration |-  EventAccessorDeclarationsRemove AddRemoveAccessorDeclaration-  deriving (Eq, Ord, Read, Show)--_EventAccessorDeclarations = (Core.Name "hydra/ext/csharp/syntax.EventAccessorDeclarations")--_EventAccessorDeclarations_add = (Core.Name "add")--_EventAccessorDeclarations_remove = (Core.Name "remove")--data AddRemoveAccessorDeclaration = -  AddRemoveAccessorDeclaration {-    addRemoveAccessorDeclarationAttributes :: (Maybe Attributes),-    addRemoveAccessorDeclarationBody :: Block}-  deriving (Eq, Ord, Read, Show)--_AddRemoveAccessorDeclaration = (Core.Name "hydra/ext/csharp/syntax.AddRemoveAccessorDeclaration")--_AddRemoveAccessorDeclaration_attributes = (Core.Name "attributes")--_AddRemoveAccessorDeclaration_body = (Core.Name "body")--data IndexerDeclaration = -  IndexerDeclarationStandard StandardIndexerDeclaration |-  IndexerDeclarationRef RefIndexerDeclaration-  deriving (Eq, Ord, Read, Show)--_IndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.IndexerDeclaration")--_IndexerDeclaration_standard = (Core.Name "standard")--_IndexerDeclaration_ref = (Core.Name "ref")--data StandardIndexerDeclaration = -  StandardIndexerDeclaration {-    standardIndexerDeclarationAttributes :: (Maybe Attributes),-    standardIndexerDeclarationModifiers :: [IndexerModifier],-    standardIndexerDeclarationDeclarator :: IndexerDeclarator,-    standardIndexerDeclarationBody :: IndexerBody}-  deriving (Eq, Ord, Read, Show)--_StandardIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.StandardIndexerDeclaration")--_StandardIndexerDeclaration_attributes = (Core.Name "attributes")--_StandardIndexerDeclaration_modifiers = (Core.Name "modifiers")--_StandardIndexerDeclaration_declarator = (Core.Name "declarator")--_StandardIndexerDeclaration_body = (Core.Name "body")--data RefIndexerDeclaration = -  RefIndexerDeclaration {-    refIndexerDeclarationAttributes :: (Maybe Attributes),-    refIndexerDeclarationModifiers :: [IndexerModifier],-    refIndexerDeclarationRefKind :: RefKind,-    refIndexerDeclarationDeclarator :: IndexerDeclarator,-    refIndexerDeclarationBody :: RefIndexerBody}-  deriving (Eq, Ord, Read, Show)--_RefIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.RefIndexerDeclaration")--_RefIndexerDeclaration_attributes = (Core.Name "attributes")--_RefIndexerDeclaration_modifiers = (Core.Name "modifiers")--_RefIndexerDeclaration_refKind = (Core.Name "refKind")--_RefIndexerDeclaration_declarator = (Core.Name "declarator")--_RefIndexerDeclaration_body = (Core.Name "body")--data IndexerModifier = -  IndexerModifierNew  |-  IndexerModifierPublic  |-  IndexerModifierProtected  |-  IndexerModifierInternal  |-  IndexerModifierPrivate  |-  IndexerModifierVirtual  |-  IndexerModifierSealed  |-  IndexerModifierOverride  |-  IndexerModifierAbstract  |-  IndexerModifierExtern  |-  IndexerModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_IndexerModifier = (Core.Name "hydra/ext/csharp/syntax.IndexerModifier")--_IndexerModifier_new = (Core.Name "new")--_IndexerModifier_public = (Core.Name "public")--_IndexerModifier_protected = (Core.Name "protected")--_IndexerModifier_internal = (Core.Name "internal")--_IndexerModifier_private = (Core.Name "private")--_IndexerModifier_virtual = (Core.Name "virtual")--_IndexerModifier_sealed = (Core.Name "sealed")--_IndexerModifier_override = (Core.Name "override")--_IndexerModifier_abstract = (Core.Name "abstract")--_IndexerModifier_extern = (Core.Name "extern")--_IndexerModifier_unsafe = (Core.Name "unsafe")--data IndexerDeclarator = -  IndexerDeclarator {-    indexerDeclaratorType :: Type,-    indexerDeclaratorInterface :: (Maybe InterfaceType),-    indexerDeclaratorParameters :: FormalParameterList}-  deriving (Eq, Ord, Read, Show)--_IndexerDeclarator = (Core.Name "hydra/ext/csharp/syntax.IndexerDeclarator")--_IndexerDeclarator_type = (Core.Name "type")--_IndexerDeclarator_interface = (Core.Name "interface")--_IndexerDeclarator_parameters = (Core.Name "parameters")--data IndexerBody = -  IndexerBodyBlock AccessorDeclarations |-  IndexerBodyExpression Expression-  deriving (Eq, Ord, Read, Show)--_IndexerBody = (Core.Name "hydra/ext/csharp/syntax.IndexerBody")--_IndexerBody_block = (Core.Name "block")--_IndexerBody_expression = (Core.Name "expression")--data RefIndexerBody = -  RefIndexerBodyBlock RefGetAccessorDeclaration |-  RefIndexerBodyRef VariableReference-  deriving (Eq, Ord, Read, Show)--_RefIndexerBody = (Core.Name "hydra/ext/csharp/syntax.RefIndexerBody")--_RefIndexerBody_block = (Core.Name "block")--_RefIndexerBody_ref = (Core.Name "ref")--data OperatorDeclaration = -  OperatorDeclaration {-    operatorDeclarationAttributes :: (Maybe Attributes),-    operatorDeclarationModifiers :: [OperatorModifier],-    operatorDeclarationDeclarator :: OperatorDeclarator,-    operatorDeclarationBody :: OperatorBody}-  deriving (Eq, Ord, Read, Show)--_OperatorDeclaration = (Core.Name "hydra/ext/csharp/syntax.OperatorDeclaration")--_OperatorDeclaration_attributes = (Core.Name "attributes")--_OperatorDeclaration_modifiers = (Core.Name "modifiers")--_OperatorDeclaration_declarator = (Core.Name "declarator")--_OperatorDeclaration_body = (Core.Name "body")--data OperatorModifier = -  OperatorModifierPublic  |-  OperatorModifierStatic  |-  OperatorModifierExtern  |-  OperatorModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_OperatorModifier = (Core.Name "hydra/ext/csharp/syntax.OperatorModifier")--_OperatorModifier_public = (Core.Name "public")--_OperatorModifier_static = (Core.Name "static")--_OperatorModifier_extern = (Core.Name "extern")--_OperatorModifier_unsafe = (Core.Name "unsafe")--data OperatorDeclarator = -  OperatorDeclaratorUnary UnaryOperatorDeclarator |-  OperatorDeclaratorBinary BinaryOperatorDeclarator |-  OperatorDeclaratorConversion ConversionOperatorDeclarator-  deriving (Eq, Ord, Read, Show)--_OperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.OperatorDeclarator")--_OperatorDeclarator_unary = (Core.Name "unary")--_OperatorDeclarator_binary = (Core.Name "binary")--_OperatorDeclarator_conversion = (Core.Name "conversion")--data UnaryOperatorDeclarator = -  UnaryOperatorDeclarator {-    unaryOperatorDeclaratorType :: Type,-    unaryOperatorDeclaratorOperator :: OverloadableUnaryOperator,-    unaryOperatorDeclaratorParameter :: FixedParameter}-  deriving (Eq, Ord, Read, Show)--_UnaryOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.UnaryOperatorDeclarator")--_UnaryOperatorDeclarator_type = (Core.Name "type")--_UnaryOperatorDeclarator_operator = (Core.Name "operator")--_UnaryOperatorDeclarator_parameter = (Core.Name "parameter")--data OverloadableUnaryOperator = -  OverloadableUnaryOperatorPlus  |-  OverloadableUnaryOperatorMinus  |-  OverloadableUnaryOperatorNot  |-  OverloadableUnaryOperatorComplement  |-  OverloadableUnaryOperatorIncrement  |-  OverloadableUnaryOperatorDecrement  |-  OverloadableUnaryOperatorTrue  |-  OverloadableUnaryOperatorFalse -  deriving (Eq, Ord, Read, Show)--_OverloadableUnaryOperator = (Core.Name "hydra/ext/csharp/syntax.OverloadableUnaryOperator")--_OverloadableUnaryOperator_plus = (Core.Name "plus")--_OverloadableUnaryOperator_minus = (Core.Name "minus")--_OverloadableUnaryOperator_not = (Core.Name "not")--_OverloadableUnaryOperator_complement = (Core.Name "complement")--_OverloadableUnaryOperator_increment = (Core.Name "increment")--_OverloadableUnaryOperator_decrement = (Core.Name "decrement")--_OverloadableUnaryOperator_true = (Core.Name "true")--_OverloadableUnaryOperator_false = (Core.Name "false")--data BinaryOperatorDeclarator = -  BinaryOperatorDeclarator {-    binaryOperatorDeclaratorType :: Type,-    binaryOperatorDeclaratorOperator :: OverloadableBinaryOperator,-    binaryOperatorDeclaratorLeft :: FixedParameter,-    binaryOperatorDeclaratorRight :: FixedParameter}-  deriving (Eq, Ord, Read, Show)--_BinaryOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.BinaryOperatorDeclarator")--_BinaryOperatorDeclarator_type = (Core.Name "type")--_BinaryOperatorDeclarator_operator = (Core.Name "operator")--_BinaryOperatorDeclarator_left = (Core.Name "left")--_BinaryOperatorDeclarator_right = (Core.Name "right")--data OverloadableBinaryOperator = -  OverloadableBinaryOperatorAdd  |-  OverloadableBinaryOperatorSubtract  |-  OverloadableBinaryOperatorMultiply  |-  OverloadableBinaryOperatorDivide  |-  OverloadableBinaryOperatorModulus  |-  OverloadableBinaryOperatorAnd  |-  OverloadableBinaryOperatorOr  |-  OverloadableBinaryOperatorXor  |-  OverloadableBinaryOperatorLeftShift  |-  OverloadableBinaryOperatorRightShift  |-  OverloadableBinaryOperatorEqual  |-  OverloadableBinaryOperatorNotEqual  |-  OverloadableBinaryOperatorGreaterThan  |-  OverloadableBinaryOperatorLessThan  |-  OverloadableBinaryOperatorGreaterThanOrEqual  |-  OverloadableBinaryOperatorLessThanOrEqual -  deriving (Eq, Ord, Read, Show)--_OverloadableBinaryOperator = (Core.Name "hydra/ext/csharp/syntax.OverloadableBinaryOperator")--_OverloadableBinaryOperator_add = (Core.Name "add")--_OverloadableBinaryOperator_subtract = (Core.Name "subtract")--_OverloadableBinaryOperator_multiply = (Core.Name "multiply")--_OverloadableBinaryOperator_divide = (Core.Name "divide")--_OverloadableBinaryOperator_modulus = (Core.Name "modulus")--_OverloadableBinaryOperator_and = (Core.Name "and")--_OverloadableBinaryOperator_or = (Core.Name "or")--_OverloadableBinaryOperator_xor = (Core.Name "xor")--_OverloadableBinaryOperator_leftShift = (Core.Name "leftShift")--_OverloadableBinaryOperator_rightShift = (Core.Name "rightShift")--_OverloadableBinaryOperator_equal = (Core.Name "equal")--_OverloadableBinaryOperator_notEqual = (Core.Name "notEqual")--_OverloadableBinaryOperator_greaterThan = (Core.Name "greaterThan")--_OverloadableBinaryOperator_lessThan = (Core.Name "lessThan")--_OverloadableBinaryOperator_greaterThanOrEqual = (Core.Name "greaterThanOrEqual")--_OverloadableBinaryOperator_lessThanOrEqual = (Core.Name "lessThanOrEqual")--data ConversionOperatorDeclarator = -  ConversionOperatorDeclarator {-    conversionOperatorDeclaratorKind :: ConversionKind,-    conversionOperatorDeclaratorType :: Type,-    conversionOperatorDeclaratorParameter :: FixedParameter}-  deriving (Eq, Ord, Read, Show)--_ConversionOperatorDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConversionOperatorDeclarator")--_ConversionOperatorDeclarator_kind = (Core.Name "kind")--_ConversionOperatorDeclarator_type = (Core.Name "type")--_ConversionOperatorDeclarator_parameter = (Core.Name "parameter")--data ConversionKind = -  ConversionKindImplicit  |-  ConversionKindExplicit -  deriving (Eq, Ord, Read, Show)--_ConversionKind = (Core.Name "hydra/ext/csharp/syntax.ConversionKind")--_ConversionKind_implicit = (Core.Name "implicit")--_ConversionKind_explicit = (Core.Name "explicit")--data OperatorBody = -  OperatorBodyBlock Block |-  OperatorBodyExpression Expression |-  OperatorBodyEmpty -  deriving (Eq, Ord, Read, Show)--_OperatorBody = (Core.Name "hydra/ext/csharp/syntax.OperatorBody")--_OperatorBody_block = (Core.Name "block")--_OperatorBody_expression = (Core.Name "expression")--_OperatorBody_empty = (Core.Name "empty")--data ConstructorDeclaration = -  ConstructorDeclaration {-    constructorDeclarationAttributes :: (Maybe Attributes),-    constructorDeclarationModifiers :: [ConstructorModifier],-    constructorDeclarationDeclarator :: ConstructorDeclarator,-    constructorDeclarationBody :: ConstructorBody}-  deriving (Eq, Ord, Read, Show)--_ConstructorDeclaration = (Core.Name "hydra/ext/csharp/syntax.ConstructorDeclaration")--_ConstructorDeclaration_attributes = (Core.Name "attributes")--_ConstructorDeclaration_modifiers = (Core.Name "modifiers")--_ConstructorDeclaration_declarator = (Core.Name "declarator")--_ConstructorDeclaration_body = (Core.Name "body")--data ConstructorModifier = -  ConstructorModifierPublic  |-  ConstructorModifierProtected  |-  ConstructorModifierInternal  |-  ConstructorModifierPrivate  |-  ConstructorModifierExtern  |-  ConstructorModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_ConstructorModifier = (Core.Name "hydra/ext/csharp/syntax.ConstructorModifier")--_ConstructorModifier_public = (Core.Name "public")--_ConstructorModifier_protected = (Core.Name "protected")--_ConstructorModifier_internal = (Core.Name "internal")--_ConstructorModifier_private = (Core.Name "private")--_ConstructorModifier_extern = (Core.Name "extern")--_ConstructorModifier_unsafe = (Core.Name "unsafe")--data ConstructorDeclarator = -  ConstructorDeclarator {-    constructorDeclaratorName :: Identifier,-    constructorDeclaratorParameters :: (Maybe FormalParameterList),-    constructorDeclaratorInitializer :: (Maybe ConstructorInitializer)}-  deriving (Eq, Ord, Read, Show)--_ConstructorDeclarator = (Core.Name "hydra/ext/csharp/syntax.ConstructorDeclarator")--_ConstructorDeclarator_name = (Core.Name "name")--_ConstructorDeclarator_parameters = (Core.Name "parameters")--_ConstructorDeclarator_initializer = (Core.Name "initializer")--data ConstructorInitializer = -  ConstructorInitializerBase (Maybe ArgumentList) |-  ConstructorInitializerThis (Maybe ArgumentList)-  deriving (Eq, Ord, Read, Show)--_ConstructorInitializer = (Core.Name "hydra/ext/csharp/syntax.ConstructorInitializer")--_ConstructorInitializer_base = (Core.Name "base")--_ConstructorInitializer_this = (Core.Name "this")--data ConstructorBody = -  ConstructorBodyBlock Block |-  ConstructorBodyExpression Expression |-  ConstructorBodyEmpty -  deriving (Eq, Ord, Read, Show)--_ConstructorBody = (Core.Name "hydra/ext/csharp/syntax.ConstructorBody")--_ConstructorBody_block = (Core.Name "block")--_ConstructorBody_expression = (Core.Name "expression")--_ConstructorBody_empty = (Core.Name "empty")--data StaticConstructorDeclaration = -  StaticConstructorDeclaration {-    staticConstructorDeclarationAttributes :: (Maybe Attributes),-    staticConstructorDeclarationModifiers :: StaticConstructorModifiers,-    staticConstructorDeclarationName :: Identifier,-    staticConstructorDeclarationBody :: StaticConstructorBody}-  deriving (Eq, Ord, Read, Show)--_StaticConstructorDeclaration = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorDeclaration")--_StaticConstructorDeclaration_attributes = (Core.Name "attributes")--_StaticConstructorDeclaration_modifiers = (Core.Name "modifiers")--_StaticConstructorDeclaration_name = (Core.Name "name")--_StaticConstructorDeclaration_body = (Core.Name "body")--data StaticConstructorModifiers = -  StaticConstructorModifiers {-    staticConstructorModifiersExtern :: Bool,-    staticConstructorModifiersUnsafe :: Bool}-  deriving (Eq, Ord, Read, Show)--_StaticConstructorModifiers = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorModifiers")--_StaticConstructorModifiers_extern = (Core.Name "extern")--_StaticConstructorModifiers_unsafe = (Core.Name "unsafe")--data StaticConstructorBody = -  StaticConstructorBodyBlock Block |-  StaticConstructorBodyExpression Expression |-  StaticConstructorBodyEmpty -  deriving (Eq, Ord, Read, Show)--_StaticConstructorBody = (Core.Name "hydra/ext/csharp/syntax.StaticConstructorBody")--_StaticConstructorBody_block = (Core.Name "block")--_StaticConstructorBody_expression = (Core.Name "expression")--_StaticConstructorBody_empty = (Core.Name "empty")--data FinalizerDeclaration = -  FinalizerDeclaration {-    finalizerDeclarationAttributes :: (Maybe Attributes),-    finalizerDeclarationExtern :: Bool,-    finalizerDeclarationUnsafe :: Bool,-    finalizerDeclarationName :: Identifier,-    finalizerDeclarationBody :: FinalizerBody}-  deriving (Eq, Ord, Read, Show)--_FinalizerDeclaration = (Core.Name "hydra/ext/csharp/syntax.FinalizerDeclaration")--_FinalizerDeclaration_attributes = (Core.Name "attributes")--_FinalizerDeclaration_extern = (Core.Name "extern")--_FinalizerDeclaration_unsafe = (Core.Name "unsafe")--_FinalizerDeclaration_name = (Core.Name "name")--_FinalizerDeclaration_body = (Core.Name "body")--data FinalizerBody = -  FinalizerBodyBlock Block |-  FinalizerBodyExpression Expression |-  FinalizerBodyEmpty -  deriving (Eq, Ord, Read, Show)--_FinalizerBody = (Core.Name "hydra/ext/csharp/syntax.FinalizerBody")--_FinalizerBody_block = (Core.Name "block")--_FinalizerBody_expression = (Core.Name "expression")--_FinalizerBody_empty = (Core.Name "empty")--data StructDeclaration = -  StructDeclaration {-    structDeclarationAttributes :: (Maybe Attributes),-    structDeclarationModifiers :: [StructModifier],-    structDeclarationRef :: Bool,-    structDeclarationPartial :: Bool,-    structDeclarationName :: Identifier,-    structDeclarationParameters :: (Maybe TypeParameterList),-    structDeclarationInterfaces :: [InterfaceType],-    structDeclarationConstraints :: [TypeParameterConstraintsClause],-    structDeclarationBody :: [StructMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_StructDeclaration = (Core.Name "hydra/ext/csharp/syntax.StructDeclaration")--_StructDeclaration_attributes = (Core.Name "attributes")--_StructDeclaration_modifiers = (Core.Name "modifiers")--_StructDeclaration_ref = (Core.Name "ref")--_StructDeclaration_partial = (Core.Name "partial")--_StructDeclaration_name = (Core.Name "name")--_StructDeclaration_parameters = (Core.Name "parameters")--_StructDeclaration_interfaces = (Core.Name "interfaces")--_StructDeclaration_constraints = (Core.Name "constraints")--_StructDeclaration_body = (Core.Name "body")--data StructModifier = -  StructModifierNew  |-  StructModifierPublic  |-  StructModifierProtected  |-  StructModifierInternal  |-  StructModifierPrivate  |-  StructModifierReadonly  |-  StructModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_StructModifier = (Core.Name "hydra/ext/csharp/syntax.StructModifier")--_StructModifier_new = (Core.Name "new")--_StructModifier_public = (Core.Name "public")--_StructModifier_protected = (Core.Name "protected")--_StructModifier_internal = (Core.Name "internal")--_StructModifier_private = (Core.Name "private")--_StructModifier_readonly = (Core.Name "readonly")--_StructModifier_unsafe = (Core.Name "unsafe")--data StructMemberDeclaration = -  StructMemberDeclarationConstant ConstantDeclaration |-  StructMemberDeclarationField FieldDeclaration |-  StructMemberDeclarationMethod MethodDeclaration |-  StructMemberDeclarationProperty PropertyDeclaration |-  StructMemberDeclarationEvent EventDeclaration |-  StructMemberDeclarationIndexer IndexerDeclaration |-  StructMemberDeclarationOperator OperatorDeclaration |-  StructMemberDeclarationConstructor ConstructorDeclaration |-  StructMemberDeclarationStaticConstructor StaticConstructorDeclaration |-  StructMemberDeclarationType TypeDeclaration |-  StructMemberDeclarationFixedSizeBuffer FixedSizeBufferDeclaration-  deriving (Eq, Ord, Read, Show)--_StructMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.StructMemberDeclaration")--_StructMemberDeclaration_constant = (Core.Name "constant")--_StructMemberDeclaration_field = (Core.Name "field")--_StructMemberDeclaration_method = (Core.Name "method")--_StructMemberDeclaration_property = (Core.Name "property")--_StructMemberDeclaration_event = (Core.Name "event")--_StructMemberDeclaration_indexer = (Core.Name "indexer")--_StructMemberDeclaration_operator = (Core.Name "operator")--_StructMemberDeclaration_constructor = (Core.Name "constructor")--_StructMemberDeclaration_staticConstructor = (Core.Name "staticConstructor")--_StructMemberDeclaration_type = (Core.Name "type")--_StructMemberDeclaration_fixedSizeBuffer = (Core.Name "fixedSizeBuffer")--newtype ArrayInitializer = -  ArrayInitializer {-    unArrayInitializer :: [VariableInitializer]}-  deriving (Eq, Ord, Read, Show)--_ArrayInitializer = (Core.Name "hydra/ext/csharp/syntax.ArrayInitializer")--data VariableInitializer = -  VariableInitializerExpression Expression |-  VariableInitializerArray ArrayInitializer-  deriving (Eq, Ord, Read, Show)--_VariableInitializer = (Core.Name "hydra/ext/csharp/syntax.VariableInitializer")--_VariableInitializer_expression = (Core.Name "expression")--_VariableInitializer_array = (Core.Name "array")--data InterfaceDeclaration = -  InterfaceDeclaration {-    interfaceDeclarationAttributes :: (Maybe Attributes),-    interfaceDeclarationModifiers :: [InterfaceModifier],-    interfaceDeclarationPartial :: Bool,-    interfaceDeclarationName :: Identifier,-    interfaceDeclarationParameters :: (Maybe VariantTypeParameters),-    interfaceDeclarationBase :: [InterfaceType],-    interfaceDeclarationConstraints :: [TypeParameterConstraintsClause],-    interfaceDeclarationBody :: [InterfaceMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_InterfaceDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceDeclaration")--_InterfaceDeclaration_attributes = (Core.Name "attributes")--_InterfaceDeclaration_modifiers = (Core.Name "modifiers")--_InterfaceDeclaration_partial = (Core.Name "partial")--_InterfaceDeclaration_name = (Core.Name "name")--_InterfaceDeclaration_parameters = (Core.Name "parameters")--_InterfaceDeclaration_base = (Core.Name "base")--_InterfaceDeclaration_constraints = (Core.Name "constraints")--_InterfaceDeclaration_body = (Core.Name "body")--data InterfaceModifier = -  InterfaceModifierNew  |-  InterfaceModifierPublic  |-  InterfaceModifierProtected  |-  InterfaceModifierInternal  |-  InterfaceModifierPrivate  |-  InterfaceModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_InterfaceModifier = (Core.Name "hydra/ext/csharp/syntax.InterfaceModifier")--_InterfaceModifier_new = (Core.Name "new")--_InterfaceModifier_public = (Core.Name "public")--_InterfaceModifier_protected = (Core.Name "protected")--_InterfaceModifier_internal = (Core.Name "internal")--_InterfaceModifier_private = (Core.Name "private")--_InterfaceModifier_unsafe = (Core.Name "unsafe")--newtype VariantTypeParameters = -  VariantTypeParameters {-    unVariantTypeParameters :: [VariantTypeParameter]}-  deriving (Eq, Ord, Read, Show)--_VariantTypeParameters = (Core.Name "hydra/ext/csharp/syntax.VariantTypeParameters")--data VariantTypeParameter = -  VariantTypeParameter {-    variantTypeParameterAttributes :: (Maybe Attributes),-    variantTypeParameterVariance :: (Maybe VarianceAnnotation),-    variantTypeParameterParameter :: TypeParameter}-  deriving (Eq, Ord, Read, Show)--_VariantTypeParameter = (Core.Name "hydra/ext/csharp/syntax.VariantTypeParameter")--_VariantTypeParameter_attributes = (Core.Name "attributes")--_VariantTypeParameter_variance = (Core.Name "variance")--_VariantTypeParameter_parameter = (Core.Name "parameter")--data VarianceAnnotation = -  VarianceAnnotationIn  |-  VarianceAnnotationOut -  deriving (Eq, Ord, Read, Show)--_VarianceAnnotation = (Core.Name "hydra/ext/csharp/syntax.VarianceAnnotation")--_VarianceAnnotation_in = (Core.Name "in")--_VarianceAnnotation_out = (Core.Name "out")--data InterfaceMemberDeclaration = -  InterfaceMemberDeclarationMethod InterfaceMethodDeclaration |-  InterfaceMemberDeclarationProperty InterfacePropertyDeclaration |-  InterfaceMemberDeclarationEvent InterfaceEventDeclaration |-  InterfaceMemberDeclarationIndexer InterfaceIndexerDeclaration-  deriving (Eq, Ord, Read, Show)--_InterfaceMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceMemberDeclaration")--_InterfaceMemberDeclaration_method = (Core.Name "method")--_InterfaceMemberDeclaration_property = (Core.Name "property")--_InterfaceMemberDeclaration_event = (Core.Name "event")--_InterfaceMemberDeclaration_indexer = (Core.Name "indexer")--data InterfaceMethodDeclaration = -  InterfaceMethodDeclaration {-    interfaceMethodDeclarationAttributes :: (Maybe Attributes),-    interfaceMethodDeclarationNew :: Bool,-    interfaceMethodDeclarationReturnType :: ReturnType,-    interfaceMethodDeclarationRefKind :: (Maybe RefKind),-    interfaceMethodDeclarationHeader :: InterfaceMethodHeader}-  deriving (Eq, Ord, Read, Show)--_InterfaceMethodDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceMethodDeclaration")--_InterfaceMethodDeclaration_attributes = (Core.Name "attributes")--_InterfaceMethodDeclaration_new = (Core.Name "new")--_InterfaceMethodDeclaration_returnType = (Core.Name "returnType")--_InterfaceMethodDeclaration_refKind = (Core.Name "refKind")--_InterfaceMethodDeclaration_header = (Core.Name "header")--data InterfaceMethodHeader = -  InterfaceMethodHeader {-    interfaceMethodHeaderName :: Identifier,-    interfaceMethodHeaderParameters :: (Maybe FormalParameterList),-    interfaceMethodHeaderTypeParameters :: (Maybe TypeParameterList),-    interfaceMethodHeaderConstraints :: [TypeParameterConstraintsClause]}-  deriving (Eq, Ord, Read, Show)--_InterfaceMethodHeader = (Core.Name "hydra/ext/csharp/syntax.InterfaceMethodHeader")--_InterfaceMethodHeader_name = (Core.Name "name")--_InterfaceMethodHeader_parameters = (Core.Name "parameters")--_InterfaceMethodHeader_typeParameters = (Core.Name "typeParameters")--_InterfaceMethodHeader_constraints = (Core.Name "constraints")--data InterfacePropertyDeclaration = -  InterfacePropertyDeclaration {-    interfacePropertyDeclarationAttributes :: (Maybe Attributes),-    interfacePropertyDeclarationNew :: Bool,-    interfacePropertyDeclarationRefKind :: (Maybe RefKind),-    interfacePropertyDeclarationType :: Type,-    interfacePropertyDeclarationName :: Identifier,-    interfacePropertyDeclarationAccessors :: InterfaceAccessors}-  deriving (Eq, Ord, Read, Show)--_InterfacePropertyDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfacePropertyDeclaration")--_InterfacePropertyDeclaration_attributes = (Core.Name "attributes")--_InterfacePropertyDeclaration_new = (Core.Name "new")--_InterfacePropertyDeclaration_refKind = (Core.Name "refKind")--_InterfacePropertyDeclaration_type = (Core.Name "type")--_InterfacePropertyDeclaration_name = (Core.Name "name")--_InterfacePropertyDeclaration_accessors = (Core.Name "accessors")--data InterfaceAccessors = -  InterfaceAccessors {-    interfaceAccessorsAttributes :: (Maybe Attributes),-    interfaceAccessorsGet :: (Maybe Attributes),-    interfaceAccessorsSet :: (Maybe Attributes)}-  deriving (Eq, Ord, Read, Show)--_InterfaceAccessors = (Core.Name "hydra/ext/csharp/syntax.InterfaceAccessors")--_InterfaceAccessors_attributes = (Core.Name "attributes")--_InterfaceAccessors_get = (Core.Name "get")--_InterfaceAccessors_set = (Core.Name "set")--data InterfaceEventDeclaration = -  InterfaceEventDeclaration {-    interfaceEventDeclarationAttributes :: (Maybe Attributes),-    interfaceEventDeclarationNew :: Bool,-    interfaceEventDeclarationType :: Type,-    interfaceEventDeclarationName :: Identifier}-  deriving (Eq, Ord, Read, Show)--_InterfaceEventDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceEventDeclaration")--_InterfaceEventDeclaration_attributes = (Core.Name "attributes")--_InterfaceEventDeclaration_new = (Core.Name "new")--_InterfaceEventDeclaration_type = (Core.Name "type")--_InterfaceEventDeclaration_name = (Core.Name "name")--data InterfaceIndexerDeclaration = -  InterfaceIndexerDeclaration {-    interfaceIndexerDeclarationAttributes :: (Maybe Attributes),-    interfaceIndexerDeclarationNew :: Bool,-    interfaceIndexerDeclarationRefKind :: (Maybe RefKind),-    interfaceIndexerDeclarationType :: Type,-    interfaceIndexerDeclarationParameters :: FormalParameterList,-    interfaceIndexerDeclarationAccessors :: InterfaceAccessors}-  deriving (Eq, Ord, Read, Show)--_InterfaceIndexerDeclaration = (Core.Name "hydra/ext/csharp/syntax.InterfaceIndexerDeclaration")--_InterfaceIndexerDeclaration_attributes = (Core.Name "attributes")--_InterfaceIndexerDeclaration_new = (Core.Name "new")--_InterfaceIndexerDeclaration_refKind = (Core.Name "refKind")--_InterfaceIndexerDeclaration_type = (Core.Name "type")--_InterfaceIndexerDeclaration_parameters = (Core.Name "parameters")--_InterfaceIndexerDeclaration_accessors = (Core.Name "accessors")--data EnumDeclaration = -  EnumDeclaration {-    enumDeclarationAttributes :: (Maybe Attributes),-    enumDeclarationModifiers :: [EnumModifier],-    enumDeclarationName :: Identifier,-    enumDeclarationBase :: (Maybe EnumBase),-    enumDeclarationBody :: (Maybe EnumBody)}-  deriving (Eq, Ord, Read, Show)--_EnumDeclaration = (Core.Name "hydra/ext/csharp/syntax.EnumDeclaration")--_EnumDeclaration_attributes = (Core.Name "attributes")--_EnumDeclaration_modifiers = (Core.Name "modifiers")--_EnumDeclaration_name = (Core.Name "name")--_EnumDeclaration_base = (Core.Name "base")--_EnumDeclaration_body = (Core.Name "body")--data EnumBase = -  EnumBaseType IntegralType |-  EnumBaseName TypeName-  deriving (Eq, Ord, Read, Show)--_EnumBase = (Core.Name "hydra/ext/csharp/syntax.EnumBase")--_EnumBase_type = (Core.Name "type")--_EnumBase_name = (Core.Name "name")--newtype EnumBody = -  EnumBody {-    unEnumBody :: [EnumMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_EnumBody = (Core.Name "hydra/ext/csharp/syntax.EnumBody")--data EnumModifier = -  EnumModifierNew  |-  EnumModifierPublic  |-  EnumModifierProtected  |-  EnumModifierInternal  |-  EnumModifierPrivate -  deriving (Eq, Ord, Read, Show)--_EnumModifier = (Core.Name "hydra/ext/csharp/syntax.EnumModifier")--_EnumModifier_new = (Core.Name "new")--_EnumModifier_public = (Core.Name "public")--_EnumModifier_protected = (Core.Name "protected")--_EnumModifier_internal = (Core.Name "internal")--_EnumModifier_private = (Core.Name "private")--data EnumMemberDeclaration = -  EnumMemberDeclaration {-    enumMemberDeclarationAttributes :: (Maybe Attributes),-    enumMemberDeclarationName :: Identifier,-    enumMemberDeclarationValue :: (Maybe ConstantExpression)}-  deriving (Eq, Ord, Read, Show)--_EnumMemberDeclaration = (Core.Name "hydra/ext/csharp/syntax.EnumMemberDeclaration")--_EnumMemberDeclaration_attributes = (Core.Name "attributes")--_EnumMemberDeclaration_name = (Core.Name "name")--_EnumMemberDeclaration_value = (Core.Name "value")--data DelegateDeclaration = -  DelegateDeclaration {-    delegateDeclarationAttributes :: (Maybe Attributes),-    delegateDeclarationModifiers :: [DelegateModifier],-    delegateDeclarationReturnType :: ReturnType,-    delegateDeclarationRefKind :: (Maybe RefKind),-    delegateDeclarationRefReturnType :: (Maybe Type),-    delegateDeclarationHeader :: DelegateHeader}-  deriving (Eq, Ord, Read, Show)--_DelegateDeclaration = (Core.Name "hydra/ext/csharp/syntax.DelegateDeclaration")--_DelegateDeclaration_attributes = (Core.Name "attributes")--_DelegateDeclaration_modifiers = (Core.Name "modifiers")--_DelegateDeclaration_returnType = (Core.Name "returnType")--_DelegateDeclaration_refKind = (Core.Name "refKind")--_DelegateDeclaration_refReturnType = (Core.Name "refReturnType")--_DelegateDeclaration_header = (Core.Name "header")--data DelegateHeader = -  DelegateHeader {-    delegateHeaderName :: Identifier,-    delegateHeaderTypeParameters :: (Maybe VariantTypeParameters),-    delegateHeaderParameters :: (Maybe FormalParameterList),-    delegateHeaderConstraints :: [TypeParameterConstraintsClause]}-  deriving (Eq, Ord, Read, Show)--_DelegateHeader = (Core.Name "hydra/ext/csharp/syntax.DelegateHeader")--_DelegateHeader_name = (Core.Name "name")--_DelegateHeader_typeParameters = (Core.Name "typeParameters")--_DelegateHeader_parameters = (Core.Name "parameters")--_DelegateHeader_constraints = (Core.Name "constraints")--data DelegateModifier = -  DelegateModifierNew  |-  DelegateModifierPublic  |-  DelegateModifierProtected  |-  DelegateModifierInternal  |-  DelegateModifierPrivate  |-  DelegateModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_DelegateModifier = (Core.Name "hydra/ext/csharp/syntax.DelegateModifier")--_DelegateModifier_new = (Core.Name "new")--_DelegateModifier_public = (Core.Name "public")--_DelegateModifier_protected = (Core.Name "protected")--_DelegateModifier_internal = (Core.Name "internal")--_DelegateModifier_private = (Core.Name "private")--_DelegateModifier_unsafe = (Core.Name "unsafe")--data GlobalAttributeSection = -  GlobalAttributeSection {-    globalAttributeSectionTarget :: Identifier,-    globalAttributeSectionAttributes :: AttributeList}-  deriving (Eq, Ord, Read, Show)--_GlobalAttributeSection = (Core.Name "hydra/ext/csharp/syntax.GlobalAttributeSection")--_GlobalAttributeSection_target = (Core.Name "target")--_GlobalAttributeSection_attributes = (Core.Name "attributes")--newtype Attributes = -  Attributes {-    unAttributes :: [AttributeSection]}-  deriving (Eq, Ord, Read, Show)--_Attributes = (Core.Name "hydra/ext/csharp/syntax.Attributes")--data AttributeSection = -  AttributeSection {-    attributeSectionTarget :: (Maybe AttributeTarget),-    attributeSectionAttributes :: AttributeList}-  deriving (Eq, Ord, Read, Show)--_AttributeSection = (Core.Name "hydra/ext/csharp/syntax.AttributeSection")--_AttributeSection_target = (Core.Name "target")--_AttributeSection_attributes = (Core.Name "attributes")--data AttributeTarget = -  AttributeTargetIdentifier Identifier |-  AttributeTargetKeyword Keyword-  deriving (Eq, Ord, Read, Show)--_AttributeTarget = (Core.Name "hydra/ext/csharp/syntax.AttributeTarget")--_AttributeTarget_identifier = (Core.Name "identifier")--_AttributeTarget_keyword = (Core.Name "keyword")--newtype AttributeList = -  AttributeList {-    unAttributeList :: [Attribute]}-  deriving (Eq, Ord, Read, Show)--_AttributeList = (Core.Name "hydra/ext/csharp/syntax.AttributeList")--data Attribute = -  Attribute {-    attributeName :: AttributeName,-    attributeArguments :: (Maybe AttributeArguments)}-  deriving (Eq, Ord, Read, Show)--_Attribute = (Core.Name "hydra/ext/csharp/syntax.Attribute")--_Attribute_name = (Core.Name "name")--_Attribute_arguments = (Core.Name "arguments")--newtype AttributeName = -  AttributeName {-    unAttributeName :: TypeName}-  deriving (Eq, Ord, Read, Show)--_AttributeName = (Core.Name "hydra/ext/csharp/syntax.AttributeName")--data AttributeArguments = -  AttributeArguments {-    attributeArgumentsPositonal :: (Maybe PositionalArgumentList),-    attributeArgumentsNamed :: (Maybe NamedArgumentList)}-  deriving (Eq, Ord, Read, Show)--_AttributeArguments = (Core.Name "hydra/ext/csharp/syntax.AttributeArguments")--_AttributeArguments_positonal = (Core.Name "positonal")--_AttributeArguments_named = (Core.Name "named")--newtype PositionalArgumentList = -  PositionalArgumentList {-    unPositionalArgumentList :: [PositionalArgument]}-  deriving (Eq, Ord, Read, Show)--_PositionalArgumentList = (Core.Name "hydra/ext/csharp/syntax.PositionalArgumentList")--data PositionalArgument = -  PositionalArgument {-    positionalArgumentName :: (Maybe Identifier),-    positionalArgumentValue :: AttributeArgumentExpression}-  deriving (Eq, Ord, Read, Show)--_PositionalArgument = (Core.Name "hydra/ext/csharp/syntax.PositionalArgument")--_PositionalArgument_name = (Core.Name "name")--_PositionalArgument_value = (Core.Name "value")--newtype NamedArgumentList = -  NamedArgumentList {-    unNamedArgumentList :: [NamedArgument]}-  deriving (Eq, Ord, Read, Show)--_NamedArgumentList = (Core.Name "hydra/ext/csharp/syntax.NamedArgumentList")--data NamedArgument = -  NamedArgument {-    namedArgumentName :: Identifier,-    namedArgumentValue :: AttributeArgumentExpression}-  deriving (Eq, Ord, Read, Show)--_NamedArgument = (Core.Name "hydra/ext/csharp/syntax.NamedArgument")--_NamedArgument_name = (Core.Name "name")--_NamedArgument_value = (Core.Name "value")--newtype AttributeArgumentExpression = -  AttributeArgumentExpression {-    unAttributeArgumentExpression :: NonAssignmentExpression}-  deriving (Eq, Ord, Read, Show)--_AttributeArgumentExpression = (Core.Name "hydra/ext/csharp/syntax.AttributeArgumentExpression")--data PointerType = -  PointerTypeValueType (Maybe ValueType) |-  PointerTypePointerDepth Int-  deriving (Eq, Ord, Read, Show)--_PointerType = (Core.Name "hydra/ext/csharp/syntax.PointerType")--_PointerType_valueType = (Core.Name "valueType")--_PointerType_pointerDepth = (Core.Name "pointerDepth")--data PointerMemberAccess = -  PointerMemberAccess {-    pointerMemberAccessPointer :: PrimaryExpression,-    pointerMemberAccessMember :: Identifier,-    pointerMemberAccessTypeArguments :: (Maybe TypeArgumentList)}-  deriving (Eq, Ord, Read, Show)--_PointerMemberAccess = (Core.Name "hydra/ext/csharp/syntax.PointerMemberAccess")--_PointerMemberAccess_pointer = (Core.Name "pointer")--_PointerMemberAccess_member = (Core.Name "member")--_PointerMemberAccess_typeArguments = (Core.Name "typeArguments")--data PointerElementAccess = -  PointerElementAccess {-    pointerElementAccessPointer :: PrimaryNoArrayCreationExpression,-    pointerElementAccessIndex :: Expression}-  deriving (Eq, Ord, Read, Show)--_PointerElementAccess = (Core.Name "hydra/ext/csharp/syntax.PointerElementAccess")--_PointerElementAccess_pointer = (Core.Name "pointer")--_PointerElementAccess_index = (Core.Name "index")--data FixedStatement = -  FixedStatement {-    fixedStatementPointerType :: PointerType,-    fixedStatementDeclarators :: [FixedPointerDeclarator],-    fixedStatementStatement :: EmbeddedStatement}-  deriving (Eq, Ord, Read, Show)--_FixedStatement = (Core.Name "hydra/ext/csharp/syntax.FixedStatement")--_FixedStatement_pointerType = (Core.Name "pointerType")--_FixedStatement_declarators = (Core.Name "declarators")--_FixedStatement_statement = (Core.Name "statement")--data FixedPointerDeclarator = -  FixedPointerDeclaratorReference VariableReference |-  FixedPointerDeclaratorExpression Expression-  deriving (Eq, Ord, Read, Show)--_FixedPointerDeclarator = (Core.Name "hydra/ext/csharp/syntax.FixedPointerDeclarator")--_FixedPointerDeclarator_reference = (Core.Name "reference")--_FixedPointerDeclarator_expression = (Core.Name "expression")--data FixedSizeBufferDeclaration = -  FixedSizeBufferDeclaration {-    fixedSizeBufferDeclarationAttributes :: (Maybe Attributes),-    fixedSizeBufferDeclarationModifiers :: [FixedSizeBufferModifier],-    fixedSizeBufferDeclarationElementType :: Type,-    fixedSizeBufferDeclarationDeclarators :: [FixedSizeBufferDeclarator]}-  deriving (Eq, Ord, Read, Show)--_FixedSizeBufferDeclaration = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferDeclaration")--_FixedSizeBufferDeclaration_attributes = (Core.Name "attributes")--_FixedSizeBufferDeclaration_modifiers = (Core.Name "modifiers")--_FixedSizeBufferDeclaration_elementType = (Core.Name "elementType")--_FixedSizeBufferDeclaration_declarators = (Core.Name "declarators")--data FixedSizeBufferModifier = -  FixedSizeBufferModifierNew  |-  FixedSizeBufferModifierPublic  |-  FixedSizeBufferModifierInternal  |-  FixedSizeBufferModifierPrivate  |-  FixedSizeBufferModifierUnsafe -  deriving (Eq, Ord, Read, Show)--_FixedSizeBufferModifier = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferModifier")--_FixedSizeBufferModifier_new = (Core.Name "new")--_FixedSizeBufferModifier_public = (Core.Name "public")--_FixedSizeBufferModifier_internal = (Core.Name "internal")--_FixedSizeBufferModifier_private = (Core.Name "private")--_FixedSizeBufferModifier_unsafe = (Core.Name "unsafe")--data FixedSizeBufferDeclarator = -  FixedSizeBufferDeclarator {-    fixedSizeBufferDeclaratorName :: Identifier,-    fixedSizeBufferDeclaratorSize :: ConstantExpression}-  deriving (Eq, Ord, Read, Show)--_FixedSizeBufferDeclarator = (Core.Name "hydra/ext/csharp/syntax.FixedSizeBufferDeclarator")--_FixedSizeBufferDeclarator_name = (Core.Name "name")--_FixedSizeBufferDeclarator_size = (Core.Name "size")
− src/gen-main/haskell/Hydra/Ext/Cypher/Features.hs 
@@ -1,1360 +0,0 @@--- | A model for characterizing OpenCypher queries and implementations in terms of included features.Based on the OpenCypher grammar and the list of standard Cypher functions at https://neo4j.com/docs/cypher-manual/current/functions. Current as of August 2024.--module Hydra.Ext.Cypher.Features where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | A set of features which characterize an OpenCypher query or implementation. Any features which are omitted from the set are assumed to be unsupported or nonrequired.-data CypherFeatures = -  CypherFeatures {-    -- | Arithmetic operations-    cypherFeaturesArithmetic :: ArithmeticFeatures,-    -- | Various kinds of atomic expressions-    cypherFeaturesAtom :: AtomFeatures,-    -- | Comparison operators and functions-    cypherFeaturesComparison :: ComparisonFeatures,-    -- | Delete operations-    cypherFeaturesDelete :: DeleteFeatures,-    -- | Standard Cypher functions-    cypherFeaturesFunction :: FunctionFeatures,-    -- | List functionality-    cypherFeaturesList :: ListFeatures,-    -- | Various types of literal values-    cypherFeaturesLiteral :: LiteralFeatures,-    -- | Logical operations-    cypherFeaturesLogical :: LogicalFeatures,-    -- | Match queries-    cypherFeaturesMatch :: MatchFeatures,-    -- | Merge operations-    cypherFeaturesMerge :: MergeFeatures,-    -- | Node patterns-    cypherFeaturesNodePattern :: NodePatternFeatures,-    -- | IS NULL / IS NOT NULL checks-    cypherFeaturesNull :: NullFeatures,-    -- | Path functions only found in OpenCypher-    cypherFeaturesPath :: PathFeatures,-    -- | Procedure calls-    cypherFeaturesProcedureCall :: ProcedureCallFeatures,-    -- | Projections-    cypherFeaturesProjection :: ProjectionFeatures,-    -- | Quantifier expressions-    cypherFeaturesQuantifier :: QuantifierFeatures,-    -- | Range literals within relationship patterns-    cypherFeaturesRangeLiteral :: RangeLiteralFeatures,-    -- | Specific syntax related to reading data from the graph.-    cypherFeaturesReading :: ReadingFeatures,-    -- | Relationship directions / arrow patterns-    cypherFeaturesRelationshipDirection :: RelationshipDirectionFeatures,-    -- | Relationship patterns-    cypherFeaturesRelationshipPattern :: RelationshipPatternFeatures,-    -- | REMOVE operations-    cypherFeaturesRemove :: RemoveFeatures,-    -- | Set definitions-    cypherFeaturesSet :: SetFeatures,-    -- | String functions/keywords only found in OpenCypher-    cypherFeaturesString :: StringFeatures,-    -- | Specific syntax related to updating data in the graph-    cypherFeaturesUpdating :: UpdatingFeatures}-  deriving (Eq, Ord, Read, Show)--_CypherFeatures = (Core.Name "hydra/ext/cypher/features.CypherFeatures")--_CypherFeatures_arithmetic = (Core.Name "arithmetic")--_CypherFeatures_atom = (Core.Name "atom")--_CypherFeatures_comparison = (Core.Name "comparison")--_CypherFeatures_delete = (Core.Name "delete")--_CypherFeatures_function = (Core.Name "function")--_CypherFeatures_list = (Core.Name "list")--_CypherFeatures_literal = (Core.Name "literal")--_CypherFeatures_logical = (Core.Name "logical")--_CypherFeatures_match = (Core.Name "match")--_CypherFeatures_merge = (Core.Name "merge")--_CypherFeatures_nodePattern = (Core.Name "nodePattern")--_CypherFeatures_null = (Core.Name "null")--_CypherFeatures_path = (Core.Name "path")--_CypherFeatures_procedureCall = (Core.Name "procedureCall")--_CypherFeatures_projection = (Core.Name "projection")--_CypherFeatures_quantifier = (Core.Name "quantifier")--_CypherFeatures_rangeLiteral = (Core.Name "rangeLiteral")--_CypherFeatures_reading = (Core.Name "reading")--_CypherFeatures_relationshipDirection = (Core.Name "relationshipDirection")--_CypherFeatures_relationshipPattern = (Core.Name "relationshipPattern")--_CypherFeatures_remove = (Core.Name "remove")--_CypherFeatures_set = (Core.Name "set")--_CypherFeatures_string = (Core.Name "string")--_CypherFeatures_updating = (Core.Name "updating")---- | Arithmetic operations-data ArithmeticFeatures = -  ArithmeticFeatures {-    -- | The + operator-    arithmeticFeaturesPlus :: Bool,-    -- | The - operator-    arithmeticFeaturesMinus :: Bool,-    -- | The * operator-    arithmeticFeaturesMultiply :: Bool,-    -- | The / operator-    arithmeticFeaturesDivide :: Bool,-    -- | The % operator-    arithmeticFeaturesModulus :: Bool,-    -- | The ^ operator-    arithmeticFeaturesPowerOf :: Bool}-  deriving (Eq, Ord, Read, Show)--_ArithmeticFeatures = (Core.Name "hydra/ext/cypher/features.ArithmeticFeatures")--_ArithmeticFeatures_plus = (Core.Name "plus")--_ArithmeticFeatures_minus = (Core.Name "minus")--_ArithmeticFeatures_multiply = (Core.Name "multiply")--_ArithmeticFeatures_divide = (Core.Name "divide")--_ArithmeticFeatures_modulus = (Core.Name "modulus")--_ArithmeticFeatures_powerOf = (Core.Name "powerOf")---- | Various kinds of atomic expressions-data AtomFeatures = -  AtomFeatures {-    -- | CASE expressions-    atomFeaturesCaseExpression :: Bool,-    -- | The COUNT (*) expression-    atomFeaturesCount :: Bool,-    -- | Existential subqueries-    atomFeaturesExistentialSubquery :: Bool,-    -- | Function invocation-    atomFeaturesFunctionInvocation :: Bool,-    -- | Parameter expressions-    atomFeaturesParameter :: Bool,-    -- | Pattern comprehensions-    atomFeaturesPatternComprehension :: Bool,-    -- | Relationship patterns as subexpressions-    atomFeaturesPatternPredicate :: Bool,-    -- | Variable expressions (note: included by most if not all implementations).-    atomFeaturesVariable :: Bool}-  deriving (Eq, Ord, Read, Show)--_AtomFeatures = (Core.Name "hydra/ext/cypher/features.AtomFeatures")--_AtomFeatures_caseExpression = (Core.Name "caseExpression")--_AtomFeatures_count = (Core.Name "count")--_AtomFeatures_existentialSubquery = (Core.Name "existentialSubquery")--_AtomFeatures_functionInvocation = (Core.Name "functionInvocation")--_AtomFeatures_parameter = (Core.Name "parameter")--_AtomFeatures_patternComprehension = (Core.Name "patternComprehension")--_AtomFeatures_patternPredicate = (Core.Name "patternPredicate")--_AtomFeatures_variable = (Core.Name "variable")---- | Comparison operators and functions-data ComparisonFeatures = -  ComparisonFeatures {-    -- | The = comparison operator-    comparisonFeaturesEqual :: Bool,-    -- | The > comparison operator-    comparisonFeaturesGreaterThan :: Bool,-    -- | The >= comparison operator-    comparisonFeaturesGreaterThanOrEqual :: Bool,-    -- | The < comparison operator-    comparisonFeaturesLessThan :: Bool,-    -- | The <= comparison operator-    comparisonFeaturesLessThanOrEqual :: Bool,-    -- | The <> comparison operator-    comparisonFeaturesNotEqual :: Bool}-  deriving (Eq, Ord, Read, Show)--_ComparisonFeatures = (Core.Name "hydra/ext/cypher/features.ComparisonFeatures")--_ComparisonFeatures_equal = (Core.Name "equal")--_ComparisonFeatures_greaterThan = (Core.Name "greaterThan")--_ComparisonFeatures_greaterThanOrEqual = (Core.Name "greaterThanOrEqual")--_ComparisonFeatures_lessThan = (Core.Name "lessThan")--_ComparisonFeatures_lessThanOrEqual = (Core.Name "lessThanOrEqual")--_ComparisonFeatures_notEqual = (Core.Name "notEqual")---- | Delete operations-data DeleteFeatures = -  DeleteFeatures {-    -- | The basic DELETE clause-    deleteFeaturesDelete :: Bool,-    -- | The DETACH DELETE clause-    deleteFeaturesDetachDelete :: Bool}-  deriving (Eq, Ord, Read, Show)--_DeleteFeatures = (Core.Name "hydra/ext/cypher/features.DeleteFeatures")--_DeleteFeatures_delete = (Core.Name "delete")--_DeleteFeatures_detachDelete = (Core.Name "detachDelete")---- | Standard Cypher functions-data FunctionFeatures = -  FunctionFeatures {-    -- | Aggregate functions-    functionFeaturesAggregateFunction :: AggregateFunctionFeatures,-    -- | Database functions-    functionFeaturesDatabaseFunction :: DatabaseFunctionFeatures,-    -- | GenAI functions-    functionFeaturesGenAIFunction :: GenAIFunctionFeatures,-    -- | Graph functions-    functionFeaturesGraphFunction :: GraphFunctionFeatures,-    -- | List functions-    functionFeaturesListFunction :: ListFunctionFeatures,-    -- | Load CSV functions-    functionFeaturesLoadCSVFunction :: LoadCSVFunctionFeatures,-    -- | Logarithmic functions-    functionFeaturesLogarithmicFunction :: LogarithmicFunctionFeatures,-    -- | Numeric functions-    functionFeaturesNumericFunction :: NumericFunctionFeatures,-    -- | Predicate functions-    functionFeaturesPredicateFunction :: PredicateFunctionFeatures,-    -- | Scalar functions-    functionFeaturesScalarFunction :: ScalarFunctionFeatures,-    -- | Spatial functions-    functionFeaturesSpatialFunction :: SpatialFunctionFeatures,-    -- | String functions-    functionFeaturesStringFunction :: StringFunctionFeatures,-    -- | Temporal duration functions-    functionFeaturesTemporalDurationFunction :: TemporalDurationFunctionFeatures,-    -- | Temporal instant functions-    functionFeaturesTemporalInstantFunction :: TemporalInstantFunctionFeatures,-    -- | Trigonometric functions-    functionFeaturesTrigonometricFunction :: TrigonometricFunctionFeatures,-    -- | Vector functions-    functionFeaturesVectorFunction :: VectorFunctionFeatures}-  deriving (Eq, Ord, Read, Show)--_FunctionFeatures = (Core.Name "hydra/ext/cypher/features.FunctionFeatures")--_FunctionFeatures_aggregateFunction = (Core.Name "aggregateFunction")--_FunctionFeatures_databaseFunction = (Core.Name "databaseFunction")--_FunctionFeatures_genAIFunction = (Core.Name "genAIFunction")--_FunctionFeatures_graphFunction = (Core.Name "graphFunction")--_FunctionFeatures_listFunction = (Core.Name "listFunction")--_FunctionFeatures_loadCSVFunction = (Core.Name "loadCSVFunction")--_FunctionFeatures_logarithmicFunction = (Core.Name "logarithmicFunction")--_FunctionFeatures_numericFunction = (Core.Name "numericFunction")--_FunctionFeatures_predicateFunction = (Core.Name "predicateFunction")--_FunctionFeatures_scalarFunction = (Core.Name "scalarFunction")--_FunctionFeatures_spatialFunction = (Core.Name "spatialFunction")--_FunctionFeatures_stringFunction = (Core.Name "stringFunction")--_FunctionFeatures_temporalDurationFunction = (Core.Name "temporalDurationFunction")--_FunctionFeatures_temporalInstantFunction = (Core.Name "temporalInstantFunction")--_FunctionFeatures_trigonometricFunction = (Core.Name "trigonometricFunction")--_FunctionFeatures_vectorFunction = (Core.Name "vectorFunction")---- | Aggregate functions-data AggregateFunctionFeatures = -  AggregateFunctionFeatures {-    -- | The avg() function / AVG. Returns the average of a set of DURATION values.; Returns the average of a set of FLOAT values.; Returns the average of a set of INTEGER values.-    aggregateFunctionFeaturesAvg :: Bool,-    -- | The collect() function / COLLECT. Returns a list containing the values returned by an expression.-    aggregateFunctionFeaturesCollect :: Bool,-    -- | The count() function / COUNT. Returns the number of values or rows.-    aggregateFunctionFeaturesCount :: Bool,-    -- | The max() function / MAX. Returns the maximum value in a set of values.-    aggregateFunctionFeaturesMax :: Bool,-    -- | The min() function / MIN. Returns the minimum value in a set of values.-    aggregateFunctionFeaturesMin :: Bool,-    -- | The percentileCont() function. Returns the percentile of a value over a group using linear interpolation.-    aggregateFunctionFeaturesPercentileCont :: Bool,-    -- | The percentileDisc() function. Returns the nearest FLOAT value to the given percentile over a group using a rounding method.; Returns the nearest INTEGER value to the given percentile over a group using a rounding method.-    aggregateFunctionFeaturesPercentileDisc :: Bool,-    -- | The stdev() function. Returns the standard deviation for the given value over a group for a sample of a population.-    aggregateFunctionFeaturesStdev :: Bool,-    -- | The stdevp() function. Returns the standard deviation for the given value over a group for an entire population.-    aggregateFunctionFeaturesStdevp :: Bool,-    -- | The sum() function / SUM. Returns the sum of a set of DURATION values.; Returns the sum of a set of FLOAT values.; Returns the sum of a set of INTEGER values.-    aggregateFunctionFeaturesSum :: Bool}-  deriving (Eq, Ord, Read, Show)--_AggregateFunctionFeatures = (Core.Name "hydra/ext/cypher/features.AggregateFunctionFeatures")--_AggregateFunctionFeatures_avg = (Core.Name "avg")--_AggregateFunctionFeatures_collect = (Core.Name "collect")--_AggregateFunctionFeatures_count = (Core.Name "count")--_AggregateFunctionFeatures_max = (Core.Name "max")--_AggregateFunctionFeatures_min = (Core.Name "min")--_AggregateFunctionFeatures_percentileCont = (Core.Name "percentileCont")--_AggregateFunctionFeatures_percentileDisc = (Core.Name "percentileDisc")--_AggregateFunctionFeatures_stdev = (Core.Name "stdev")--_AggregateFunctionFeatures_stdevp = (Core.Name "stdevp")--_AggregateFunctionFeatures_sum = (Core.Name "sum")---- | Database functions-data DatabaseFunctionFeatures = -  DatabaseFunctionFeatures {-    -- | The db.nameFromElementId() function. Resolves the database name from the given element id. Introduced in 5.12.-    databaseFunctionFeaturesDb_nameFromElementId :: Bool}-  deriving (Eq, Ord, Read, Show)--_DatabaseFunctionFeatures = (Core.Name "hydra/ext/cypher/features.DatabaseFunctionFeatures")--_DatabaseFunctionFeatures_db_nameFromElementId = (Core.Name "db.nameFromElementId")---- | GenAI functions-data GenAIFunctionFeatures = -  GenAIFunctionFeatures {-    -- | The genai.vector.encode() function. Encode a given resource as a vector using the named provider. Introduced in 5.17.-    genAIFunctionFeaturesGenai_vector_encode :: Bool}-  deriving (Eq, Ord, Read, Show)--_GenAIFunctionFeatures = (Core.Name "hydra/ext/cypher/features.GenAIFunctionFeatures")--_GenAIFunctionFeatures_genai_vector_encode = (Core.Name "genai.vector.encode")---- | Graph functions-data GraphFunctionFeatures = -  GraphFunctionFeatures {-    -- | The graph.byElementId() function. Resolves the constituent graph to which a given element id belongs. Introduced in 5.13.-    graphFunctionFeaturesGraph_byElementId :: Bool,-    -- | The graph.byName() function. Resolves a constituent graph by name.-    graphFunctionFeaturesGraph_byName :: Bool,-    -- | The graph.names() function. Returns a list containing the names of all graphs in the current composite database.-    graphFunctionFeaturesGraph_names :: Bool,-    -- | The graph.propertiesByName() function. Returns a map containing the properties associated with the given graph.-    graphFunctionFeaturesGraph_propertiesByName :: Bool}-  deriving (Eq, Ord, Read, Show)--_GraphFunctionFeatures = (Core.Name "hydra/ext/cypher/features.GraphFunctionFeatures")--_GraphFunctionFeatures_graph_byElementId = (Core.Name "graph.byElementId")--_GraphFunctionFeatures_graph_byName = (Core.Name "graph.byName")--_GraphFunctionFeatures_graph_names = (Core.Name "graph.names")--_GraphFunctionFeatures_graph_propertiesByName = (Core.Name "graph.propertiesByName")---- | List functions-data ListFunctionFeatures = -  ListFunctionFeatures {-    -- | The keys() function. Returns a LIST<STRING> containing the STRING representations for all the property names of a MAP.; Returns a LIST<STRING> containing the STRING representations for all the property names of a NODE.; Returns a LIST<STRING> containing the STRING representations for all the property names of a RELATIONSHIP.-    listFunctionFeaturesKeys :: Bool,-    -- | The labels() function. Returns a LIST<STRING> containing the STRING representations for all the labels of a NODE.-    listFunctionFeaturesLabels :: Bool,-    -- | The nodes() function. Returns a LIST<NODE> containing all the NODE values in a PATH.-    listFunctionFeaturesNodes :: Bool,-    -- | The range() function. Returns a LIST<INTEGER> comprising all INTEGER values within a specified range.; Returns a LIST<INTEGER> comprising all INTEGER values within a specified range created with step length.-    listFunctionFeaturesRange :: Bool,-    -- | The reduce() function. Runs an expression against individual elements of a LIST<ANY>, storing the result of the expression in an accumulator.-    listFunctionFeaturesReduce :: Bool,-    -- | The relationships() function. Returns a LIST<RELATIONSHIP> containing all the RELATIONSHIP values in a PATH.-    listFunctionFeaturesRelationships :: Bool,-    -- | The reverse() function. Returns a LIST<ANY> in which the order of all elements in the given LIST<ANY> have been reversed.-    listFunctionFeaturesReverse :: Bool,-    -- | The tail() function. Returns all but the first element in a LIST<ANY>.-    listFunctionFeaturesTail :: Bool,-    -- | The toBooleanList() function. Converts a LIST<ANY> of values to a LIST<BOOLEAN> values. If any values are not convertible to BOOLEAN they will be null in the LIST<BOOLEAN> returned.-    listFunctionFeaturesToBooleanList :: Bool,-    -- | The toFloatList() function. Converts a LIST<ANY> to a LIST<FLOAT> values. If any values are not convertible to FLOAT they will be null in the LIST<FLOAT> returned.-    listFunctionFeaturesToFloatList :: Bool,-    -- | The toIntegerList() function. Converts a LIST<ANY> to a LIST<INTEGER> values. If any values are not convertible to INTEGER they will be null in the LIST<INTEGER> returned.-    listFunctionFeaturesToIntegerList :: Bool,-    -- | The toStringList() function. Converts a LIST<ANY> to a LIST<STRING> values. If any values are not convertible to STRING they will be null in the LIST<STRING> returned.-    listFunctionFeaturesToStringList :: Bool}-  deriving (Eq, Ord, Read, Show)--_ListFunctionFeatures = (Core.Name "hydra/ext/cypher/features.ListFunctionFeatures")--_ListFunctionFeatures_keys = (Core.Name "keys")--_ListFunctionFeatures_labels = (Core.Name "labels")--_ListFunctionFeatures_nodes = (Core.Name "nodes")--_ListFunctionFeatures_range = (Core.Name "range")--_ListFunctionFeatures_reduce = (Core.Name "reduce")--_ListFunctionFeatures_relationships = (Core.Name "relationships")--_ListFunctionFeatures_reverse = (Core.Name "reverse")--_ListFunctionFeatures_tail = (Core.Name "tail")--_ListFunctionFeatures_toBooleanList = (Core.Name "toBooleanList")--_ListFunctionFeatures_toFloatList = (Core.Name "toFloatList")--_ListFunctionFeatures_toIntegerList = (Core.Name "toIntegerList")--_ListFunctionFeatures_toStringList = (Core.Name "toStringList")---- | Load CSV functions-data LoadCSVFunctionFeatures = -  LoadCSVFunctionFeatures {-    -- | The file() function. Returns the absolute path of the file that LOAD CSV is using.-    loadCSVFunctionFeaturesFile :: Bool,-    -- | The linenumber() function. Returns the line number that LOAD CSV is currently using.-    loadCSVFunctionFeaturesLinenumber :: Bool}-  deriving (Eq, Ord, Read, Show)--_LoadCSVFunctionFeatures = (Core.Name "hydra/ext/cypher/features.LoadCSVFunctionFeatures")--_LoadCSVFunctionFeatures_file = (Core.Name "file")--_LoadCSVFunctionFeatures_linenumber = (Core.Name "linenumber")---- | Logarithmic functions-data LogarithmicFunctionFeatures = -  LogarithmicFunctionFeatures {-    -- | The e() function. Returns the base of the natural logarithm, e.-    logarithmicFunctionFeaturesE :: Bool,-    -- | The exp() function. Returns e^n, where e is the base of the natural logarithm, and n is the value of the argument expression.-    logarithmicFunctionFeaturesExp :: Bool,-    -- | The log() function. Returns the natural logarithm of a FLOAT.-    logarithmicFunctionFeaturesLog :: Bool,-    -- | The log10() function. Returns the common logarithm (base 10) of a FLOAT.-    logarithmicFunctionFeaturesLog10 :: Bool,-    -- | The sqrt() function. Returns the square root of a FLOAT.-    logarithmicFunctionFeaturesSqrt :: Bool}-  deriving (Eq, Ord, Read, Show)--_LogarithmicFunctionFeatures = (Core.Name "hydra/ext/cypher/features.LogarithmicFunctionFeatures")--_LogarithmicFunctionFeatures_e = (Core.Name "e")--_LogarithmicFunctionFeatures_exp = (Core.Name "exp")--_LogarithmicFunctionFeatures_log = (Core.Name "log")--_LogarithmicFunctionFeatures_log10 = (Core.Name "log10")--_LogarithmicFunctionFeatures_sqrt = (Core.Name "sqrt")---- | Numeric functions-data NumericFunctionFeatures = -  NumericFunctionFeatures {-    -- | The abs() function. Returns the absolute value of a FLOAT.; Returns the absolute value of an INTEGER.-    numericFunctionFeaturesAbs :: Bool,-    -- | The ceil() function. Returns the smallest FLOAT that is greater than or equal to a number and equal to an INTEGER.-    numericFunctionFeaturesCeil :: Bool,-    -- | The floor() function. Returns the largest FLOAT that is less than or equal to a number and equal to an INTEGER.-    numericFunctionFeaturesFloor :: Bool,-    -- | The isNaN() function. Returns true if the floating point number is NaN.; Returns true if the integer number is NaN.-    numericFunctionFeaturesIsNaN :: Bool,-    -- | The rand() function. Returns a random FLOAT in the range from 0 (inclusive) to 1 (exclusive).-    numericFunctionFeaturesRand :: Bool,-    -- | The round() function. Returns the value of a number rounded to the nearest INTEGER.; Returns the value of a number rounded to the specified precision using rounding mode HALF_UP.; Returns the value of a number rounded to the specified precision with the specified rounding mode.-    numericFunctionFeaturesRound :: Bool,-    -- | The sign() function. Returns the signum of a FLOAT: 0 if the number is 0, -1 for any negative number, and 1 for any positive number.; Returns the signum of an INTEGER: 0 if the number is 0, -1 for any negative number, and 1 for any positive number.-    numericFunctionFeaturesSign :: Bool}-  deriving (Eq, Ord, Read, Show)--_NumericFunctionFeatures = (Core.Name "hydra/ext/cypher/features.NumericFunctionFeatures")--_NumericFunctionFeatures_abs = (Core.Name "abs")--_NumericFunctionFeatures_ceil = (Core.Name "ceil")--_NumericFunctionFeatures_floor = (Core.Name "floor")--_NumericFunctionFeatures_isNaN = (Core.Name "isNaN")--_NumericFunctionFeatures_rand = (Core.Name "rand")--_NumericFunctionFeatures_round = (Core.Name "round")--_NumericFunctionFeatures_sign = (Core.Name "sign")---- | Predicate functions-data PredicateFunctionFeatures = -  PredicateFunctionFeatures {-    -- | The all() function. Returns true if the predicate holds for all elements in the given LIST<ANY>.-    predicateFunctionFeaturesAll :: Bool,-    -- | The any() function. Returns true if the predicate holds for at least one element in the given LIST<ANY>.-    predicateFunctionFeaturesAny :: Bool,-    -- | The exists() function. Returns true if a match for the pattern exists in the graph.-    predicateFunctionFeaturesExists :: Bool,-    -- | The isEmpty() function. Checks whether a LIST<ANY> is empty.; Checks whether a MAP is empty.; Checks whether a STRING is empty.-    predicateFunctionFeaturesIsEmpty :: Bool,-    -- | The none() function. Returns true if the predicate holds for no element in the given LIST<ANY>.-    predicateFunctionFeaturesNone :: Bool,-    -- | The single() function. Returns true if the predicate holds for exactly one of the elements in the given LIST<ANY>.-    predicateFunctionFeaturesSingle :: Bool}-  deriving (Eq, Ord, Read, Show)--_PredicateFunctionFeatures = (Core.Name "hydra/ext/cypher/features.PredicateFunctionFeatures")--_PredicateFunctionFeatures_all = (Core.Name "all")--_PredicateFunctionFeatures_any = (Core.Name "any")--_PredicateFunctionFeatures_exists = (Core.Name "exists")--_PredicateFunctionFeatures_isEmpty = (Core.Name "isEmpty")--_PredicateFunctionFeatures_none = (Core.Name "none")--_PredicateFunctionFeatures_single = (Core.Name "single")---- | Scalar functions-data ScalarFunctionFeatures = -  ScalarFunctionFeatures {-    -- | The char_length() function. Returns the number of Unicode characters in a STRING.-    scalarFunctionFeaturesChar_length :: Bool,-    -- | The character_length() function. Returns the number of Unicode characters in a STRING.-    scalarFunctionFeaturesCharacter_length :: Bool,-    -- | The coalesce() function. Returns the first non-null value in a list of expressions.-    scalarFunctionFeaturesCoalesce :: Bool,-    -- | The elementId() function. Returns a node identifier, unique within a specific transaction and DBMS.; Returns a relationship identifier, unique within a specific transaction and DBMS.-    scalarFunctionFeaturesElementId :: Bool,-    -- | The endNode() function. Returns a relationship identifier, unique within a specific transaction and DBMS.-    scalarFunctionFeaturesEndNode :: Bool,-    -- | The head() function. Returns the first element in a LIST<ANY>.-    scalarFunctionFeaturesHead :: Bool,-    -- | The id() function. [Deprecated] Returns the id of a NODE. Replaced by elementId().; [Deprecated] Returns the id of a RELATIONSHIP. Replaced by elementId().-    scalarFunctionFeaturesId :: Bool,-    -- | The last() function. Returns the last element in a LIST<ANY>.-    scalarFunctionFeaturesLast :: Bool,-    -- | The length() function. Returns the length of a PATH.-    scalarFunctionFeaturesLength :: Bool,-    -- | The nullIf() function. Returns null if the two given parameters are equivalent, otherwise returns the value of the first parameter.-    scalarFunctionFeaturesNullIf :: Bool,-    -- | The properties() function. Returns a MAP containing all the properties of a MAP.; Returns a MAP containing all the properties of a NODE.; Returns a MAP containing all the properties of a RELATIONSHIP.-    scalarFunctionFeaturesProperties :: Bool,-    -- | The randomUUID() function. Generates a random UUID.-    scalarFunctionFeaturesRandomUUID :: Bool,-    -- | The size() function. Returns the number of items in a LIST<ANY>.; Returns the number of Unicode characters in a STRING.-    scalarFunctionFeaturesSize :: Bool,-    -- | The startNode() function. Returns the start NODE of a RELATIONSHIP.-    scalarFunctionFeaturesStartNode :: Bool,-    -- | The toBoolean() function. Converts a STRING value to a BOOLEAN value.; Converts a BOOLEAN value to a BOOLEAN value.; Converts an INTEGER value to a BOOLEAN value.-    scalarFunctionFeaturesToBoolean :: Bool,-    -- | The toBooleanOrNull() function. Converts a value to a BOOLEAN value, or null if the value cannot be converted.-    scalarFunctionFeaturesToBooleanOrNull :: Bool,-    -- | The toFloat() function. Converts an INTEGER value to a FLOAT value.; Converts a STRING value to a FLOAT value.-    scalarFunctionFeaturesToFloat :: Bool,-    -- | The toFloatOrNull() function. Converts a value to a FLOAT value, or null if the value cannot be converted.-    scalarFunctionFeaturesToFloatOrNull :: Bool,-    -- | The toInteger() function. Converts a FLOAT value to an INTEGER value.; Converts a BOOLEAN value to an INTEGER value.; Converts a STRING value to an INTEGER value.-    scalarFunctionFeaturesToInteger :: Bool,-    -- | The toIntegerOrNull() function. Converts a value to an INTEGER value, or null if the value cannot be converted.-    scalarFunctionFeaturesToIntegerOrNull :: Bool,-    -- | The type() function. Returns a STRING representation of the RELATIONSHIP type.-    scalarFunctionFeaturesType :: Bool,-    -- | The valueType() function. Returns a STRING representation of the most precise value type that the given expression evaluates to.-    scalarFunctionFeaturesValueType :: Bool}-  deriving (Eq, Ord, Read, Show)--_ScalarFunctionFeatures = (Core.Name "hydra/ext/cypher/features.ScalarFunctionFeatures")--_ScalarFunctionFeatures_char_length = (Core.Name "char_length")--_ScalarFunctionFeatures_character_length = (Core.Name "character_length")--_ScalarFunctionFeatures_coalesce = (Core.Name "coalesce")--_ScalarFunctionFeatures_elementId = (Core.Name "elementId")--_ScalarFunctionFeatures_endNode = (Core.Name "endNode")--_ScalarFunctionFeatures_head = (Core.Name "head")--_ScalarFunctionFeatures_id = (Core.Name "id")--_ScalarFunctionFeatures_last = (Core.Name "last")--_ScalarFunctionFeatures_length = (Core.Name "length")--_ScalarFunctionFeatures_nullIf = (Core.Name "nullIf")--_ScalarFunctionFeatures_properties = (Core.Name "properties")--_ScalarFunctionFeatures_randomUUID = (Core.Name "randomUUID")--_ScalarFunctionFeatures_size = (Core.Name "size")--_ScalarFunctionFeatures_startNode = (Core.Name "startNode")--_ScalarFunctionFeatures_toBoolean = (Core.Name "toBoolean")--_ScalarFunctionFeatures_toBooleanOrNull = (Core.Name "toBooleanOrNull")--_ScalarFunctionFeatures_toFloat = (Core.Name "toFloat")--_ScalarFunctionFeatures_toFloatOrNull = (Core.Name "toFloatOrNull")--_ScalarFunctionFeatures_toInteger = (Core.Name "toInteger")--_ScalarFunctionFeatures_toIntegerOrNull = (Core.Name "toIntegerOrNull")--_ScalarFunctionFeatures_type = (Core.Name "type")--_ScalarFunctionFeatures_valueType = (Core.Name "valueType")---- | Spatial functions-data SpatialFunctionFeatures = -  SpatialFunctionFeatures {-    -- | The point.distance() function. Returns a FLOAT representing the geodesic distance between any two points in the same CRS.-    spatialFunctionFeaturesPoint_distance :: Bool,-    -- | The point() function. Returns a 2D point object, given two coordinate values in the Cartesian coordinate system.; Returns a 3D point object, given three coordinate values in the Cartesian coordinate system.; Returns a 2D point object, given two coordinate values in the WGS 84 geographic coordinate system.; Returns a 3D point object, given three coordinate values in the WGS 84 geographic coordinate system.-    spatialFunctionFeaturesPoint :: Bool,-    -- | The point.withinBBox() function. Returns true if the provided point is within the bounding box defined by the two provided points, lowerLeft and upperRight.-    spatialFunctionFeaturesPoint_withinBBox :: Bool}-  deriving (Eq, Ord, Read, Show)--_SpatialFunctionFeatures = (Core.Name "hydra/ext/cypher/features.SpatialFunctionFeatures")--_SpatialFunctionFeatures_point_distance = (Core.Name "point.distance")--_SpatialFunctionFeatures_point = (Core.Name "point")--_SpatialFunctionFeatures_point_withinBBox = (Core.Name "point.withinBBox")---- | String functions-data StringFunctionFeatures = -  StringFunctionFeatures {-    -- | The btrim() function. Returns the given STRING with leading and trailing whitespace removed.; Returns the given STRING with leading and trailing trimCharacterString characters removed. Introduced in 5.20.-    stringFunctionFeaturesBtrim :: Bool,-    -- | The left() function. Returns a STRING containing the specified number (INTEGER) of leftmost characters in the given STRING.-    stringFunctionFeaturesLeft :: Bool,-    -- | The lower() function. Returns the given STRING in lowercase. This function is an alias to the toLower() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21.-    stringFunctionFeaturesLower :: Bool,-    -- | The ltrim() function. Returns the given STRING with leading whitespace removed.; Returns the given STRING with leading trimCharacterString characters removed. Introduced in 5.20.-    stringFunctionFeaturesLtrim :: Bool,-    -- | The normalize() function. Returns the given STRING normalized according to the normalization CypherFunctionForm NFC. Introduced in 5.17.; Returns the given STRING normalized according to the specified normalization CypherFunctionForm. Introduced in 5.17.-    stringFunctionFeaturesNormalize :: Bool,-    -- | The replace() function. Returns a STRING in which all occurrences of a specified search STRING in the given STRING have been replaced by another (specified) replacement STRING.-    stringFunctionFeaturesReplace :: Bool,-    -- | The reverse() function. Returns a STRING in which the order of all characters in the given STRING have been reversed.-    stringFunctionFeaturesReverse :: Bool,-    -- | The right() function. Returns a STRING containing the specified number of rightmost characters in the given STRING.-    stringFunctionFeaturesRight :: Bool,-    -- | The rtrim() function. Returns the given STRING with trailing whitespace removed.; Returns the given STRING with trailing trimCharacterString characters removed. Introduced in 5.20.-    stringFunctionFeaturesRtrim :: Bool,-    -- | The split() function. Returns a LIST<STRING> resulting from the splitting of the given STRING around matches of the given delimiter.; Returns a LIST<STRING> resulting from the splitting of the given STRING around matches of any of the given delimiters.-    stringFunctionFeaturesSplit :: Bool,-    -- | The substring() function. Returns a substring of the given STRING, beginning with a 0-based index start.; Returns a substring of a given length from the given STRING, beginning with a 0-based index start.-    stringFunctionFeaturesSubstring :: Bool,-    -- | The toLower() function. Returns the given STRING in lowercase.-    stringFunctionFeaturesToLower :: Bool,-    -- | The toString() function. Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING.-    stringFunctionFeaturesToString :: Bool,-    -- | The toStringOrNull() function. Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING, or null if the value cannot be converted.-    stringFunctionFeaturesToStringOrNull :: Bool,-    -- | The toUpper() function. Returns the given STRING in uppercase.-    stringFunctionFeaturesToUpper :: Bool,-    -- | The trim() function. Returns the given STRING with leading and trailing whitespace removed.; Returns the given STRING with the leading and/or trailing trimCharacterString character removed. Introduced in 5.20.-    stringFunctionFeaturesTrim :: Bool,-    -- | The upper() function. Returns the given STRING in uppercase. This function is an alias to the toUpper() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21.-    stringFunctionFeaturesUpper :: Bool}-  deriving (Eq, Ord, Read, Show)--_StringFunctionFeatures = (Core.Name "hydra/ext/cypher/features.StringFunctionFeatures")--_StringFunctionFeatures_btrim = (Core.Name "btrim")--_StringFunctionFeatures_left = (Core.Name "left")--_StringFunctionFeatures_lower = (Core.Name "lower")--_StringFunctionFeatures_ltrim = (Core.Name "ltrim")--_StringFunctionFeatures_normalize = (Core.Name "normalize")--_StringFunctionFeatures_replace = (Core.Name "replace")--_StringFunctionFeatures_reverse = (Core.Name "reverse")--_StringFunctionFeatures_right = (Core.Name "right")--_StringFunctionFeatures_rtrim = (Core.Name "rtrim")--_StringFunctionFeatures_split = (Core.Name "split")--_StringFunctionFeatures_substring = (Core.Name "substring")--_StringFunctionFeatures_toLower = (Core.Name "toLower")--_StringFunctionFeatures_toString = (Core.Name "toString")--_StringFunctionFeatures_toStringOrNull = (Core.Name "toStringOrNull")--_StringFunctionFeatures_toUpper = (Core.Name "toUpper")--_StringFunctionFeatures_trim = (Core.Name "trim")--_StringFunctionFeatures_upper = (Core.Name "upper")---- | Temporal duration functions-data TemporalDurationFunctionFeatures = -  TemporalDurationFunctionFeatures {-    -- | The duration() function. Constructs a DURATION value.-    temporalDurationFunctionFeaturesDuration :: Bool,-    -- | The duration.between() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in logical units.-    temporalDurationFunctionFeaturesDuration_between :: Bool,-    -- | The duration.inDays() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in days.-    temporalDurationFunctionFeaturesDuration_inDays :: Bool,-    -- | The duration.inMonths() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in months.-    temporalDurationFunctionFeaturesDuration_inMonths :: Bool,-    -- | The duration.inSeconds() function. Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in seconds.-    temporalDurationFunctionFeaturesDuration_inSeconds :: Bool}-  deriving (Eq, Ord, Read, Show)--_TemporalDurationFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TemporalDurationFunctionFeatures")--_TemporalDurationFunctionFeatures_duration = (Core.Name "duration")--_TemporalDurationFunctionFeatures_duration_between = (Core.Name "duration.between")--_TemporalDurationFunctionFeatures_duration_inDays = (Core.Name "duration.inDays")--_TemporalDurationFunctionFeatures_duration_inMonths = (Core.Name "duration.inMonths")--_TemporalDurationFunctionFeatures_duration_inSeconds = (Core.Name "duration.inSeconds")---- | Temporal instant functions-data TemporalInstantFunctionFeatures = -  TemporalInstantFunctionFeatures {-    -- | The date() function. Creates a DATE instant.-    temporalInstantFunctionFeaturesDate :: Bool,-    -- | The date.realtime() function. Returns the current DATE instant using the realtime clock.-    temporalInstantFunctionFeaturesDate_realtime :: Bool,-    -- | The date.statement() function. Returns the current DATE instant using the statement clock.-    temporalInstantFunctionFeaturesDate_statement :: Bool,-    -- | The date.transaction() function. Returns the current DATE instant using the transaction clock.-    temporalInstantFunctionFeaturesDate_transaction :: Bool,-    -- | The date.truncate() function. Truncates the given temporal value to a DATE instant using the specified unit.-    temporalInstantFunctionFeaturesDate_truncate :: Bool,-    -- | The datetime() function. Creates a ZONED DATETIME instant.-    temporalInstantFunctionFeaturesDatetime :: Bool,-    -- | The datetime.fromepoch() function. Creates a ZONED DATETIME given the seconds and nanoseconds since the start of the epoch.-    temporalInstantFunctionFeaturesDatetime_fromepoch :: Bool,-    -- | The datetime.fromepochmillis() function. Creates a ZONED DATETIME given the milliseconds since the start of the epoch.-    temporalInstantFunctionFeaturesDatetime_fromepochmillis :: Bool,-    -- | The datetime.realtime() function. Returns the current ZONED DATETIME instant using the realtime clock.-    temporalInstantFunctionFeaturesDatetime_realtime :: Bool,-    -- | The datetime.statement() function. Returns the current ZONED DATETIME instant using the statement clock.-    temporalInstantFunctionFeaturesDatetime_statement :: Bool,-    -- | The datetime.transaction() function. Returns the current ZONED DATETIME instant using the transaction clock.-    temporalInstantFunctionFeaturesDatetime_transaction :: Bool,-    -- | The datetime.truncate() function. Truncates the given temporal value to a ZONED DATETIME instant using the specified unit.-    temporalInstantFunctionFeaturesDatetime_truncate :: Bool,-    -- | The localdatetime() function. Creates a LOCAL DATETIME instant.-    temporalInstantFunctionFeaturesLocaldatetime :: Bool,-    -- | The localdatetime.realtime() function. Returns the current LOCAL DATETIME instant using the realtime clock.-    temporalInstantFunctionFeaturesLocaldatetime_realtime :: Bool,-    -- | The localdatetime.statement() function. Returns the current LOCAL DATETIME instant using the statement clock.-    temporalInstantFunctionFeaturesLocaldatetime_statement :: Bool,-    -- | The localdatetime.transaction() function. Returns the current LOCAL DATETIME instant using the transaction clock.-    temporalInstantFunctionFeaturesLocaldatetime_transaction :: Bool,-    -- | The localdatetime.truncate() function. Truncates the given temporal value to a LOCAL DATETIME instant using the specified unit.-    temporalInstantFunctionFeaturesLocaldatetime_truncate :: Bool,-    -- | The localtime() function. Creates a LOCAL TIME instant.-    temporalInstantFunctionFeaturesLocaltime :: Bool,-    -- | The localtime.realtime() function. Returns the current LOCAL TIME instant using the realtime clock.-    temporalInstantFunctionFeaturesLocaltime_realtime :: Bool,-    -- | The localtime.statement() function. Returns the current LOCAL TIME instant using the statement clock.-    temporalInstantFunctionFeaturesLocaltime_statement :: Bool,-    -- | The localtime.transaction() function. Returns the current LOCAL TIME instant using the transaction clock.-    temporalInstantFunctionFeaturesLocaltime_transaction :: Bool,-    -- | The localtime.truncate() function. Truncates the given temporal value to a LOCAL TIME instant using the specified unit.-    temporalInstantFunctionFeaturesLocaltime_truncate :: Bool,-    -- | The time() function. Creates a ZONED TIME instant.-    temporalInstantFunctionFeaturesTime :: Bool,-    -- | The time.realtime() function. Returns the current ZONED TIME instant using the realtime clock.-    temporalInstantFunctionFeaturesTime_realtime :: Bool,-    -- | The time.statement() function. Returns the current ZONED TIME instant using the statement clock.-    temporalInstantFunctionFeaturesTime_statement :: Bool,-    -- | The time.transaction() function. Returns the current ZONED TIME instant using the transaction clock.-    temporalInstantFunctionFeaturesTime_transaction :: Bool,-    -- | The time.truncate() function. Truncates the given temporal value to a ZONED TIME instant using the specified unit.-    temporalInstantFunctionFeaturesTime_truncate :: Bool}-  deriving (Eq, Ord, Read, Show)--_TemporalInstantFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TemporalInstantFunctionFeatures")--_TemporalInstantFunctionFeatures_date = (Core.Name "date")--_TemporalInstantFunctionFeatures_date_realtime = (Core.Name "date.realtime")--_TemporalInstantFunctionFeatures_date_statement = (Core.Name "date.statement")--_TemporalInstantFunctionFeatures_date_transaction = (Core.Name "date.transaction")--_TemporalInstantFunctionFeatures_date_truncate = (Core.Name "date.truncate")--_TemporalInstantFunctionFeatures_datetime = (Core.Name "datetime")--_TemporalInstantFunctionFeatures_datetime_fromepoch = (Core.Name "datetime.fromepoch")--_TemporalInstantFunctionFeatures_datetime_fromepochmillis = (Core.Name "datetime.fromepochmillis")--_TemporalInstantFunctionFeatures_datetime_realtime = (Core.Name "datetime.realtime")--_TemporalInstantFunctionFeatures_datetime_statement = (Core.Name "datetime.statement")--_TemporalInstantFunctionFeatures_datetime_transaction = (Core.Name "datetime.transaction")--_TemporalInstantFunctionFeatures_datetime_truncate = (Core.Name "datetime.truncate")--_TemporalInstantFunctionFeatures_localdatetime = (Core.Name "localdatetime")--_TemporalInstantFunctionFeatures_localdatetime_realtime = (Core.Name "localdatetime.realtime")--_TemporalInstantFunctionFeatures_localdatetime_statement = (Core.Name "localdatetime.statement")--_TemporalInstantFunctionFeatures_localdatetime_transaction = (Core.Name "localdatetime.transaction")--_TemporalInstantFunctionFeatures_localdatetime_truncate = (Core.Name "localdatetime.truncate")--_TemporalInstantFunctionFeatures_localtime = (Core.Name "localtime")--_TemporalInstantFunctionFeatures_localtime_realtime = (Core.Name "localtime.realtime")--_TemporalInstantFunctionFeatures_localtime_statement = (Core.Name "localtime.statement")--_TemporalInstantFunctionFeatures_localtime_transaction = (Core.Name "localtime.transaction")--_TemporalInstantFunctionFeatures_localtime_truncate = (Core.Name "localtime.truncate")--_TemporalInstantFunctionFeatures_time = (Core.Name "time")--_TemporalInstantFunctionFeatures_time_realtime = (Core.Name "time.realtime")--_TemporalInstantFunctionFeatures_time_statement = (Core.Name "time.statement")--_TemporalInstantFunctionFeatures_time_transaction = (Core.Name "time.transaction")--_TemporalInstantFunctionFeatures_time_truncate = (Core.Name "time.truncate")---- | Trigonometric functions-data TrigonometricFunctionFeatures = -  TrigonometricFunctionFeatures {-    -- | The acos() function. Returns the arccosine of a FLOAT in radians.-    trigonometricFunctionFeaturesAcos :: Bool,-    -- | The asin() function. Returns the arcsine of a FLOAT in radians.-    trigonometricFunctionFeaturesAsin :: Bool,-    -- | The atan() function. Returns the arctangent of a FLOAT in radians.-    trigonometricFunctionFeaturesAtan :: Bool,-    -- | The atan2() function. Returns the arctangent2 of a set of coordinates in radians.-    trigonometricFunctionFeaturesAtan2 :: Bool,-    -- | The cos() function. Returns the cosine of a FLOAT.-    trigonometricFunctionFeaturesCos :: Bool,-    -- | The cot() function. Returns the cotangent of a FLOAT.-    trigonometricFunctionFeaturesCot :: Bool,-    -- | The degrees() function. Converts radians to degrees.-    trigonometricFunctionFeaturesDegrees :: Bool,-    -- | The haversin() function. Returns half the versine of a number.-    trigonometricFunctionFeaturesHaversin :: Bool,-    -- | The pi() function. Returns the mathematical constant pi.-    trigonometricFunctionFeaturesPi :: Bool,-    -- | The radians() function. Converts degrees to radians.-    trigonometricFunctionFeaturesRadians :: Bool,-    -- | The sin() function. Returns the sine of a FLOAT.-    trigonometricFunctionFeaturesSin :: Bool,-    -- | The tan() function. Returns the tangent of a FLOAT.-    trigonometricFunctionFeaturesTan :: Bool}-  deriving (Eq, Ord, Read, Show)--_TrigonometricFunctionFeatures = (Core.Name "hydra/ext/cypher/features.TrigonometricFunctionFeatures")--_TrigonometricFunctionFeatures_acos = (Core.Name "acos")--_TrigonometricFunctionFeatures_asin = (Core.Name "asin")--_TrigonometricFunctionFeatures_atan = (Core.Name "atan")--_TrigonometricFunctionFeatures_atan2 = (Core.Name "atan2")--_TrigonometricFunctionFeatures_cos = (Core.Name "cos")--_TrigonometricFunctionFeatures_cot = (Core.Name "cot")--_TrigonometricFunctionFeatures_degrees = (Core.Name "degrees")--_TrigonometricFunctionFeatures_haversin = (Core.Name "haversin")--_TrigonometricFunctionFeatures_pi = (Core.Name "pi")--_TrigonometricFunctionFeatures_radians = (Core.Name "radians")--_TrigonometricFunctionFeatures_sin = (Core.Name "sin")--_TrigonometricFunctionFeatures_tan = (Core.Name "tan")---- | Vector functions-data VectorFunctionFeatures = -  VectorFunctionFeatures {-    -- | The vector.similarity.cosine() function. Returns a FLOAT representing the similarity between the argument vectors based on their cosine.-    vectorFunctionFeaturesVector_similarity_cosine :: Bool,-    -- | The vector.similarity.euclidean() function. Returns a FLOAT representing the similarity between the argument vectors based on their Euclidean distance.-    vectorFunctionFeaturesVector_similarity_euclidean :: Bool}-  deriving (Eq, Ord, Read, Show)--_VectorFunctionFeatures = (Core.Name "hydra/ext/cypher/features.VectorFunctionFeatures")--_VectorFunctionFeatures_vector_similarity_cosine = (Core.Name "vector.similarity.cosine")--_VectorFunctionFeatures_vector_similarity_euclidean = (Core.Name "vector.similarity.euclidean")---- | List functionality-data ListFeatures = -  ListFeatures {-    -- | Basic list comprehensions-    listFeaturesListComprehension :: Bool,-    -- | List range comprehensions (e.g. [1..10])-    listFeaturesListRange :: Bool}-  deriving (Eq, Ord, Read, Show)--_ListFeatures = (Core.Name "hydra/ext/cypher/features.ListFeatures")--_ListFeatures_listComprehension = (Core.Name "listComprehension")--_ListFeatures_listRange = (Core.Name "listRange")---- | Various types of literal values-data LiteralFeatures = -  LiteralFeatures {-    -- | Boolean literals (note: included by most if not all implementations).-    literalFeaturesBoolean :: Bool,-    -- | Double-precision floating-point literals-    literalFeaturesDouble :: Bool,-    -- | Integer literals-    literalFeaturesInteger :: Bool,-    -- | List literals-    literalFeaturesList :: Bool,-    -- | Map literals-    literalFeaturesMap :: Bool,-    -- | The NULL literal-    literalFeaturesNull :: Bool,-    -- | String literals (note: included by most if not all implementations).-    literalFeaturesString :: Bool}-  deriving (Eq, Ord, Read, Show)--_LiteralFeatures = (Core.Name "hydra/ext/cypher/features.LiteralFeatures")--_LiteralFeatures_boolean = (Core.Name "boolean")--_LiteralFeatures_double = (Core.Name "double")--_LiteralFeatures_integer = (Core.Name "integer")--_LiteralFeatures_list = (Core.Name "list")--_LiteralFeatures_map = (Core.Name "map")--_LiteralFeatures_null = (Core.Name "null")--_LiteralFeatures_string = (Core.Name "string")---- | Logical operations-data LogicalFeatures = -  LogicalFeatures {-    -- | The AND operator-    logicalFeaturesAnd :: Bool,-    -- | The NOT operator-    logicalFeaturesNot :: Bool,-    -- | The OR operator-    logicalFeaturesOr :: Bool,-    -- | The XOR operator-    logicalFeaturesXor :: Bool}-  deriving (Eq, Ord, Read, Show)--_LogicalFeatures = (Core.Name "hydra/ext/cypher/features.LogicalFeatures")--_LogicalFeatures_and = (Core.Name "and")--_LogicalFeatures_not = (Core.Name "not")--_LogicalFeatures_or = (Core.Name "or")--_LogicalFeatures_xor = (Core.Name "xor")---- | Match queries-data MatchFeatures = -  MatchFeatures {-    -- | The basic (non-optional) MATCH clause-    matchFeaturesMatch :: Bool,-    -- | OPTIONAL MATCH-    matchFeaturesOptionalMatch :: Bool}-  deriving (Eq, Ord, Read, Show)--_MatchFeatures = (Core.Name "hydra/ext/cypher/features.MatchFeatures")--_MatchFeatures_match = (Core.Name "match")--_MatchFeatures_optionalMatch = (Core.Name "optionalMatch")---- | Merge operations-data MergeFeatures = -  MergeFeatures {-    -- | The basic MERGE clause-    mergeFeaturesMerge :: Bool,-    -- | MERGE with the ON CREATE action-    mergeFeaturesMergeOnCreate :: Bool,-    -- | MERGE with the ON MATCH action-    mergeFeaturesMergeOnMatch :: Bool}-  deriving (Eq, Ord, Read, Show)--_MergeFeatures = (Core.Name "hydra/ext/cypher/features.MergeFeatures")--_MergeFeatures_merge = (Core.Name "merge")--_MergeFeatures_mergeOnCreate = (Core.Name "mergeOnCreate")--_MergeFeatures_mergeOnMatch = (Core.Name "mergeOnMatch")---- | Node patterns-data NodePatternFeatures = -  NodePatternFeatures {-    -- | Specifying multiple labels in a node pattern-    nodePatternFeaturesMultipleLabels :: Bool,-    -- | Specifying a parameter as part of a node pattern-    nodePatternFeaturesParameter :: Bool,-    -- | Specifying a key/value map of properties in a node pattern-    nodePatternFeaturesPropertyMap :: Bool,-    -- | Binding a variable to a node in a node pattern (note: included by most if not all implementations).-    nodePatternFeaturesVariableNode :: Bool,-    -- | Omitting labels from a node pattern-    nodePatternFeaturesWildcardLabel :: Bool}-  deriving (Eq, Ord, Read, Show)--_NodePatternFeatures = (Core.Name "hydra/ext/cypher/features.NodePatternFeatures")--_NodePatternFeatures_multipleLabels = (Core.Name "multipleLabels")--_NodePatternFeatures_parameter = (Core.Name "parameter")--_NodePatternFeatures_propertyMap = (Core.Name "propertyMap")--_NodePatternFeatures_variableNode = (Core.Name "variableNode")--_NodePatternFeatures_wildcardLabel = (Core.Name "wildcardLabel")---- | IS NULL / IS NOT NULL checks-data NullFeatures = -  NullFeatures {-    -- | The IS NULL operator-    nullFeaturesIsNull :: Bool,-    -- | The IS NOT NULL operator-    nullFeaturesIsNotNull :: Bool}-  deriving (Eq, Ord, Read, Show)--_NullFeatures = (Core.Name "hydra/ext/cypher/features.NullFeatures")--_NullFeatures_isNull = (Core.Name "isNull")--_NullFeatures_isNotNull = (Core.Name "isNotNull")---- | Path functions only found in OpenCypher-data PathFeatures = -  PathFeatures {-    -- | The shortestPath() function-    pathFeaturesShortestPath :: Bool}-  deriving (Eq, Ord, Read, Show)--_PathFeatures = (Core.Name "hydra/ext/cypher/features.PathFeatures")--_PathFeatures_shortestPath = (Core.Name "shortestPath")---- | Procedure calls-data ProcedureCallFeatures = -  ProcedureCallFeatures {-    -- | CALL within a query-    procedureCallFeaturesInQueryCall :: Bool,-    -- | Standalone / top-level CALL-    procedureCallFeaturesStandaloneCall :: Bool,-    -- | The YIELD clause in CALL-    procedureCallFeaturesYield :: Bool}-  deriving (Eq, Ord, Read, Show)--_ProcedureCallFeatures = (Core.Name "hydra/ext/cypher/features.ProcedureCallFeatures")--_ProcedureCallFeatures_inQueryCall = (Core.Name "inQueryCall")--_ProcedureCallFeatures_standaloneCall = (Core.Name "standaloneCall")--_ProcedureCallFeatures_yield = (Core.Name "yield")---- | Projections-data ProjectionFeatures = -  ProjectionFeatures {-    -- | The LIMIT clause-    projectionFeaturesLimit :: Bool,-    -- | The ORDER BY clause-    projectionFeaturesOrderBy :: Bool,-    -- | The DISTINCT keyword-    projectionFeaturesProjectDistinct :: Bool,-    -- | The * projection-    projectionFeaturesProjectAll :: Bool,-    -- | The AS keyword-    projectionFeaturesProjectAs :: Bool,-    -- | The SKIP clause-    projectionFeaturesSkip :: Bool,-    -- | The ASC/ASCENDING and DESC/DESCENDING keywords-    projectionFeaturesSortOrder :: Bool}-  deriving (Eq, Ord, Read, Show)--_ProjectionFeatures = (Core.Name "hydra/ext/cypher/features.ProjectionFeatures")--_ProjectionFeatures_limit = (Core.Name "limit")--_ProjectionFeatures_orderBy = (Core.Name "orderBy")--_ProjectionFeatures_projectDistinct = (Core.Name "projectDistinct")--_ProjectionFeatures_projectAll = (Core.Name "projectAll")--_ProjectionFeatures_projectAs = (Core.Name "projectAs")--_ProjectionFeatures_skip = (Core.Name "skip")--_ProjectionFeatures_sortOrder = (Core.Name "sortOrder")---- | Quantifier expressions-data QuantifierFeatures = -  QuantifierFeatures {-    -- | The ALL quantifier-    quantifierFeaturesAll :: Bool,-    -- | The ANY quantifier-    quantifierFeaturesAny :: Bool,-    -- | The NONE quantifier-    quantifierFeaturesNone :: Bool,-    -- | The SINGLE quantifier-    quantifierFeaturesSingle :: Bool}-  deriving (Eq, Ord, Read, Show)--_QuantifierFeatures = (Core.Name "hydra/ext/cypher/features.QuantifierFeatures")--_QuantifierFeatures_all = (Core.Name "all")--_QuantifierFeatures_any = (Core.Name "any")--_QuantifierFeatures_none = (Core.Name "none")--_QuantifierFeatures_single = (Core.Name "single")---- | Range literals within relationship patterns-data RangeLiteralFeatures = -  RangeLiteralFeatures {-    -- | Range literals with both lower and upper bounds-    rangeLiteralFeaturesBounds :: Bool,-    -- | Range literals providing an exact number of repetitions-    rangeLiteralFeaturesExactRange :: Bool,-    -- | Range literals with a lower bound (only)-    rangeLiteralFeaturesLowerBound :: Bool,-    -- | The * range literal-    rangeLiteralFeaturesStarRange :: Bool,-    -- | Range literals with an upper bound (only)-    rangeLiteralFeaturesUpperBound :: Bool}-  deriving (Eq, Ord, Read, Show)--_RangeLiteralFeatures = (Core.Name "hydra/ext/cypher/features.RangeLiteralFeatures")--_RangeLiteralFeatures_bounds = (Core.Name "bounds")--_RangeLiteralFeatures_exactRange = (Core.Name "exactRange")--_RangeLiteralFeatures_lowerBound = (Core.Name "lowerBound")--_RangeLiteralFeatures_starRange = (Core.Name "starRange")--_RangeLiteralFeatures_upperBound = (Core.Name "upperBound")---- | Specific syntax related to reading data from the graph.-data ReadingFeatures = -  ReadingFeatures {-    -- | The UNION operator-    readingFeaturesUnion :: Bool,-    -- | The UNION ALL operator-    readingFeaturesUnionAll :: Bool,-    -- | The UNWIND clause-    readingFeaturesUnwind :: Bool}-  deriving (Eq, Ord, Read, Show)--_ReadingFeatures = (Core.Name "hydra/ext/cypher/features.ReadingFeatures")--_ReadingFeatures_union = (Core.Name "union")--_ReadingFeatures_unionAll = (Core.Name "unionAll")--_ReadingFeatures_unwind = (Core.Name "unwind")---- | Relationship directions / arrow patterns-data RelationshipDirectionFeatures = -  RelationshipDirectionFeatures {-    -- | The two-headed arrow (<-[]->) relationship direction-    relationshipDirectionFeaturesBoth :: Bool,-    -- | The left arrow (<-[]-) relationship direction-    relationshipDirectionFeaturesLeft :: Bool,-    -- | The headless arrow (-[]-) relationship direction-    relationshipDirectionFeaturesNeither :: Bool,-    -- | The right arrow (-[]->) relationship direction-    relationshipDirectionFeaturesRight :: Bool}-  deriving (Eq, Ord, Read, Show)--_RelationshipDirectionFeatures = (Core.Name "hydra/ext/cypher/features.RelationshipDirectionFeatures")--_RelationshipDirectionFeatures_both = (Core.Name "both")--_RelationshipDirectionFeatures_left = (Core.Name "left")--_RelationshipDirectionFeatures_neither = (Core.Name "neither")--_RelationshipDirectionFeatures_right = (Core.Name "right")---- | Relationship patterns-data RelationshipPatternFeatures = -  RelationshipPatternFeatures {-    -- | Specifying a disjunction of multiple types in a relationship pattern-    relationshipPatternFeaturesMultipleTypes :: Bool,-    -- | Binding a variable to a relationship in a relationship pattern (note: included by most if not all implementations).-    relationshipPatternFeaturesVariableRelationship :: Bool,-    -- | Omitting types from a relationship pattern-    relationshipPatternFeaturesWildcardType :: Bool}-  deriving (Eq, Ord, Read, Show)--_RelationshipPatternFeatures = (Core.Name "hydra/ext/cypher/features.RelationshipPatternFeatures")--_RelationshipPatternFeatures_multipleTypes = (Core.Name "multipleTypes")--_RelationshipPatternFeatures_variableRelationship = (Core.Name "variableRelationship")--_RelationshipPatternFeatures_wildcardType = (Core.Name "wildcardType")---- | REMOVE operations-data RemoveFeatures = -  RemoveFeatures {-    -- | REMOVE Variable:NodeLabels-    removeFeaturesByLabel :: Bool,-    -- | REMOVE PropertyExpression-    removeFeaturesByProperty :: Bool}-  deriving (Eq, Ord, Read, Show)--_RemoveFeatures = (Core.Name "hydra/ext/cypher/features.RemoveFeatures")--_RemoveFeatures_byLabel = (Core.Name "byLabel")--_RemoveFeatures_byProperty = (Core.Name "byProperty")---- | Set definitions-data SetFeatures = -  SetFeatures {-    -- | Defining a set using PropertyExpression = Expression-    setFeaturesPropertyEquals :: Bool,-    -- | Defining a set using Variable = Expression-    setFeaturesVariableEquals :: Bool,-    -- | Defining a set using Variable += Expression-    setFeaturesVariablePlusEquals :: Bool,-    -- | Defining a set using Variable:NodeLabels-    setFeaturesVariableWithNodeLabels :: Bool}-  deriving (Eq, Ord, Read, Show)--_SetFeatures = (Core.Name "hydra/ext/cypher/features.SetFeatures")--_SetFeatures_propertyEquals = (Core.Name "propertyEquals")--_SetFeatures_variableEquals = (Core.Name "variableEquals")--_SetFeatures_variablePlusEquals = (Core.Name "variablePlusEquals")--_SetFeatures_variableWithNodeLabels = (Core.Name "variableWithNodeLabels")---- | String functions/keywords only found in OpenCypher-data StringFeatures = -  StringFeatures {-    -- | The contains() function / CONTAINS-    stringFeaturesContains :: Bool,-    -- | The endsWith() function / ENDS WITH-    stringFeaturesEndsWith :: Bool,-    -- | The in() function / IN-    stringFeaturesIn :: Bool,-    -- | The startsWith() function / STARTS WITH-    stringFeaturesStartsWith :: Bool}-  deriving (Eq, Ord, Read, Show)--_StringFeatures = (Core.Name "hydra/ext/cypher/features.StringFeatures")--_StringFeatures_contains = (Core.Name "contains")--_StringFeatures_endsWith = (Core.Name "endsWith")--_StringFeatures_in = (Core.Name "in")--_StringFeatures_startsWith = (Core.Name "startsWith")---- | Specific syntax related to updating data in the graph-data UpdatingFeatures = -  UpdatingFeatures {-    -- | The CREATE clause-    updatingFeaturesCreate :: Bool,-    -- | The SET clause-    updatingFeaturesSet :: Bool,-    -- | Multi-part queries using WITH-    updatingFeaturesWith :: Bool}-  deriving (Eq, Ord, Read, Show)--_UpdatingFeatures = (Core.Name "hydra/ext/cypher/features.UpdatingFeatures")--_UpdatingFeatures_create = (Core.Name "create")--_UpdatingFeatures_set = (Core.Name "set")--_UpdatingFeatures_with = (Core.Name "with")
− src/gen-main/haskell/Hydra/Ext/Cypher/OpenCypher.hs 
@@ -1,1306 +0,0 @@--- | A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at:--- |   https://opencypher.org/resources/--module Hydra.Ext.Cypher.OpenCypher where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--data Query = -  QueryRegular RegularQuery |-  QueryStandalone StandaloneCall-  deriving (Eq, Ord, Read, Show)--_Query = (Core.Name "hydra/ext/cypher/openCypher.Query")--_Query_regular = (Core.Name "regular")--_Query_standalone = (Core.Name "standalone")--data RegularQuery = -  RegularQuery {-    regularQueryHead :: SingleQuery,-    regularQueryRest :: [Union]}-  deriving (Eq, Ord, Read, Show)--_RegularQuery = (Core.Name "hydra/ext/cypher/openCypher.RegularQuery")--_RegularQuery_head = (Core.Name "head")--_RegularQuery_rest = (Core.Name "rest")--data Union = -  Union {-    unionAll :: Bool,-    unionQuery :: SingleQuery}-  deriving (Eq, Ord, Read, Show)--_Union = (Core.Name "hydra/ext/cypher/openCypher.Union")--_Union_all = (Core.Name "all")--_Union_query = (Core.Name "query")--data SingleQuery = -  SingleQuerySinglePart SinglePartQuery |-  SingleQueryMultiPart MultiPartQuery-  deriving (Eq, Ord, Read, Show)--_SingleQuery = (Core.Name "hydra/ext/cypher/openCypher.SingleQuery")--_SingleQuery_singlePart = (Core.Name "singlePart")--_SingleQuery_multiPart = (Core.Name "multiPart")--data SinglePartQuery = -  SinglePartQuery {-    singlePartQueryReading :: [ReadingClause],-    singlePartQueryUpdating :: [UpdatingClause],-    singlePartQueryReturn :: (Maybe Return)}-  deriving (Eq, Ord, Read, Show)--_SinglePartQuery = (Core.Name "hydra/ext/cypher/openCypher.SinglePartQuery")--_SinglePartQuery_reading = (Core.Name "reading")--_SinglePartQuery_updating = (Core.Name "updating")--_SinglePartQuery_return = (Core.Name "return")--data WithClause = -  WithClause {-    withClauseReading :: [ReadingClause],-    withClauseUpdating :: [UpdatingClause],-    withClauseWith :: With}-  deriving (Eq, Ord, Read, Show)--_WithClause = (Core.Name "hydra/ext/cypher/openCypher.WithClause")--_WithClause_reading = (Core.Name "reading")--_WithClause_updating = (Core.Name "updating")--_WithClause_with = (Core.Name "with")--data MultiPartQuery = -  MultiPartQuery {-    multiPartQueryWith :: [WithClause],-    multiPartQueryBody :: SinglePartQuery}-  deriving (Eq, Ord, Read, Show)--_MultiPartQuery = (Core.Name "hydra/ext/cypher/openCypher.MultiPartQuery")--_MultiPartQuery_with = (Core.Name "with")--_MultiPartQuery_body = (Core.Name "body")--data UpdatingClause = -  UpdatingClauseCreate Create |-  UpdatingClauseMerge Merge |-  UpdatingClauseDelete Delete |-  UpdatingClauseSet Set_ |-  UpdatingClauseRemove Remove-  deriving (Eq, Ord, Read, Show)--_UpdatingClause = (Core.Name "hydra/ext/cypher/openCypher.UpdatingClause")--_UpdatingClause_create = (Core.Name "create")--_UpdatingClause_merge = (Core.Name "merge")--_UpdatingClause_delete = (Core.Name "delete")--_UpdatingClause_set = (Core.Name "set")--_UpdatingClause_remove = (Core.Name "remove")--data ReadingClause = -  ReadingClauseMatch Match |-  ReadingClauseUnwind Unwind |-  ReadingClauseInQueryCall InQueryCall-  deriving (Eq, Ord, Read, Show)--_ReadingClause = (Core.Name "hydra/ext/cypher/openCypher.ReadingClause")--_ReadingClause_match = (Core.Name "match")--_ReadingClause_unwind = (Core.Name "unwind")--_ReadingClause_inQueryCall = (Core.Name "inQueryCall")--data Match = -  Match {-    matchOptional :: Bool,-    matchPattern :: Pattern,-    matchWhere :: (Maybe Where)}-  deriving (Eq, Ord, Read, Show)--_Match = (Core.Name "hydra/ext/cypher/openCypher.Match")--_Match_optional = (Core.Name "optional")--_Match_pattern = (Core.Name "pattern")--_Match_where = (Core.Name "where")--data Unwind = -  Unwind {-    unwindExpression :: Expression,-    unwindVariable :: Variable}-  deriving (Eq, Ord, Read, Show)--_Unwind = (Core.Name "hydra/ext/cypher/openCypher.Unwind")--_Unwind_expression = (Core.Name "expression")--_Unwind_variable = (Core.Name "variable")--data Merge = -  Merge {-    mergePatternPart :: PatternPart,-    mergeActions :: [MergeAction]}-  deriving (Eq, Ord, Read, Show)--_Merge = (Core.Name "hydra/ext/cypher/openCypher.Merge")--_Merge_patternPart = (Core.Name "patternPart")--_Merge_actions = (Core.Name "actions")--data MatchOrCreate = -  MatchOrCreateMatch  |-  MatchOrCreateCreate -  deriving (Eq, Ord, Read, Show)--_MatchOrCreate = (Core.Name "hydra/ext/cypher/openCypher.MatchOrCreate")--_MatchOrCreate_match = (Core.Name "match")--_MatchOrCreate_create = (Core.Name "create")--data MergeAction = -  MergeAction {-    mergeActionAction :: MatchOrCreate,-    mergeActionSet :: Set_}-  deriving (Eq, Ord, Read, Show)--_MergeAction = (Core.Name "hydra/ext/cypher/openCypher.MergeAction")--_MergeAction_action = (Core.Name "action")--_MergeAction_set = (Core.Name "set")--newtype Create = -  Create {-    unCreate :: Pattern}-  deriving (Eq, Ord, Read, Show)--_Create = (Core.Name "hydra/ext/cypher/openCypher.Create")--newtype Set_ = -  Set_ {-    unSet :: [SetItem]}-  deriving (Eq, Ord, Read, Show)--_Set = (Core.Name "hydra/ext/cypher/openCypher.Set")--data SetItem = -  SetItemProperty PropertyEquals |-  SetItemVariableEqual VariableEquals |-  SetItemVariablePlusEqual VariablePlusEquals |-  SetItemVariableLabels VariableAndNodeLabels-  deriving (Eq, Ord, Read, Show)--_SetItem = (Core.Name "hydra/ext/cypher/openCypher.SetItem")--_SetItem_property = (Core.Name "property")--_SetItem_variableEqual = (Core.Name "variableEqual")--_SetItem_variablePlusEqual = (Core.Name "variablePlusEqual")--_SetItem_variableLabels = (Core.Name "variableLabels")--data PropertyEquals = -  PropertyEquals {-    propertyEqualsLhs :: PropertyExpression,-    propertyEqualsRhs :: Expression}-  deriving (Eq, Ord, Read, Show)--_PropertyEquals = (Core.Name "hydra/ext/cypher/openCypher.PropertyEquals")--_PropertyEquals_lhs = (Core.Name "lhs")--_PropertyEquals_rhs = (Core.Name "rhs")--data VariableEquals = -  VariableEquals {-    variableEqualsLhs :: Variable,-    variableEqualsRhs :: Expression}-  deriving (Eq, Ord, Read, Show)--_VariableEquals = (Core.Name "hydra/ext/cypher/openCypher.VariableEquals")--_VariableEquals_lhs = (Core.Name "lhs")--_VariableEquals_rhs = (Core.Name "rhs")--data VariablePlusEquals = -  VariablePlusEquals {-    variablePlusEqualsLhs :: Variable,-    variablePlusEqualsRhs :: Expression}-  deriving (Eq, Ord, Read, Show)--_VariablePlusEquals = (Core.Name "hydra/ext/cypher/openCypher.VariablePlusEquals")--_VariablePlusEquals_lhs = (Core.Name "lhs")--_VariablePlusEquals_rhs = (Core.Name "rhs")--data VariableAndNodeLabels = -  VariableAndNodeLabels {-    variableAndNodeLabelsVariable :: Variable,-    variableAndNodeLabelsLabels :: NodeLabels}-  deriving (Eq, Ord, Read, Show)--_VariableAndNodeLabels = (Core.Name "hydra/ext/cypher/openCypher.VariableAndNodeLabels")--_VariableAndNodeLabels_variable = (Core.Name "variable")--_VariableAndNodeLabels_labels = (Core.Name "labels")--data Delete = -  Delete {-    deleteDetach :: Bool,-    deleteExpressions :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_Delete = (Core.Name "hydra/ext/cypher/openCypher.Delete")--_Delete_detach = (Core.Name "detach")--_Delete_expressions = (Core.Name "expressions")--newtype Remove = -  Remove {-    unRemove :: [RemoveItem]}-  deriving (Eq, Ord, Read, Show)--_Remove = (Core.Name "hydra/ext/cypher/openCypher.Remove")--data RemoveItem = -  RemoveItemVariableLabels VariableAndNodeLabels |-  RemoveItemProperty PropertyExpression-  deriving (Eq, Ord, Read, Show)--_RemoveItem = (Core.Name "hydra/ext/cypher/openCypher.RemoveItem")--_RemoveItem_variableLabels = (Core.Name "variableLabels")--_RemoveItem_property = (Core.Name "property")--data InQueryCall = -  InQueryCall {-    inQueryCallCall :: ExplicitProcedureInvocation,-    inQueryCallYieldItems :: (Maybe YieldItems)}-  deriving (Eq, Ord, Read, Show)--_InQueryCall = (Core.Name "hydra/ext/cypher/openCypher.InQueryCall")--_InQueryCall_call = (Core.Name "call")--_InQueryCall_yieldItems = (Core.Name "yieldItems")--data ProcedureInvocation = -  ProcedureInvocationExplicit ExplicitProcedureInvocation |-  ProcedureInvocationImplicit ImplicitProcedureInvocation-  deriving (Eq, Ord, Read, Show)--_ProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ProcedureInvocation")--_ProcedureInvocation_explicit = (Core.Name "explicit")--_ProcedureInvocation_implicit = (Core.Name "implicit")--data StarOrYieldItems = -  StarOrYieldItemsStar  |-  StarOrYieldItemsItems YieldItems-  deriving (Eq, Ord, Read, Show)--_StarOrYieldItems = (Core.Name "hydra/ext/cypher/openCypher.StarOrYieldItems")--_StarOrYieldItems_star = (Core.Name "star")--_StarOrYieldItems_items = (Core.Name "items")--data StandaloneCall = -  StandaloneCall {-    standaloneCallCall :: ProcedureInvocation,-    standaloneCallYieldItems :: (Maybe StarOrYieldItems)}-  deriving (Eq, Ord, Read, Show)--_StandaloneCall = (Core.Name "hydra/ext/cypher/openCypher.StandaloneCall")--_StandaloneCall_call = (Core.Name "call")--_StandaloneCall_yieldItems = (Core.Name "yieldItems")--data YieldItems = -  YieldItems {-    yieldItemsItems :: [YieldItem],-    yieldItemsWhere :: (Maybe Where)}-  deriving (Eq, Ord, Read, Show)--_YieldItems = (Core.Name "hydra/ext/cypher/openCypher.YieldItems")--_YieldItems_items = (Core.Name "items")--_YieldItems_where = (Core.Name "where")--data YieldItem = -  YieldItem {-    yieldItemField :: (Maybe ProcedureResultField),-    yieldItemVariable :: Variable}-  deriving (Eq, Ord, Read, Show)--_YieldItem = (Core.Name "hydra/ext/cypher/openCypher.YieldItem")--_YieldItem_field = (Core.Name "field")--_YieldItem_variable = (Core.Name "variable")--data With = -  With {-    withProjection :: ProjectionBody,-    withWhere :: (Maybe Where)}-  deriving (Eq, Ord, Read, Show)--_With = (Core.Name "hydra/ext/cypher/openCypher.With")--_With_projection = (Core.Name "projection")--_With_where = (Core.Name "where")--newtype Return = -  Return {-    unReturn :: ProjectionBody}-  deriving (Eq, Ord, Read, Show)--_Return = (Core.Name "hydra/ext/cypher/openCypher.Return")--data ProjectionBody = -  ProjectionBody {-    projectionBodyDistinct :: Bool,-    projectionBodyProjectionItems :: ProjectionItems,-    projectionBodyOrder :: (Maybe Order),-    projectionBodySkip :: (Maybe Skip),-    projectionBodyLimit :: (Maybe Limit)}-  deriving (Eq, Ord, Read, Show)--_ProjectionBody = (Core.Name "hydra/ext/cypher/openCypher.ProjectionBody")--_ProjectionBody_distinct = (Core.Name "distinct")--_ProjectionBody_projectionItems = (Core.Name "projectionItems")--_ProjectionBody_order = (Core.Name "order")--_ProjectionBody_skip = (Core.Name "skip")--_ProjectionBody_limit = (Core.Name "limit")--data ProjectionItems = -  ProjectionItems {-    projectionItemsStar :: Bool,-    projectionItemsExplicit :: [ProjectionItem]}-  deriving (Eq, Ord, Read, Show)--_ProjectionItems = (Core.Name "hydra/ext/cypher/openCypher.ProjectionItems")--_ProjectionItems_star = (Core.Name "star")--_ProjectionItems_explicit = (Core.Name "explicit")--data ProjectionItem = -  ProjectionItem {-    projectionItemExpression :: Expression,-    projectionItemVariable :: (Maybe Variable)}-  deriving (Eq, Ord, Read, Show)--_ProjectionItem = (Core.Name "hydra/ext/cypher/openCypher.ProjectionItem")--_ProjectionItem_expression = (Core.Name "expression")--_ProjectionItem_variable = (Core.Name "variable")--newtype Order = -  Order {-    unOrder :: [SortItem]}-  deriving (Eq, Ord, Read, Show)--_Order = (Core.Name "hydra/ext/cypher/openCypher.Order")--newtype Skip = -  Skip {-    unSkip :: Expression}-  deriving (Eq, Ord, Read, Show)--_Skip = (Core.Name "hydra/ext/cypher/openCypher.Skip")--newtype Limit = -  Limit {-    unLimit :: Expression}-  deriving (Eq, Ord, Read, Show)--_Limit = (Core.Name "hydra/ext/cypher/openCypher.Limit")--data SortOrder = -  SortOrderAscending  |-  SortOrderDescending -  deriving (Eq, Ord, Read, Show)--_SortOrder = (Core.Name "hydra/ext/cypher/openCypher.SortOrder")--_SortOrder_ascending = (Core.Name "ascending")--_SortOrder_descending = (Core.Name "descending")--data SortItem = -  SortItem {-    sortItemExpression :: Expression,-    sortItemOrder :: (Maybe SortOrder)}-  deriving (Eq, Ord, Read, Show)--_SortItem = (Core.Name "hydra/ext/cypher/openCypher.SortItem")--_SortItem_expression = (Core.Name "expression")--_SortItem_order = (Core.Name "order")--newtype Where = -  Where {-    unWhere :: Expression}-  deriving (Eq, Ord, Read, Show)--_Where = (Core.Name "hydra/ext/cypher/openCypher.Where")--newtype Pattern = -  Pattern {-    unPattern :: [PatternPart]}-  deriving (Eq, Ord, Read, Show)--_Pattern = (Core.Name "hydra/ext/cypher/openCypher.Pattern")--data PatternPart = -  PatternPart {-    patternPartVariable :: (Maybe Variable),-    patternPartPattern :: AnonymousPatternPart}-  deriving (Eq, Ord, Read, Show)--_PatternPart = (Core.Name "hydra/ext/cypher/openCypher.PatternPart")--_PatternPart_variable = (Core.Name "variable")--_PatternPart_pattern = (Core.Name "pattern")--newtype AnonymousPatternPart = -  AnonymousPatternPart {-    unAnonymousPatternPart :: PatternElement}-  deriving (Eq, Ord, Read, Show)--_AnonymousPatternPart = (Core.Name "hydra/ext/cypher/openCypher.AnonymousPatternPart")--data NodePatternChain = -  NodePatternChain {-    nodePatternChainNodePattern :: NodePattern,-    nodePatternChainChain :: [PatternElementChain]}-  deriving (Eq, Ord, Read, Show)--_NodePatternChain = (Core.Name "hydra/ext/cypher/openCypher.NodePatternChain")--_NodePatternChain_nodePattern = (Core.Name "nodePattern")--_NodePatternChain_chain = (Core.Name "chain")--data PatternElement = -  PatternElementChained NodePatternChain |-  PatternElementParenthesized PatternElement-  deriving (Eq, Ord, Read, Show)--_PatternElement = (Core.Name "hydra/ext/cypher/openCypher.PatternElement")--_PatternElement_chained = (Core.Name "chained")--_PatternElement_parenthesized = (Core.Name "parenthesized")--data RelationshipsPattern = -  RelationshipsPattern {-    relationshipsPatternNodePattern :: NodePattern,-    relationshipsPatternChain :: [PatternElementChain]}-  deriving (Eq, Ord, Read, Show)--_RelationshipsPattern = (Core.Name "hydra/ext/cypher/openCypher.RelationshipsPattern")--_RelationshipsPattern_nodePattern = (Core.Name "nodePattern")--_RelationshipsPattern_chain = (Core.Name "chain")--data NodePattern = -  NodePattern {-    nodePatternVariable :: (Maybe Variable),-    nodePatternLabels :: (Maybe NodeLabels),-    nodePatternProperties :: (Maybe Properties)}-  deriving (Eq, Ord, Read, Show)--_NodePattern = (Core.Name "hydra/ext/cypher/openCypher.NodePattern")--_NodePattern_variable = (Core.Name "variable")--_NodePattern_labels = (Core.Name "labels")--_NodePattern_properties = (Core.Name "properties")--data PatternElementChain = -  PatternElementChain {-    patternElementChainRelationship :: RelationshipPattern,-    patternElementChainNode :: NodePattern}-  deriving (Eq, Ord, Read, Show)--_PatternElementChain = (Core.Name "hydra/ext/cypher/openCypher.PatternElementChain")--_PatternElementChain_relationship = (Core.Name "relationship")--_PatternElementChain_node = (Core.Name "node")--data RelationshipPattern = -  RelationshipPattern {-    relationshipPatternLeftArrow :: Bool,-    relationshipPatternDetail :: (Maybe RelationshipDetail),-    relationshipPatternRightArrow :: Bool}-  deriving (Eq, Ord, Read, Show)--_RelationshipPattern = (Core.Name "hydra/ext/cypher/openCypher.RelationshipPattern")--_RelationshipPattern_leftArrow = (Core.Name "leftArrow")--_RelationshipPattern_detail = (Core.Name "detail")--_RelationshipPattern_rightArrow = (Core.Name "rightArrow")--data RelationshipDetail = -  RelationshipDetail {-    relationshipDetailVariable :: (Maybe Variable),-    relationshipDetailTypes :: (Maybe RelationshipTypes),-    relationshipDetailRange :: (Maybe RangeLiteral),-    relationshipDetailProperties :: (Maybe Properties)}-  deriving (Eq, Ord, Read, Show)--_RelationshipDetail = (Core.Name "hydra/ext/cypher/openCypher.RelationshipDetail")--_RelationshipDetail_variable = (Core.Name "variable")--_RelationshipDetail_types = (Core.Name "types")--_RelationshipDetail_range = (Core.Name "range")--_RelationshipDetail_properties = (Core.Name "properties")--data Properties = -  PropertiesMap MapLiteral |-  PropertiesParameter Parameter-  deriving (Eq, Ord, Read, Show)--_Properties = (Core.Name "hydra/ext/cypher/openCypher.Properties")--_Properties_map = (Core.Name "map")--_Properties_parameter = (Core.Name "parameter")--newtype RelationshipTypes = -  RelationshipTypes {-    unRelationshipTypes :: [RelTypeName]}-  deriving (Eq, Ord, Read, Show)--_RelationshipTypes = (Core.Name "hydra/ext/cypher/openCypher.RelationshipTypes")--newtype NodeLabels = -  NodeLabels {-    unNodeLabels :: [NodeLabel]}-  deriving (Eq, Ord, Read, Show)--_NodeLabels = (Core.Name "hydra/ext/cypher/openCypher.NodeLabels")--newtype NodeLabel = -  NodeLabel {-    unNodeLabel :: String}-  deriving (Eq, Ord, Read, Show)--_NodeLabel = (Core.Name "hydra/ext/cypher/openCypher.NodeLabel")--data RangeLiteral = -  RangeLiteral {-    rangeLiteralStart :: (Maybe Integer),-    rangeLiteralEnd :: (Maybe Integer)}-  deriving (Eq, Ord, Read, Show)--_RangeLiteral = (Core.Name "hydra/ext/cypher/openCypher.RangeLiteral")--_RangeLiteral_start = (Core.Name "start")--_RangeLiteral_end = (Core.Name "end")--newtype RelTypeName = -  RelTypeName {-    unRelTypeName :: String}-  deriving (Eq, Ord, Read, Show)--_RelTypeName = (Core.Name "hydra/ext/cypher/openCypher.RelTypeName")--data PropertyExpression = -  PropertyExpression {-    propertyExpressionAtom :: Atom,-    propertyExpressionLookups :: [PropertyLookup]}-  deriving (Eq, Ord, Read, Show)--_PropertyExpression = (Core.Name "hydra/ext/cypher/openCypher.PropertyExpression")--_PropertyExpression_atom = (Core.Name "atom")--_PropertyExpression_lookups = (Core.Name "lookups")--newtype Expression = -  Expression {-    unExpression :: OrExpression}-  deriving (Eq, Ord, Read, Show)--_Expression = (Core.Name "hydra/ext/cypher/openCypher.Expression")--newtype OrExpression = -  OrExpression {-    unOrExpression :: [XorExpression]}-  deriving (Eq, Ord, Read, Show)--_OrExpression = (Core.Name "hydra/ext/cypher/openCypher.OrExpression")--newtype XorExpression = -  XorExpression {-    unXorExpression :: [AndExpression]}-  deriving (Eq, Ord, Read, Show)--_XorExpression = (Core.Name "hydra/ext/cypher/openCypher.XorExpression")--newtype AndExpression = -  AndExpression {-    unAndExpression :: [NotExpression]}-  deriving (Eq, Ord, Read, Show)--_AndExpression = (Core.Name "hydra/ext/cypher/openCypher.AndExpression")--data NotExpression = -  NotExpression {-    notExpressionNot :: Bool,-    notExpressionExpression :: ComparisonExpression}-  deriving (Eq, Ord, Read, Show)--_NotExpression = (Core.Name "hydra/ext/cypher/openCypher.NotExpression")--_NotExpression_not = (Core.Name "not")--_NotExpression_expression = (Core.Name "expression")--data ComparisonExpression = -  ComparisonExpression {-    comparisonExpressionLeft :: StringListNullPredicateExpression,-    comparisonExpressionRight :: [PartialComparisonExpression]}-  deriving (Eq, Ord, Read, Show)--_ComparisonExpression = (Core.Name "hydra/ext/cypher/openCypher.ComparisonExpression")--_ComparisonExpression_left = (Core.Name "left")--_ComparisonExpression_right = (Core.Name "right")--data ComparisonOperator = -  ComparisonOperatorEq  |-  ComparisonOperatorNeq  |-  ComparisonOperatorLt  |-  ComparisonOperatorGt  |-  ComparisonOperatorLte  |-  ComparisonOperatorGte -  deriving (Eq, Ord, Read, Show)--_ComparisonOperator = (Core.Name "hydra/ext/cypher/openCypher.ComparisonOperator")--_ComparisonOperator_eq = (Core.Name "eq")--_ComparisonOperator_neq = (Core.Name "neq")--_ComparisonOperator_lt = (Core.Name "lt")--_ComparisonOperator_gt = (Core.Name "gt")--_ComparisonOperator_lte = (Core.Name "lte")--_ComparisonOperator_gte = (Core.Name "gte")--data PartialComparisonExpression = -  PartialComparisonExpression {-    partialComparisonExpressionOperator :: ComparisonOperator,-    partialComparisonExpressionRight :: StringListNullPredicateExpression}-  deriving (Eq, Ord, Read, Show)--_PartialComparisonExpression = (Core.Name "hydra/ext/cypher/openCypher.PartialComparisonExpression")--_PartialComparisonExpression_operator = (Core.Name "operator")--_PartialComparisonExpression_right = (Core.Name "right")--data StringListNullPredicateExpression = -  StringListNullPredicateExpression {-    stringListNullPredicateExpressionLeft :: AddOrSubtractExpression,-    stringListNullPredicateExpressionRight :: [StringListNullPredicateRightHandSide]}-  deriving (Eq, Ord, Read, Show)--_StringListNullPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.StringListNullPredicateExpression")--_StringListNullPredicateExpression_left = (Core.Name "left")--_StringListNullPredicateExpression_right = (Core.Name "right")--data StringListNullPredicateRightHandSide = -  StringListNullPredicateRightHandSideString StringPredicateExpression |-  StringListNullPredicateRightHandSideList ListPredicateExpression |-  StringListNullPredicateRightHandSideNull NullPredicateExpression-  deriving (Eq, Ord, Read, Show)--_StringListNullPredicateRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.StringListNullPredicateRightHandSide")--_StringListNullPredicateRightHandSide_string = (Core.Name "string")--_StringListNullPredicateRightHandSide_list = (Core.Name "list")--_StringListNullPredicateRightHandSide_null = (Core.Name "null")--data StringPredicateExpression = -  StringPredicateExpression {-    stringPredicateExpressionOperator :: StringPredicateOperator,-    stringPredicateExpressionExpression :: AddOrSubtractExpression}-  deriving (Eq, Ord, Read, Show)--_StringPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.StringPredicateExpression")--_StringPredicateExpression_operator = (Core.Name "operator")--_StringPredicateExpression_expression = (Core.Name "expression")--data StringPredicateOperator = -  StringPredicateOperatorStartsWith  |-  StringPredicateOperatorEndsWith  |-  StringPredicateOperatorContains -  deriving (Eq, Ord, Read, Show)--_StringPredicateOperator = (Core.Name "hydra/ext/cypher/openCypher.StringPredicateOperator")--_StringPredicateOperator_startsWith = (Core.Name "startsWith")--_StringPredicateOperator_endsWith = (Core.Name "endsWith")--_StringPredicateOperator_contains = (Core.Name "contains")--newtype ListPredicateExpression = -  ListPredicateExpression {-    unListPredicateExpression :: AddOrSubtractExpression}-  deriving (Eq, Ord, Read, Show)--_ListPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.ListPredicateExpression")--newtype NullPredicateExpression = -  NullPredicateExpression {-    unNullPredicateExpression :: Bool}-  deriving (Eq, Ord, Read, Show)--_NullPredicateExpression = (Core.Name "hydra/ext/cypher/openCypher.NullPredicateExpression")--data AddOrSubtractExpression = -  AddOrSubtractExpression {-    addOrSubtractExpressionLeft :: MultiplyDivideModuloExpression,-    addOrSubtractExpressionRight :: [AddOrSubtractRightHandSide]}-  deriving (Eq, Ord, Read, Show)--_AddOrSubtractExpression = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractExpression")--_AddOrSubtractExpression_left = (Core.Name "left")--_AddOrSubtractExpression_right = (Core.Name "right")--data AddOrSubtractRightHandSide = -  AddOrSubtractRightHandSide {-    addOrSubtractRightHandSideOperator :: AddOrSubtractOperator,-    addOrSubtractRightHandSideExpression :: MultiplyDivideModuloExpression}-  deriving (Eq, Ord, Read, Show)--_AddOrSubtractRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractRightHandSide")--_AddOrSubtractRightHandSide_operator = (Core.Name "operator")--_AddOrSubtractRightHandSide_expression = (Core.Name "expression")--data AddOrSubtractOperator = -  AddOrSubtractOperatorAdd  |-  AddOrSubtractOperatorSubtract -  deriving (Eq, Ord, Read, Show)--_AddOrSubtractOperator = (Core.Name "hydra/ext/cypher/openCypher.AddOrSubtractOperator")--_AddOrSubtractOperator_add = (Core.Name "add")--_AddOrSubtractOperator_subtract = (Core.Name "subtract")--data MultiplyDivideModuloExpression = -  MultiplyDivideModuloExpression {-    multiplyDivideModuloExpressionLeft :: PowerOfExpression,-    multiplyDivideModuloExpressionRight :: [MultiplyDivideModuloRightHandSide]}-  deriving (Eq, Ord, Read, Show)--_MultiplyDivideModuloExpression = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloExpression")--_MultiplyDivideModuloExpression_left = (Core.Name "left")--_MultiplyDivideModuloExpression_right = (Core.Name "right")--data MultiplyDivideModuloRightHandSide = -  MultiplyDivideModuloRightHandSide {-    multiplyDivideModuloRightHandSideOperator :: MultiplyDivideModuloOperator,-    multiplyDivideModuloRightHandSideExpression :: PowerOfExpression}-  deriving (Eq, Ord, Read, Show)--_MultiplyDivideModuloRightHandSide = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloRightHandSide")--_MultiplyDivideModuloRightHandSide_operator = (Core.Name "operator")--_MultiplyDivideModuloRightHandSide_expression = (Core.Name "expression")--data MultiplyDivideModuloOperator = -  MultiplyDivideModuloOperatorMultiply  |-  MultiplyDivideModuloOperatorDivide  |-  MultiplyDivideModuloOperatorModulo -  deriving (Eq, Ord, Read, Show)--_MultiplyDivideModuloOperator = (Core.Name "hydra/ext/cypher/openCypher.MultiplyDivideModuloOperator")--_MultiplyDivideModuloOperator_multiply = (Core.Name "multiply")--_MultiplyDivideModuloOperator_divide = (Core.Name "divide")--_MultiplyDivideModuloOperator_modulo = (Core.Name "modulo")--newtype PowerOfExpression = -  PowerOfExpression {-    unPowerOfExpression :: [UnaryAddOrSubtractExpression]}-  deriving (Eq, Ord, Read, Show)--_PowerOfExpression = (Core.Name "hydra/ext/cypher/openCypher.PowerOfExpression")--data UnaryAddOrSubtractExpression = -  UnaryAddOrSubtractExpression {-    unaryAddOrSubtractExpressionOperator :: (Maybe AddOrSubtractOperator),-    unaryAddOrSubtractExpressionExpression :: NonArithmeticOperatorExpression}-  deriving (Eq, Ord, Read, Show)--_UnaryAddOrSubtractExpression = (Core.Name "hydra/ext/cypher/openCypher.UnaryAddOrSubtractExpression")--_UnaryAddOrSubtractExpression_operator = (Core.Name "operator")--_UnaryAddOrSubtractExpression_expression = (Core.Name "expression")--data ListOperatorExpressionOrPropertyLookup = -  ListOperatorExpressionOrPropertyLookupList ListOperatorExpression |-  ListOperatorExpressionOrPropertyLookupProperty PropertyLookup-  deriving (Eq, Ord, Read, Show)--_ListOperatorExpressionOrPropertyLookup = (Core.Name "hydra/ext/cypher/openCypher.ListOperatorExpressionOrPropertyLookup")--_ListOperatorExpressionOrPropertyLookup_list = (Core.Name "list")--_ListOperatorExpressionOrPropertyLookup_property = (Core.Name "property")--data NonArithmeticOperatorExpression = -  NonArithmeticOperatorExpression {-    nonArithmeticOperatorExpressionAtom :: Atom,-    nonArithmeticOperatorExpressionListsAndLookups :: [ListOperatorExpressionOrPropertyLookup],-    nonArithmeticOperatorExpressionLabels :: (Maybe NodeLabels)}-  deriving (Eq, Ord, Read, Show)--_NonArithmeticOperatorExpression = (Core.Name "hydra/ext/cypher/openCypher.NonArithmeticOperatorExpression")--_NonArithmeticOperatorExpression_atom = (Core.Name "atom")--_NonArithmeticOperatorExpression_listsAndLookups = (Core.Name "listsAndLookups")--_NonArithmeticOperatorExpression_labels = (Core.Name "labels")--data RangeExpression = -  RangeExpression {-    rangeExpressionStart :: (Maybe Expression),-    rangeExpressionEnd :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_RangeExpression = (Core.Name "hydra/ext/cypher/openCypher.RangeExpression")--_RangeExpression_start = (Core.Name "start")--_RangeExpression_end = (Core.Name "end")--data ListOperatorExpression = -  ListOperatorExpressionSingle Expression |-  ListOperatorExpressionRange RangeExpression-  deriving (Eq, Ord, Read, Show)--_ListOperatorExpression = (Core.Name "hydra/ext/cypher/openCypher.ListOperatorExpression")--_ListOperatorExpression_single = (Core.Name "single")--_ListOperatorExpression_range = (Core.Name "range")--newtype PropertyLookup = -  PropertyLookup {-    unPropertyLookup :: PropertyKeyName}-  deriving (Eq, Ord, Read, Show)--_PropertyLookup = (Core.Name "hydra/ext/cypher/openCypher.PropertyLookup")--data Atom = -  AtomLiteral Literal |-  AtomParameter Parameter |-  AtomCase CaseExpression |-  AtomCountStar  |-  AtomListComprehension ListComprehension |-  AtomPatternComprehension PatternComprehension |-  AtomQuantifier Quantifier |-  AtomPatternPredicate PatternPredicate |-  AtomParenthesized ParenthesizedExpression |-  AtomFunctionInvocation FunctionInvocation |-  AtomExistentialSubquery ExistentialSubquery |-  AtomVariable Variable-  deriving (Eq, Ord, Read, Show)--_Atom = (Core.Name "hydra/ext/cypher/openCypher.Atom")--_Atom_literal = (Core.Name "literal")--_Atom_parameter = (Core.Name "parameter")--_Atom_case = (Core.Name "case")--_Atom_countStar = (Core.Name "countStar")--_Atom_listComprehension = (Core.Name "listComprehension")--_Atom_patternComprehension = (Core.Name "patternComprehension")--_Atom_quantifier = (Core.Name "quantifier")--_Atom_patternPredicate = (Core.Name "patternPredicate")--_Atom_parenthesized = (Core.Name "parenthesized")--_Atom_functionInvocation = (Core.Name "functionInvocation")--_Atom_existentialSubquery = (Core.Name "existentialSubquery")--_Atom_variable = (Core.Name "variable")--data CaseExpression = -  CaseExpression {-    caseExpressionExpression :: (Maybe Expression),-    caseExpressionAlternatives :: [CaseAlternative],-    caseExpressionElse :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_CaseExpression = (Core.Name "hydra/ext/cypher/openCypher.CaseExpression")--_CaseExpression_expression = (Core.Name "expression")--_CaseExpression_alternatives = (Core.Name "alternatives")--_CaseExpression_else = (Core.Name "else")--data CaseAlternative = -  CaseAlternative {-    caseAlternativeCondition :: Expression,-    caseAlternativeResult :: Expression}-  deriving (Eq, Ord, Read, Show)--_CaseAlternative = (Core.Name "hydra/ext/cypher/openCypher.CaseAlternative")--_CaseAlternative_condition = (Core.Name "condition")--_CaseAlternative_result = (Core.Name "result")--data ListComprehension = -  ListComprehension {-    listComprehensionLeft :: FilterExpression,-    listComprehensionRight :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_ListComprehension = (Core.Name "hydra/ext/cypher/openCypher.ListComprehension")--_ListComprehension_left = (Core.Name "left")--_ListComprehension_right = (Core.Name "right")--data PatternComprehension = -  PatternComprehension {-    patternComprehensionVariable :: (Maybe Variable),-    patternComprehensionPattern :: RelationshipsPattern,-    patternComprehensionWhere :: (Maybe Where),-    patternComprehensionRight :: Expression}-  deriving (Eq, Ord, Read, Show)--_PatternComprehension = (Core.Name "hydra/ext/cypher/openCypher.PatternComprehension")--_PatternComprehension_variable = (Core.Name "variable")--_PatternComprehension_pattern = (Core.Name "pattern")--_PatternComprehension_where = (Core.Name "where")--_PatternComprehension_right = (Core.Name "right")--data Quantifier = -  Quantifier {-    quantifierOperator :: QuantifierOperator,-    quantifierExpression :: FilterExpression}-  deriving (Eq, Ord, Read, Show)--_Quantifier = (Core.Name "hydra/ext/cypher/openCypher.Quantifier")--_Quantifier_operator = (Core.Name "operator")--_Quantifier_expression = (Core.Name "expression")--data QuantifierOperator = -  QuantifierOperatorAll  |-  QuantifierOperatorAny  |-  QuantifierOperatorNone  |-  QuantifierOperatorSingle -  deriving (Eq, Ord, Read, Show)--_QuantifierOperator = (Core.Name "hydra/ext/cypher/openCypher.QuantifierOperator")--_QuantifierOperator_all = (Core.Name "all")--_QuantifierOperator_any = (Core.Name "any")--_QuantifierOperator_none = (Core.Name "none")--_QuantifierOperator_single = (Core.Name "single")--data FilterExpression = -  FilterExpression {-    filterExpressionIdInColl :: IdInColl,-    filterExpressionWhere :: (Maybe Where)}-  deriving (Eq, Ord, Read, Show)--_FilterExpression = (Core.Name "hydra/ext/cypher/openCypher.FilterExpression")--_FilterExpression_idInColl = (Core.Name "idInColl")--_FilterExpression_where = (Core.Name "where")--newtype PatternPredicate = -  PatternPredicate {-    unPatternPredicate :: RelationshipsPattern}-  deriving (Eq, Ord, Read, Show)--_PatternPredicate = (Core.Name "hydra/ext/cypher/openCypher.PatternPredicate")--newtype ParenthesizedExpression = -  ParenthesizedExpression {-    unParenthesizedExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_ParenthesizedExpression = (Core.Name "hydra/ext/cypher/openCypher.ParenthesizedExpression")--data IdInColl = -  IdInColl {-    idInCollVariable :: Variable,-    idInCollExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_IdInColl = (Core.Name "hydra/ext/cypher/openCypher.IdInColl")--_IdInColl_variable = (Core.Name "variable")--_IdInColl_expression = (Core.Name "expression")--data FunctionInvocation = -  FunctionInvocation {-    functionInvocationName :: QualifiedName,-    functionInvocationDistinct :: Bool,-    functionInvocationArguments :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_FunctionInvocation = (Core.Name "hydra/ext/cypher/openCypher.FunctionInvocation")--_FunctionInvocation_name = (Core.Name "name")--_FunctionInvocation_distinct = (Core.Name "distinct")--_FunctionInvocation_arguments = (Core.Name "arguments")--data QualifiedName = -  QualifiedName {-    qualifiedNameNamespace :: String,-    qualifiedNameLocal :: String}-  deriving (Eq, Ord, Read, Show)--_QualifiedName = (Core.Name "hydra/ext/cypher/openCypher.QualifiedName")--_QualifiedName_namespace = (Core.Name "namespace")--_QualifiedName_local = (Core.Name "local")--data PatternWhere = -  PatternWhere {-    patternWherePattern :: Pattern,-    patternWhereWhere :: (Maybe Where)}-  deriving (Eq, Ord, Read, Show)--_PatternWhere = (Core.Name "hydra/ext/cypher/openCypher.PatternWhere")--_PatternWhere_pattern = (Core.Name "pattern")--_PatternWhere_where = (Core.Name "where")--data ExistentialSubquery = -  ExistentialSubqueryRegular RegularQuery |-  ExistentialSubqueryPattern PatternWhere-  deriving (Eq, Ord, Read, Show)--_ExistentialSubquery = (Core.Name "hydra/ext/cypher/openCypher.ExistentialSubquery")--_ExistentialSubquery_regular = (Core.Name "regular")--_ExistentialSubquery_pattern = (Core.Name "pattern")--data ExplicitProcedureInvocation = -  ExplicitProcedureInvocation {-    explicitProcedureInvocationName :: QualifiedName,-    explicitProcedureInvocationArguments :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_ExplicitProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ExplicitProcedureInvocation")--_ExplicitProcedureInvocation_name = (Core.Name "name")--_ExplicitProcedureInvocation_arguments = (Core.Name "arguments")--newtype ImplicitProcedureInvocation = -  ImplicitProcedureInvocation {-    unImplicitProcedureInvocation :: QualifiedName}-  deriving (Eq, Ord, Read, Show)--_ImplicitProcedureInvocation = (Core.Name "hydra/ext/cypher/openCypher.ImplicitProcedureInvocation")--newtype ProcedureResultField = -  ProcedureResultField {-    unProcedureResultField :: String}-  deriving (Eq, Ord, Read, Show)--_ProcedureResultField = (Core.Name "hydra/ext/cypher/openCypher.ProcedureResultField")--newtype Variable = -  Variable {-    unVariable :: String}-  deriving (Eq, Ord, Read, Show)--_Variable = (Core.Name "hydra/ext/cypher/openCypher.Variable")--data Literal = -  LiteralBoolean Bool |-  LiteralNull  |-  LiteralNumber NumberLiteral |-  LiteralString StringLiteral |-  LiteralList ListLiteral |-  LiteralMap MapLiteral-  deriving (Eq, Ord, Read, Show)--_Literal = (Core.Name "hydra/ext/cypher/openCypher.Literal")--_Literal_boolean = (Core.Name "boolean")--_Literal_null = (Core.Name "null")--_Literal_number = (Core.Name "number")--_Literal_string = (Core.Name "string")--_Literal_list = (Core.Name "list")--_Literal_map = (Core.Name "map")--data NumberLiteral = -  NumberLiteralDouble Double |-  NumberLiteralInteger Integer-  deriving (Eq, Ord, Read, Show)--_NumberLiteral = (Core.Name "hydra/ext/cypher/openCypher.NumberLiteral")--_NumberLiteral_double = (Core.Name "double")--_NumberLiteral_integer = (Core.Name "integer")--newtype StringLiteral = -  StringLiteral {-    unStringLiteral :: String}-  deriving (Eq, Ord, Read, Show)--_StringLiteral = (Core.Name "hydra/ext/cypher/openCypher.StringLiteral")--newtype ListLiteral = -  ListLiteral {-    unListLiteral :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_ListLiteral = (Core.Name "hydra/ext/cypher/openCypher.ListLiteral")--newtype MapLiteral = -  MapLiteral {-    unMapLiteral :: [KeyValuePair]}-  deriving (Eq, Ord, Read, Show)--_MapLiteral = (Core.Name "hydra/ext/cypher/openCypher.MapLiteral")--data KeyValuePair = -  KeyValuePair {-    keyValuePairKey :: PropertyKeyName,-    keyValuePairValue :: Expression}-  deriving (Eq, Ord, Read, Show)--_KeyValuePair = (Core.Name "hydra/ext/cypher/openCypher.KeyValuePair")--_KeyValuePair_key = (Core.Name "key")--_KeyValuePair_value = (Core.Name "value")--newtype PropertyKeyName = -  PropertyKeyName {-    unPropertyKeyName :: String}-  deriving (Eq, Ord, Read, Show)--_PropertyKeyName = (Core.Name "hydra/ext/cypher/openCypher.PropertyKeyName")--data Parameter = -  ParameterSymbolic String |-  ParameterInteger Integer-  deriving (Eq, Ord, Read, Show)--_Parameter = (Core.Name "hydra/ext/cypher/openCypher.Parameter")--_Parameter_symbolic = (Core.Name "symbolic")--_Parameter_integer = (Core.Name "integer")
src/gen-main/haskell/Hydra/Ext/Haskell/Ast.hs view
@@ -3,10 +3,11 @@ module Hydra.Ext.Haskell.Ast where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A pattern-matching alternative data Alternative = @@ -16,7 +17,7 @@     alternativeBinds :: (Maybe LocalBindings)}   deriving (Eq, Ord, Read, Show) -_Alternative = (Core.Name "hydra/ext/haskell/ast.Alternative")+_Alternative = (Core.Name "hydra.ext.haskell.ast.Alternative")  _Alternative_pattern = (Core.Name "pattern") @@ -26,27 +27,27 @@  -- | A type assertion data Assertion = -  AssertionClass Assertion_Class |+  AssertionClass ClassAssertion |   AssertionTuple [Assertion]   deriving (Eq, Ord, Read, Show) -_Assertion = (Core.Name "hydra/ext/haskell/ast.Assertion")+_Assertion = (Core.Name "hydra.ext.haskell.ast.Assertion")  _Assertion_class = (Core.Name "class")  _Assertion_tuple = (Core.Name "tuple") -data Assertion_Class = -  Assertion_Class {-    assertion_ClassName :: Name,-    assertion_ClassTypes :: [Type]}+data ClassAssertion = +  ClassAssertion {+    classAssertionName :: Name,+    classAssertionTypes :: [Type]}   deriving (Eq, Ord, Read, Show) -_Assertion_Class = (Core.Name "hydra/ext/haskell/ast.Assertion.Class")+_ClassAssertion = (Core.Name "hydra.ext.haskell.ast.ClassAssertion") -_Assertion_Class_name = (Core.Name "name")+_ClassAssertion_name = (Core.Name "name") -_Assertion_Class_types = (Core.Name "types")+_ClassAssertion_types = (Core.Name "types")  -- | The right-hand side of a pattern-matching alternative newtype CaseRhs = @@ -54,45 +55,45 @@     unCaseRhs :: Expression}   deriving (Eq, Ord, Read, Show) -_CaseRhs = (Core.Name "hydra/ext/haskell/ast.CaseRhs")+_CaseRhs = (Core.Name "hydra.ext.haskell.ast.CaseRhs")  -- | A data constructor data Constructor = -  ConstructorOrdinary Constructor_Ordinary |-  ConstructorRecord Constructor_Record+  ConstructorOrdinary OrdinaryConstructor |+  ConstructorRecord RecordConstructor   deriving (Eq, Ord, Read, Show) -_Constructor = (Core.Name "hydra/ext/haskell/ast.Constructor")+_Constructor = (Core.Name "hydra.ext.haskell.ast.Constructor")  _Constructor_ordinary = (Core.Name "ordinary")  _Constructor_record = (Core.Name "record")  -- | An ordinary (positional) data constructor-data Constructor_Ordinary = -  Constructor_Ordinary {-    constructor_OrdinaryName :: Name,-    constructor_OrdinaryFields :: [Type]}+data OrdinaryConstructor = +  OrdinaryConstructor {+    ordinaryConstructorName :: Name,+    ordinaryConstructorFields :: [Type]}   deriving (Eq, Ord, Read, Show) -_Constructor_Ordinary = (Core.Name "hydra/ext/haskell/ast.Constructor.Ordinary")+_OrdinaryConstructor = (Core.Name "hydra.ext.haskell.ast.OrdinaryConstructor") -_Constructor_Ordinary_name = (Core.Name "name")+_OrdinaryConstructor_name = (Core.Name "name") -_Constructor_Ordinary_fields = (Core.Name "fields")+_OrdinaryConstructor_fields = (Core.Name "fields")  -- | A record-style data constructor-data Constructor_Record = -  Constructor_Record {-    constructor_RecordName :: Name,-    constructor_RecordFields :: [FieldWithComments]}+data RecordConstructor = +  RecordConstructor {+    recordConstructorName :: Name,+    recordConstructorFields :: [FieldWithComments]}   deriving (Eq, Ord, Read, Show) -_Constructor_Record = (Core.Name "hydra/ext/haskell/ast.Constructor.Record")+_RecordConstructor = (Core.Name "hydra.ext.haskell.ast.RecordConstructor") -_Constructor_Record_name = (Core.Name "name")+_RecordConstructor_name = (Core.Name "name") -_Constructor_Record_fields = (Core.Name "fields")+_RecordConstructor_fields = (Core.Name "fields")  -- | A data constructor together with any comments data ConstructorWithComments = @@ -101,7 +102,7 @@     constructorWithCommentsComments :: (Maybe String)}   deriving (Eq, Ord, Read, Show) -_ConstructorWithComments = (Core.Name "hydra/ext/haskell/ast.ConstructorWithComments")+_ConstructorWithComments = (Core.Name "hydra.ext.haskell.ast.ConstructorWithComments")  _ConstructorWithComments_body = (Core.Name "body") @@ -110,14 +111,14 @@ -- | A data type declaration data DataDeclaration =    DataDeclaration {-    dataDeclarationKeyword :: DataDeclaration_Keyword,+    dataDeclarationKeyword :: DataOrNewtype,     dataDeclarationContext :: [Assertion],     dataDeclarationHead :: DeclarationHead,     dataDeclarationConstructors :: [ConstructorWithComments],     dataDeclarationDeriving :: [Deriving]}   deriving (Eq, Ord, Read, Show) -_DataDeclaration = (Core.Name "hydra/ext/haskell/ast.DataDeclaration")+_DataDeclaration = (Core.Name "hydra.ext.haskell.ast.DataDeclaration")  _DataDeclaration_keyword = (Core.Name "keyword") @@ -130,16 +131,16 @@ _DataDeclaration_deriving = (Core.Name "deriving")  -- | The 'data' versus 'newtype keyword-data DataDeclaration_Keyword = -  DataDeclaration_KeywordData  |-  DataDeclaration_KeywordNewtype +data DataOrNewtype = +  DataOrNewtypeData  |+  DataOrNewtypeNewtype    deriving (Eq, Ord, Read, Show) -_DataDeclaration_Keyword = (Core.Name "hydra/ext/haskell/ast.DataDeclaration.Keyword")+_DataOrNewtype = (Core.Name "hydra.ext.haskell.ast.DataOrNewtype") -_DataDeclaration_Keyword_data = (Core.Name "data")+_DataOrNewtype_data = (Core.Name "data") -_DataDeclaration_Keyword_newtype = (Core.Name "newtype")+_DataOrNewtype_newtype = (Core.Name "newtype")  -- | A data declaration together with any comments data DeclarationWithComments = @@ -148,7 +149,7 @@     declarationWithCommentsComments :: (Maybe String)}   deriving (Eq, Ord, Read, Show) -_DeclarationWithComments = (Core.Name "hydra/ext/haskell/ast.DeclarationWithComments")+_DeclarationWithComments = (Core.Name "hydra.ext.haskell.ast.DeclarationWithComments")  _DeclarationWithComments_body = (Core.Name "body") @@ -162,7 +163,7 @@   DeclarationTypedBinding TypedBinding   deriving (Eq, Ord, Read, Show) -_Declaration = (Core.Name "hydra/ext/haskell/ast.Declaration")+_Declaration = (Core.Name "hydra.ext.haskell.ast.Declaration")  _Declaration_data = (Core.Name "data") @@ -174,12 +175,12 @@  -- | The left-hand side of a declaration data DeclarationHead = -  DeclarationHeadApplication DeclarationHead_Application |+  DeclarationHeadApplication ApplicationDeclarationHead |   DeclarationHeadParens DeclarationHead |   DeclarationHeadSimple Name   deriving (Eq, Ord, Read, Show) -_DeclarationHead = (Core.Name "hydra/ext/haskell/ast.DeclarationHead")+_DeclarationHead = (Core.Name "hydra.ext.haskell.ast.DeclarationHead")  _DeclarationHead_application = (Core.Name "application") @@ -188,17 +189,17 @@ _DeclarationHead_simple = (Core.Name "simple")  -- | An application-style declaration head-data DeclarationHead_Application = -  DeclarationHead_Application {-    declarationHead_ApplicationFunction :: DeclarationHead,-    declarationHead_ApplicationOperand :: Variable}+data ApplicationDeclarationHead = +  ApplicationDeclarationHead {+    applicationDeclarationHeadFunction :: DeclarationHead,+    applicationDeclarationHeadOperand :: Variable}   deriving (Eq, Ord, Read, Show) -_DeclarationHead_Application = (Core.Name "hydra/ext/haskell/ast.DeclarationHead.Application")+_ApplicationDeclarationHead = (Core.Name "hydra.ext.haskell.ast.ApplicationDeclarationHead") -_DeclarationHead_Application_function = (Core.Name "function")+_ApplicationDeclarationHead_function = (Core.Name "function") -_DeclarationHead_Application_operand = (Core.Name "operand")+_ApplicationDeclarationHead_operand = (Core.Name "operand")  -- | A 'deriving' statement newtype Deriving = @@ -206,7 +207,7 @@     unDeriving :: [Name]}   deriving (Eq, Ord, Read, Show) -_Deriving = (Core.Name "hydra/ext/haskell/ast.Deriving")+_Deriving = (Core.Name "hydra.ext.haskell.ast.Deriving")  -- | An export statement data Export = @@ -214,7 +215,7 @@   ExportModule ModuleName   deriving (Eq, Ord, Read, Show) -_Export = (Core.Name "hydra/ext/haskell/ast.Export")+_Export = (Core.Name "hydra.ext.haskell.ast.Export")  _Export_declaration = (Core.Name "declaration") @@ -222,27 +223,27 @@  -- | A data expression data Expression = -  ExpressionApplication Expression_Application |-  ExpressionCase Expression_Case |-  ExpressionConstructRecord Expression_ConstructRecord |+  ExpressionApplication ApplicationExpression |+  ExpressionCase CaseExpression |+  ExpressionConstructRecord ConstructRecordExpression |   ExpressionDo [Statement] |-  ExpressionIf Expression_If |-  ExpressionInfixApplication Expression_InfixApplication |+  ExpressionIf IfExpression |+  ExpressionInfixApplication InfixApplicationExpression |   ExpressionLiteral Literal |-  ExpressionLambda Expression_Lambda |-  ExpressionLeftSection Expression_Section |-  ExpressionLet Expression_Let |+  ExpressionLambda LambdaExpression |+  ExpressionLeftSection SectionExpression |+  ExpressionLet LetExpression |   ExpressionList [Expression] |   ExpressionParens Expression |-  ExpressionPrefixApplication Expression_PrefixApplication |-  ExpressionRightSection Expression_Section |+  ExpressionPrefixApplication PrefixApplicationExpression |+  ExpressionRightSection SectionExpression |   ExpressionTuple [Expression] |-  ExpressionTypeSignature Expression_TypeSignature |-  ExpressionUpdateRecord Expression_UpdateRecord |+  ExpressionTypeSignature TypeSignatureExpression |+  ExpressionUpdateRecord UpdateRecordExpression |   ExpressionVariable Name   deriving (Eq, Ord, Read, Show) -_Expression = (Core.Name "hydra/ext/haskell/ast.Expression")+_Expression = (Core.Name "hydra.ext.haskell.ast.Expression")  _Expression_application = (Core.Name "application") @@ -281,153 +282,153 @@ _Expression_variable = (Core.Name "variable")  -- | An application expression-data Expression_Application = -  Expression_Application {-    expression_ApplicationFunction :: Expression,-    expression_ApplicationArgument :: Expression}+data ApplicationExpression = +  ApplicationExpression {+    applicationExpressionFunction :: Expression,+    applicationExpressionArgument :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_Application = (Core.Name "hydra/ext/haskell/ast.Expression.Application")+_ApplicationExpression = (Core.Name "hydra.ext.haskell.ast.ApplicationExpression") -_Expression_Application_function = (Core.Name "function")+_ApplicationExpression_function = (Core.Name "function") -_Expression_Application_argument = (Core.Name "argument")+_ApplicationExpression_argument = (Core.Name "argument")  -- | A case expression-data Expression_Case = -  Expression_Case {-    expression_CaseCase :: Expression,-    expression_CaseAlternatives :: [Alternative]}+data CaseExpression = +  CaseExpression {+    caseExpressionCase :: Expression,+    caseExpressionAlternatives :: [Alternative]}   deriving (Eq, Ord, Read, Show) -_Expression_Case = (Core.Name "hydra/ext/haskell/ast.Expression.Case")+_CaseExpression = (Core.Name "hydra.ext.haskell.ast.CaseExpression") -_Expression_Case_case = (Core.Name "case")+_CaseExpression_case = (Core.Name "case") -_Expression_Case_alternatives = (Core.Name "alternatives")+_CaseExpression_alternatives = (Core.Name "alternatives")  -- | A record constructor expression-data Expression_ConstructRecord = -  Expression_ConstructRecord {-    expression_ConstructRecordName :: Name,-    expression_ConstructRecordFields :: [FieldUpdate]}+data ConstructRecordExpression = +  ConstructRecordExpression {+    constructRecordExpressionName :: Name,+    constructRecordExpressionFields :: [FieldUpdate]}   deriving (Eq, Ord, Read, Show) -_Expression_ConstructRecord = (Core.Name "hydra/ext/haskell/ast.Expression.ConstructRecord")+_ConstructRecordExpression = (Core.Name "hydra.ext.haskell.ast.ConstructRecordExpression") -_Expression_ConstructRecord_name = (Core.Name "name")+_ConstructRecordExpression_name = (Core.Name "name") -_Expression_ConstructRecord_fields = (Core.Name "fields")+_ConstructRecordExpression_fields = (Core.Name "fields")  -- | An 'if' expression-data Expression_If = -  Expression_If {-    expression_IfCondition :: Expression,-    expression_IfThen :: Expression,-    expression_IfElse :: Expression}+data IfExpression = +  IfExpression {+    ifExpressionCondition :: Expression,+    ifExpressionThen :: Expression,+    ifExpressionElse :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_If = (Core.Name "hydra/ext/haskell/ast.Expression.If")+_IfExpression = (Core.Name "hydra.ext.haskell.ast.IfExpression") -_Expression_If_condition = (Core.Name "condition")+_IfExpression_condition = (Core.Name "condition") -_Expression_If_then = (Core.Name "then")+_IfExpression_then = (Core.Name "then") -_Expression_If_else = (Core.Name "else")+_IfExpression_else = (Core.Name "else")  -- | An infix application expression-data Expression_InfixApplication = -  Expression_InfixApplication {-    expression_InfixApplicationLhs :: Expression,-    expression_InfixApplicationOperator :: Operator,-    expression_InfixApplicationRhs :: Expression}+data InfixApplicationExpression = +  InfixApplicationExpression {+    infixApplicationExpressionLhs :: Expression,+    infixApplicationExpressionOperator :: Operator,+    infixApplicationExpressionRhs :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_InfixApplication = (Core.Name "hydra/ext/haskell/ast.Expression.InfixApplication")+_InfixApplicationExpression = (Core.Name "hydra.ext.haskell.ast.InfixApplicationExpression") -_Expression_InfixApplication_lhs = (Core.Name "lhs")+_InfixApplicationExpression_lhs = (Core.Name "lhs") -_Expression_InfixApplication_operator = (Core.Name "operator")+_InfixApplicationExpression_operator = (Core.Name "operator") -_Expression_InfixApplication_rhs = (Core.Name "rhs")+_InfixApplicationExpression_rhs = (Core.Name "rhs")  -- | A lambda expression-data Expression_Lambda = -  Expression_Lambda {-    expression_LambdaBindings :: [Pattern],-    expression_LambdaInner :: Expression}+data LambdaExpression = +  LambdaExpression {+    lambdaExpressionBindings :: [Pattern],+    lambdaExpressionInner :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_Lambda = (Core.Name "hydra/ext/haskell/ast.Expression.Lambda")+_LambdaExpression = (Core.Name "hydra.ext.haskell.ast.LambdaExpression") -_Expression_Lambda_bindings = (Core.Name "bindings")+_LambdaExpression_bindings = (Core.Name "bindings") -_Expression_Lambda_inner = (Core.Name "inner")+_LambdaExpression_inner = (Core.Name "inner")  -- | A 'let' expression-data Expression_Let = -  Expression_Let {-    expression_LetBindings :: [LocalBinding],-    expression_LetInner :: Expression}+data LetExpression = +  LetExpression {+    letExpressionBindings :: [LocalBinding],+    letExpressionInner :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_Let = (Core.Name "hydra/ext/haskell/ast.Expression.Let")+_LetExpression = (Core.Name "hydra.ext.haskell.ast.LetExpression") -_Expression_Let_bindings = (Core.Name "bindings")+_LetExpression_bindings = (Core.Name "bindings") -_Expression_Let_inner = (Core.Name "inner")+_LetExpression_inner = (Core.Name "inner")  -- | A prefix expression-data Expression_PrefixApplication = -  Expression_PrefixApplication {-    expression_PrefixApplicationOperator :: Operator,-    expression_PrefixApplicationRhs :: Expression}+data PrefixApplicationExpression = +  PrefixApplicationExpression {+    prefixApplicationExpressionOperator :: Operator,+    prefixApplicationExpressionRhs :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_PrefixApplication = (Core.Name "hydra/ext/haskell/ast.Expression.PrefixApplication")+_PrefixApplicationExpression = (Core.Name "hydra.ext.haskell.ast.PrefixApplicationExpression") -_Expression_PrefixApplication_operator = (Core.Name "operator")+_PrefixApplicationExpression_operator = (Core.Name "operator") -_Expression_PrefixApplication_rhs = (Core.Name "rhs")+_PrefixApplicationExpression_rhs = (Core.Name "rhs")  -- | A section expression-data Expression_Section = -  Expression_Section {-    expression_SectionOperator :: Operator,-    expression_SectionExpression :: Expression}+data SectionExpression = +  SectionExpression {+    sectionExpressionOperator :: Operator,+    sectionExpressionExpression :: Expression}   deriving (Eq, Ord, Read, Show) -_Expression_Section = (Core.Name "hydra/ext/haskell/ast.Expression.Section")+_SectionExpression = (Core.Name "hydra.ext.haskell.ast.SectionExpression") -_Expression_Section_operator = (Core.Name "operator")+_SectionExpression_operator = (Core.Name "operator") -_Expression_Section_expression = (Core.Name "expression")+_SectionExpression_expression = (Core.Name "expression")  -- | A type signature expression-data Expression_TypeSignature = -  Expression_TypeSignature {-    expression_TypeSignatureInner :: Expression,-    expression_TypeSignatureType :: Type}+data TypeSignatureExpression = +  TypeSignatureExpression {+    typeSignatureExpressionInner :: Expression,+    typeSignatureExpressionType :: Type}   deriving (Eq, Ord, Read, Show) -_Expression_TypeSignature = (Core.Name "hydra/ext/haskell/ast.Expression.TypeSignature")+_TypeSignatureExpression = (Core.Name "hydra.ext.haskell.ast.TypeSignatureExpression") -_Expression_TypeSignature_inner = (Core.Name "inner")+_TypeSignatureExpression_inner = (Core.Name "inner") -_Expression_TypeSignature_type = (Core.Name "type")+_TypeSignatureExpression_type = (Core.Name "type")  -- | An update record expression-data Expression_UpdateRecord = -  Expression_UpdateRecord {-    expression_UpdateRecordInner :: Expression,-    expression_UpdateRecordFields :: [FieldUpdate]}+data UpdateRecordExpression = +  UpdateRecordExpression {+    updateRecordExpressionInner :: Expression,+    updateRecordExpressionFields :: [FieldUpdate]}   deriving (Eq, Ord, Read, Show) -_Expression_UpdateRecord = (Core.Name "hydra/ext/haskell/ast.Expression.UpdateRecord")+_UpdateRecordExpression = (Core.Name "hydra.ext.haskell.ast.UpdateRecordExpression") -_Expression_UpdateRecord_inner = (Core.Name "inner")+_UpdateRecordExpression_inner = (Core.Name "inner") -_Expression_UpdateRecord_fields = (Core.Name "fields")+_UpdateRecordExpression_fields = (Core.Name "fields")  -- | A field (name/type pair) data Field = @@ -436,7 +437,7 @@     fieldType :: Type}   deriving (Eq, Ord, Read, Show) -_Field = (Core.Name "hydra/ext/haskell/ast.Field")+_Field = (Core.Name "hydra.ext.haskell.ast.Field")  _Field_name = (Core.Name "name") @@ -449,7 +450,7 @@     fieldWithCommentsComments :: (Maybe String)}   deriving (Eq, Ord, Read, Show) -_FieldWithComments = (Core.Name "hydra/ext/haskell/ast.FieldWithComments")+_FieldWithComments = (Core.Name "hydra.ext.haskell.ast.FieldWithComments")  _FieldWithComments_field = (Core.Name "field") @@ -462,7 +463,7 @@     fieldUpdateValue :: Expression}   deriving (Eq, Ord, Read, Show) -_FieldUpdate = (Core.Name "hydra/ext/haskell/ast.FieldUpdate")+_FieldUpdate = (Core.Name "hydra.ext.haskell.ast.FieldUpdate")  _FieldUpdate_name = (Core.Name "name") @@ -474,10 +475,10 @@     importQualified :: Bool,     importModule :: ModuleName,     importAs :: (Maybe ModuleName),-    importSpec :: (Maybe Import_Spec)}+    importSpec :: (Maybe SpecImport)}   deriving (Eq, Ord, Read, Show) -_Import = (Core.Name "hydra/ext/haskell/ast.Import")+_Import = (Core.Name "hydra.ext.haskell.ast.Import")  _Import_qualified = (Core.Name "qualified") @@ -488,16 +489,16 @@ _Import_spec = (Core.Name "spec")  -- | An import specification-data Import_Spec = -  Import_SpecList [ImportExportSpec] |-  Import_SpecHiding [ImportExportSpec]+data SpecImport = +  SpecImportList [ImportExportSpec] |+  SpecImportHiding [ImportExportSpec]   deriving (Eq, Ord, Read, Show) -_Import_Spec = (Core.Name "hydra/ext/haskell/ast.Import.Spec")+_SpecImport = (Core.Name "hydra.ext.haskell.ast.SpecImport") -_Import_Spec_list = (Core.Name "list")+_SpecImport_list = (Core.Name "list") -_Import_Spec_hiding = (Core.Name "hiding")+_SpecImport_hiding = (Core.Name "hiding")  -- | An import modifier ('pattern' or 'type') data ImportModifier = @@ -505,7 +506,7 @@   ImportModifierType    deriving (Eq, Ord, Read, Show) -_ImportModifier = (Core.Name "hydra/ext/haskell/ast.ImportModifier")+_ImportModifier = (Core.Name "hydra.ext.haskell.ast.ImportModifier")  _ImportModifier_pattern = (Core.Name "pattern") @@ -516,10 +517,10 @@   ImportExportSpec {     importExportSpecModifier :: (Maybe ImportModifier),     importExportSpecName :: Name,-    importExportSpecSubspec :: (Maybe ImportExportSpec_Subspec)}+    importExportSpecSubspec :: (Maybe SubspecImportExportSpec)}   deriving (Eq, Ord, Read, Show) -_ImportExportSpec = (Core.Name "hydra/ext/haskell/ast.ImportExportSpec")+_ImportExportSpec = (Core.Name "hydra.ext.haskell.ast.ImportExportSpec")  _ImportExportSpec_modifier = (Core.Name "modifier") @@ -527,16 +528,16 @@  _ImportExportSpec_subspec = (Core.Name "subspec") -data ImportExportSpec_Subspec = -  ImportExportSpec_SubspecAll  |-  ImportExportSpec_SubspecList [Name]+data SubspecImportExportSpec = +  SubspecImportExportSpecAll  |+  SubspecImportExportSpecList [Name]   deriving (Eq, Ord, Read, Show) -_ImportExportSpec_Subspec = (Core.Name "hydra/ext/haskell/ast.ImportExportSpec.Subspec")+_SubspecImportExportSpec = (Core.Name "hydra.ext.haskell.ast.SubspecImportExportSpec") -_ImportExportSpec_Subspec_all = (Core.Name "all")+_SubspecImportExportSpec_all = (Core.Name "all") -_ImportExportSpec_Subspec_list = (Core.Name "list")+_SubspecImportExportSpec_list = (Core.Name "list")  -- | A literal value data Literal = @@ -548,7 +549,7 @@   LiteralString String   deriving (Eq, Ord, Read, Show) -_Literal = (Core.Name "hydra/ext/haskell/ast.Literal")+_Literal = (Core.Name "hydra.ext.haskell.ast.Literal")  _Literal_char = (Core.Name "char") @@ -567,7 +568,7 @@   LocalBindingValue ValueBinding   deriving (Eq, Ord, Read, Show) -_LocalBinding = (Core.Name "hydra/ext/haskell/ast.LocalBinding")+_LocalBinding = (Core.Name "hydra.ext.haskell.ast.LocalBinding")  _LocalBinding_signature = (Core.Name "signature") @@ -578,7 +579,7 @@     unLocalBindings :: [LocalBinding]}   deriving (Eq, Ord, Read, Show) -_LocalBindings = (Core.Name "hydra/ext/haskell/ast.LocalBindings")+_LocalBindings = (Core.Name "hydra.ext.haskell.ast.LocalBindings")  data Module =    Module {@@ -587,7 +588,7 @@     moduleDeclarations :: [DeclarationWithComments]}   deriving (Eq, Ord, Read, Show) -_Module = (Core.Name "hydra/ext/haskell/ast.Module")+_Module = (Core.Name "hydra.ext.haskell.ast.Module")  _Module_head = (Core.Name "head") @@ -602,7 +603,7 @@     moduleHeadExports :: [Export]}   deriving (Eq, Ord, Read, Show) -_ModuleHead = (Core.Name "hydra/ext/haskell/ast.ModuleHead")+_ModuleHead = (Core.Name "hydra.ext.haskell.ast.ModuleHead")  _ModuleHead_comments = (Core.Name "comments") @@ -615,7 +616,7 @@     unModuleName :: String}   deriving (Eq, Ord, Read, Show) -_ModuleName = (Core.Name "hydra/ext/haskell/ast.ModuleName")+_ModuleName = (Core.Name "hydra.ext.haskell.ast.ModuleName")  data Name =    NameImplicit QualifiedName |@@ -623,7 +624,7 @@   NameParens QualifiedName   deriving (Eq, Ord, Read, Show) -_Name = (Core.Name "hydra/ext/haskell/ast.Name")+_Name = (Core.Name "hydra.ext.haskell.ast.Name")  _Name_implicit = (Core.Name "implicit") @@ -636,33 +637,33 @@     unNamePart :: String}   deriving (Eq, Ord, Read, Show) -_NamePart = (Core.Name "hydra/ext/haskell/ast.NamePart")+_NamePart = (Core.Name "hydra.ext.haskell.ast.NamePart")  data Operator =    OperatorBacktick QualifiedName |   OperatorNormal QualifiedName   deriving (Eq, Ord, Read, Show) -_Operator = (Core.Name "hydra/ext/haskell/ast.Operator")+_Operator = (Core.Name "hydra.ext.haskell.ast.Operator")  _Operator_backtick = (Core.Name "backtick")  _Operator_normal = (Core.Name "normal")  data Pattern = -  PatternApplication Pattern_Application |-  PatternAs Pattern_As |+  PatternApplication ApplicationPattern |+  PatternAs AsPattern |   PatternList [Pattern] |   PatternLiteral Literal |   PatternName Name |   PatternParens Pattern |-  PatternRecord Pattern_Record |+  PatternRecord RecordPattern |   PatternTuple [Pattern] |-  PatternTyped Pattern_Typed |+  PatternTyped TypedPattern |   PatternWildcard    deriving (Eq, Ord, Read, Show) -_Pattern = (Core.Name "hydra/ext/haskell/ast.Pattern")+_Pattern = (Core.Name "hydra.ext.haskell.ast.Pattern")  _Pattern_application = (Core.Name "application") @@ -684,53 +685,53 @@  _Pattern_wildcard = (Core.Name "wildcard") -data Pattern_Application = -  Pattern_Application {-    pattern_ApplicationName :: Name,-    pattern_ApplicationArgs :: [Pattern]}+data ApplicationPattern = +  ApplicationPattern {+    applicationPatternName :: Name,+    applicationPatternArgs :: [Pattern]}   deriving (Eq, Ord, Read, Show) -_Pattern_Application = (Core.Name "hydra/ext/haskell/ast.Pattern.Application")+_ApplicationPattern = (Core.Name "hydra.ext.haskell.ast.ApplicationPattern") -_Pattern_Application_name = (Core.Name "name")+_ApplicationPattern_name = (Core.Name "name") -_Pattern_Application_args = (Core.Name "args")+_ApplicationPattern_args = (Core.Name "args") -data Pattern_As = -  Pattern_As {-    pattern_AsName :: Name,-    pattern_AsInner :: Pattern}+data AsPattern = +  AsPattern {+    asPatternName :: Name,+    asPatternInner :: Pattern}   deriving (Eq, Ord, Read, Show) -_Pattern_As = (Core.Name "hydra/ext/haskell/ast.Pattern.As")+_AsPattern = (Core.Name "hydra.ext.haskell.ast.AsPattern") -_Pattern_As_name = (Core.Name "name")+_AsPattern_name = (Core.Name "name") -_Pattern_As_inner = (Core.Name "inner")+_AsPattern_inner = (Core.Name "inner") -data Pattern_Record = -  Pattern_Record {-    pattern_RecordName :: Name,-    pattern_RecordFields :: [PatternField]}+data RecordPattern = +  RecordPattern {+    recordPatternName :: Name,+    recordPatternFields :: [PatternField]}   deriving (Eq, Ord, Read, Show) -_Pattern_Record = (Core.Name "hydra/ext/haskell/ast.Pattern.Record")+_RecordPattern = (Core.Name "hydra.ext.haskell.ast.RecordPattern") -_Pattern_Record_name = (Core.Name "name")+_RecordPattern_name = (Core.Name "name") -_Pattern_Record_fields = (Core.Name "fields")+_RecordPattern_fields = (Core.Name "fields") -data Pattern_Typed = -  Pattern_Typed {-    pattern_TypedInner :: Pattern,-    pattern_TypedType :: Type}+data TypedPattern = +  TypedPattern {+    typedPatternInner :: Pattern,+    typedPatternType :: Type}   deriving (Eq, Ord, Read, Show) -_Pattern_Typed = (Core.Name "hydra/ext/haskell/ast.Pattern.Typed")+_TypedPattern = (Core.Name "hydra.ext.haskell.ast.TypedPattern") -_Pattern_Typed_inner = (Core.Name "inner")+_TypedPattern_inner = (Core.Name "inner") -_Pattern_Typed_type = (Core.Name "type")+_TypedPattern_type = (Core.Name "type")  data PatternField =    PatternField {@@ -738,7 +739,7 @@     patternFieldPattern :: Pattern}   deriving (Eq, Ord, Read, Show) -_PatternField = (Core.Name "hydra/ext/haskell/ast.PatternField")+_PatternField = (Core.Name "hydra.ext.haskell.ast.PatternField")  _PatternField_name = (Core.Name "name") @@ -750,7 +751,7 @@     qualifiedNameUnqualified :: NamePart}   deriving (Eq, Ord, Read, Show) -_QualifiedName = (Core.Name "hydra/ext/haskell/ast.QualifiedName")+_QualifiedName = (Core.Name "hydra.ext.haskell.ast.QualifiedName")  _QualifiedName_qualifiers = (Core.Name "qualifiers") @@ -761,27 +762,27 @@     unRightHandSide :: Expression}   deriving (Eq, Ord, Read, Show) -_RightHandSide = (Core.Name "hydra/ext/haskell/ast.RightHandSide")+_RightHandSide = (Core.Name "hydra.ext.haskell.ast.RightHandSide")  newtype Statement =    Statement {     unStatement :: Expression}   deriving (Eq, Ord, Read, Show) -_Statement = (Core.Name "hydra/ext/haskell/ast.Statement")+_Statement = (Core.Name "hydra.ext.haskell.ast.Statement")  data Type = -  TypeApplication Type_Application |-  TypeCtx Type_Context |-  TypeFunction Type_Function |-  TypeInfix Type_Infix |+  TypeApplication ApplicationType |+  TypeCtx ContextType |+  TypeFunction FunctionType |+  TypeInfix InfixType |   TypeList Type |   TypeParens Type |   TypeTuple [Type] |   TypeVariable Name   deriving (Eq, Ord, Read, Show) -_Type = (Core.Name "hydra/ext/haskell/ast.Type")+_Type = (Core.Name "hydra.ext.haskell.ast.Type")  _Type_application = (Core.Name "application") @@ -799,56 +800,56 @@  _Type_variable = (Core.Name "variable") -data Type_Application = -  Type_Application {-    type_ApplicationContext :: Type,-    type_ApplicationArgument :: Type}+data ApplicationType = +  ApplicationType {+    applicationTypeContext :: Type,+    applicationTypeArgument :: Type}   deriving (Eq, Ord, Read, Show) -_Type_Application = (Core.Name "hydra/ext/haskell/ast.Type.Application")+_ApplicationType = (Core.Name "hydra.ext.haskell.ast.ApplicationType") -_Type_Application_context = (Core.Name "context")+_ApplicationType_context = (Core.Name "context") -_Type_Application_argument = (Core.Name "argument")+_ApplicationType_argument = (Core.Name "argument") -data Type_Context = -  Type_Context {-    type_ContextCtx :: Assertion,-    type_ContextType :: Type}+data ContextType = +  ContextType {+    contextTypeCtx :: Assertion,+    contextTypeType :: Type}   deriving (Eq, Ord, Read, Show) -_Type_Context = (Core.Name "hydra/ext/haskell/ast.Type.Context")+_ContextType = (Core.Name "hydra.ext.haskell.ast.ContextType") -_Type_Context_ctx = (Core.Name "ctx")+_ContextType_ctx = (Core.Name "ctx") -_Type_Context_type = (Core.Name "type")+_ContextType_type = (Core.Name "type") -data Type_Function = -  Type_Function {-    type_FunctionDomain :: Type,-    type_FunctionCodomain :: Type}+data FunctionType = +  FunctionType {+    functionTypeDomain :: Type,+    functionTypeCodomain :: Type}   deriving (Eq, Ord, Read, Show) -_Type_Function = (Core.Name "hydra/ext/haskell/ast.Type.Function")+_FunctionType = (Core.Name "hydra.ext.haskell.ast.FunctionType") -_Type_Function_domain = (Core.Name "domain")+_FunctionType_domain = (Core.Name "domain") -_Type_Function_codomain = (Core.Name "codomain")+_FunctionType_codomain = (Core.Name "codomain") -data Type_Infix = -  Type_Infix {-    type_InfixLhs :: Type,-    type_InfixOperator :: Operator,-    type_InfixRhs :: Operator}+data InfixType = +  InfixType {+    infixTypeLhs :: Type,+    infixTypeOperator :: Operator,+    infixTypeRhs :: Operator}   deriving (Eq, Ord, Read, Show) -_Type_Infix = (Core.Name "hydra/ext/haskell/ast.Type.Infix")+_InfixType = (Core.Name "hydra.ext.haskell.ast.InfixType") -_Type_Infix_lhs = (Core.Name "lhs")+_InfixType_lhs = (Core.Name "lhs") -_Type_Infix_operator = (Core.Name "operator")+_InfixType_operator = (Core.Name "operator") -_Type_Infix_rhs = (Core.Name "rhs")+_InfixType_rhs = (Core.Name "rhs")  data TypeDeclaration =    TypeDeclaration {@@ -856,7 +857,7 @@     typeDeclarationType :: Type}   deriving (Eq, Ord, Read, Show) -_TypeDeclaration = (Core.Name "hydra/ext/haskell/ast.TypeDeclaration")+_TypeDeclaration = (Core.Name "hydra.ext.haskell.ast.TypeDeclaration")  _TypeDeclaration_name = (Core.Name "name") @@ -868,7 +869,7 @@     typeSignatureType :: Type}   deriving (Eq, Ord, Read, Show) -_TypeSignature = (Core.Name "hydra/ext/haskell/ast.TypeSignature")+_TypeSignature = (Core.Name "hydra.ext.haskell.ast.TypeSignature")  _TypeSignature_name = (Core.Name "name") @@ -880,38 +881,38 @@     typedBindingValueBinding :: ValueBinding}   deriving (Eq, Ord, Read, Show) -_TypedBinding = (Core.Name "hydra/ext/haskell/ast.TypedBinding")+_TypedBinding = (Core.Name "hydra.ext.haskell.ast.TypedBinding")  _TypedBinding_typeSignature = (Core.Name "typeSignature")  _TypedBinding_valueBinding = (Core.Name "valueBinding")  data ValueBinding = -  ValueBindingSimple ValueBinding_Simple+  ValueBindingSimple SimpleValueBinding   deriving (Eq, Ord, Read, Show) -_ValueBinding = (Core.Name "hydra/ext/haskell/ast.ValueBinding")+_ValueBinding = (Core.Name "hydra.ext.haskell.ast.ValueBinding")  _ValueBinding_simple = (Core.Name "simple") -data ValueBinding_Simple = -  ValueBinding_Simple {-    valueBinding_SimplePattern :: Pattern,-    valueBinding_SimpleRhs :: RightHandSide,-    valueBinding_SimpleLocalBindings :: (Maybe LocalBindings)}+data SimpleValueBinding = +  SimpleValueBinding {+    simpleValueBindingPattern :: Pattern,+    simpleValueBindingRhs :: RightHandSide,+    simpleValueBindingLocalBindings :: (Maybe LocalBindings)}   deriving (Eq, Ord, Read, Show) -_ValueBinding_Simple = (Core.Name "hydra/ext/haskell/ast.ValueBinding.Simple")+_SimpleValueBinding = (Core.Name "hydra.ext.haskell.ast.SimpleValueBinding") -_ValueBinding_Simple_pattern = (Core.Name "pattern")+_SimpleValueBinding_pattern = (Core.Name "pattern") -_ValueBinding_Simple_rhs = (Core.Name "rhs")+_SimpleValueBinding_rhs = (Core.Name "rhs") -_ValueBinding_Simple_localBindings = (Core.Name "localBindings")+_SimpleValueBinding_localBindings = (Core.Name "localBindings")  newtype Variable =    Variable {     unVariable :: Name}   deriving (Eq, Ord, Read, Show) -_Variable = (Core.Name "hydra/ext/haskell/ast.Variable")+_Variable = (Core.Name "hydra.ext.haskell.ast.Variable")
+ src/gen-main/haskell/Hydra/Ext/Haskell/Coder.hs view
@@ -0,0 +1,631 @@+-- | Functions for encoding Hydra modules as Haskell modules++module Hydra.Ext.Haskell.Coder where++import qualified Hydra.Adapt.Modules as Modules+import qualified Hydra.Annotations as Annotations+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.Decode.Core as Core_+import qualified Hydra.Decoding as Decoding+import qualified Hydra.Encode.Core as Core__+import qualified Hydra.Ext.Haskell.Ast as Ast+import qualified Hydra.Ext.Haskell.Language as Language+import qualified Hydra.Ext.Haskell.Serde as Serde+import qualified Hydra.Ext.Haskell.Utils as Utils+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Monads as Monads+import qualified Hydra.Names as Names+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import qualified Hydra.Serialization as Serialization+import qualified Hydra.Show.Core as Core___+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++includeTypeDefinitions :: Bool+includeTypeDefinitions = False++useCoreImport :: Bool+useCoreImport = True++keyHaskellVar :: Core.Name+keyHaskellVar = (Core.Name "haskellVar")++adaptTypeToHaskellAndEncode :: (Module.Namespaces Ast.ModuleName -> Core.Type -> Compute.Flow Graph.Graph Ast.Type)+adaptTypeToHaskellAndEncode namespaces = (Modules.adaptTypeToLanguageAndEncode Language.haskellLanguage (encodeType namespaces))++constantForFieldName :: (Core.Name -> Core.Name -> String)+constantForFieldName tname fname = (Strings.cat [+  "_",+  Names.localNameOf tname,+  "_",+  (Core.unName fname)])++constantForTypeName :: (Core.Name -> String)+constantForTypeName tname = (Strings.cat2 "_" (Names.localNameOf tname))++constructModule :: (Module.Namespaces Ast.ModuleName -> Module.Module -> M.Map Core.Type (Compute.Coder Graph.Graph t0 Core.Term Ast.Expression) -> [(Core.Binding, Core.TypedTerm)] -> Compute.Flow Graph.Graph Ast.Module)+constructModule namespaces mod coders pairs =  +  let h = (\namespace -> Module.unNamespace namespace) +      createDeclarations = (\g -> \pair ->  +              let el = (fst pair) +                  tt = (snd pair)+                  term = (Core.typedTermTerm tt)+                  typ = (Core.typedTermType tt)+              in (Logic.ifElse (Annotations.isNativeType el) (toTypeDeclarations namespaces el term) (Flows.bind (toDataDeclaration coders namespaces pair) (\d -> Flows.pure [+                d]))))+      importName = (\name -> Ast.ModuleName (Strings.intercalate "." (Lists.map Formatting.capitalize (Strings.splitOn "." name))))+      imports = (Lists.concat2 domainImports standardImports)+      domainImports =  +              let toImport = (\pair ->  +                      let namespace = (fst pair) +                          alias = (snd pair)+                          name = (h namespace)+                      in Ast.Import {+                        Ast.importQualified = True,+                        Ast.importModule = (importName name),+                        Ast.importAs = (Just alias),+                        Ast.importSpec = Nothing})+              in (Lists.map toImport (Maps.toList (Module.namespacesMapping namespaces)))+      standardImports =  +              let toImport = (\triple ->  +                      let name = (fst (fst triple)) +                          malias = (snd (fst triple))+                          hidden = (snd triple)+                          spec = (Logic.ifElse (Lists.null hidden) Nothing (Just (Ast.SpecImportHiding (Lists.map (\n -> Ast.ImportExportSpec {+                                  Ast.importExportSpecModifier = Nothing,+                                  Ast.importExportSpecName = (Utils.simpleName n),+                                  Ast.importExportSpecSubspec = Nothing}) hidden))))+                      in Ast.Import {+                        Ast.importQualified = (Optionals.isJust malias),+                        Ast.importModule = (Ast.ModuleName name),+                        Ast.importAs = (Optionals.map (\x -> Ast.ModuleName x) malias),+                        Ast.importSpec = spec})+              in (Lists.map toImport [+                (("Prelude", Nothing), [+                  "Enum",+                  "Ordering",+                  "fail",+                  "map",+                  "pure",+                  "sum"]),+                (("Data.Int", (Just "I")), []),+                (("Data.List", (Just "L")), []),+                (("Data.Map", (Just "M")), []),+                (("Data.Set", (Just "S")), [])])+  in (Flows.bind Monads.getState (\g -> Flows.bind (Flows.mapList (createDeclarations g) pairs) (\declLists ->  +    let decls = (Lists.concat declLists) +        mc = (Module.moduleDescription mod)+    in (Flows.pure (Ast.Module {+      Ast.moduleHead = (Just (Ast.ModuleHead {+        Ast.moduleHeadComments = mc,+        Ast.moduleHeadName = (importName (h (Module.moduleNamespace mod))),+        Ast.moduleHeadExports = []})),+      Ast.moduleImports = imports,+      Ast.moduleDeclarations = decls})))))++encodeFunction :: (Module.Namespaces Ast.ModuleName -> Core.Function -> Compute.Flow Graph.Graph Ast.Expression)+encodeFunction namespaces fun = ((\x -> case x of+  Core.FunctionElimination v1 -> ((\x -> case x of+    Core.EliminationWrap v2 -> (Flows.pure (Ast.ExpressionVariable (Utils.elementReference namespaces (Names.qname (Optionals.fromJust (Names.namespaceOf v2)) (Utils.newtypeAccessorName v2)))))+    Core.EliminationProduct v2 ->  +      let arity = (Core.tupleProjectionArity v2) +          idx = (Core.tupleProjectionIndex v2)+      in (Logic.ifElse (Equality.equal arity 2) (Flows.pure (Utils.hsvar (Logic.ifElse (Equality.equal idx 0) "fst" "snd"))) (Flows.fail "Eliminations for tuples of arity > 2 are not supported yet in the Haskell coder"))+    Core.EliminationRecord v2 ->  +      let dn = (Core.projectionTypeName v2) +          fname = (Core.projectionField v2)+      in (Flows.pure (Ast.ExpressionVariable (Utils.recordFieldReference namespaces dn fname)))+    Core.EliminationUnion v2 ->  +      let dn = (Core.caseStatementTypeName v2) +          def = (Core.caseStatementDefault v2)+          fields = (Core.caseStatementCases v2)+          caseExpr = (Flows.bind (Lexical.withSchemaContext (Schemas.requireUnionType dn)) (\rt ->  +                  let fieldMap = (Maps.fromList (Lists.map toFieldMapEntry (Core.rowTypeFields rt))) +                      toFieldMapEntry = (\f -> (Core.fieldTypeName f, f))+                  in (Flows.bind (Flows.mapList (toAlt fieldMap) fields) (\ecases -> Flows.bind (Optionals.cases def (Flows.pure []) (\d -> Flows.bind (Flows.map (\x -> Ast.CaseRhs x) (encodeTerm namespaces d)) (\cs ->  +                    let lhs = (Ast.PatternName (Utils.rawName Constants.ignoredVariable)) +                        alt = Ast.Alternative {+                                Ast.alternativePattern = lhs,+                                Ast.alternativeRhs = cs,+                                Ast.alternativeBinds = Nothing}+                    in (Flows.pure [+                      alt])))) (\dcases -> Flows.pure (Ast.ExpressionCase (Ast.CaseExpression {+                    Ast.caseExpressionCase = (Utils.hsvar "x"),+                    Ast.caseExpressionAlternatives = (Lists.concat2 ecases dcases)})))))))+          toAlt = (\fieldMap -> \field ->  +                  let fn = (Core.fieldName field) +                      fun_ = (Core.fieldTerm field)+                  in (Annotations.withDepth keyHaskellVar (\depth ->  +                    let v0 = (Strings.cat2 "v" (Literals.showInt32 depth)) +                        raw = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = fun_,+                                Core.applicationArgument = (Core.TermVariable (Core.Name v0))}))+                        rhsTerm = (Rewriting.simplifyTerm raw)+                        v1 = (Logic.ifElse (Rewriting.isFreeVariableInTerm (Core.Name v0) rhsTerm) Constants.ignoredVariable v0)+                        hname = (Utils.unionFieldReference namespaces dn fn)+                    in (Flows.bind (Optionals.cases (Maps.lookup fn fieldMap) (Flows.fail (Strings.cat [+                      "field ",+                      Literals.showString (Core.unName fn),+                      " not found in ",+                      (Literals.showString (Core.unName dn))])) (\fieldType ->  +                      let ft = (Core.fieldTypeType fieldType) +                          noArgs = (Flows.pure [])+                          singleArg = (Flows.pure [+                                  Ast.PatternName (Utils.rawName v1)])+                      in ((\x -> case x of+                        Core.TypeUnit -> noArgs+                        _ -> singleArg) (Rewriting.deannotateType ft)))) (\args ->  +                      let lhs = (Utils.applicationPattern hname args)+                      in (Flows.bind (Flows.map (\x -> Ast.CaseRhs x) (encodeTerm namespaces rhsTerm)) (\rhs -> Flows.pure (Ast.Alternative {+                        Ast.alternativePattern = lhs,+                        Ast.alternativeRhs = rhs,+                        Ast.alternativeBinds = Nothing}))))))))+      in (Flows.map (Utils.hslambda (Utils.rawName "x")) caseExpr)) v1)+  Core.FunctionLambda v1 ->  +    let v = (Core.lambdaParameter v1) +        body = (Core.lambdaBody v1)+    in (Flows.bind (encodeTerm namespaces body) (\hbody -> Flows.pure (Utils.hslambda (Utils.elementReference namespaces v) hbody)))+  Core.FunctionPrimitive v1 -> (Flows.pure (Ast.ExpressionVariable (Utils.elementReference namespaces v1)))) fun)++encodeLiteral :: (Core.Literal -> Compute.Flow t0 Ast.Expression)+encodeLiteral l = ((\x -> case x of+  Core.LiteralBoolean v1 -> (Flows.pure (Utils.hsvar (Logic.ifElse v1 "True" "False")))+  Core.LiteralFloat v1 -> ((\x -> case x of+    Core.FloatValueFloat32 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralFloat v2)))+    Core.FloatValueFloat64 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralDouble v2)))+    Core.FloatValueBigfloat v2 -> (Flows.pure (Utils.hslit (Ast.LiteralDouble (Literals.bigfloatToFloat64 v2))))) v1)+  Core.LiteralInteger v1 -> ((\x -> case x of+    Core.IntegerValueBigint v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger v2)))+    Core.IntegerValueInt8 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.int8ToBigint v2))))+    Core.IntegerValueInt16 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.int16ToBigint v2))))+    Core.IntegerValueInt32 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInt v2)))+    Core.IntegerValueInt64 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.int64ToBigint v2))))+    Core.IntegerValueUint8 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.uint8ToBigint v2))))+    Core.IntegerValueUint16 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.uint16ToBigint v2))))+    Core.IntegerValueUint32 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.uint32ToBigint v2))))+    Core.IntegerValueUint64 v2 -> (Flows.pure (Utils.hslit (Ast.LiteralInteger (Literals.uint64ToBigint v2))))) v1)+  Core.LiteralString v1 -> (Flows.pure (Utils.hslit (Ast.LiteralString v1)))+  _ -> (Flows.fail (Strings.cat2 "literal value " (Core___.literal l)))) l)++encodeTerm :: (Module.Namespaces Ast.ModuleName -> Core.Term -> Compute.Flow Graph.Graph Ast.Expression)+encodeTerm namespaces term =  +  let encode = (encodeTerm namespaces)+  in ((\x -> case x of+    Core.TermApplication v1 ->  +      let fun = (Core.applicationFunction v1) +          arg = (Core.applicationArgument v1)+      in (Flows.bind (encode fun) (\hfun -> Flows.bind (encode arg) (\harg -> Flows.pure (Utils.hsapp hfun harg))))+    Core.TermFunction v1 -> (encodeFunction namespaces v1)+    Core.TermLet v1 ->  +      let bindings = (Core.letBindings v1) +          env = (Core.letEnvironment v1)+          encodeBinding = (\binding ->  +                  let name = (Core.bindingName binding) +                      term_ = (Core.bindingTerm binding)+                      hname = (Utils.simpleName (Core.unName name))+                  in (Flows.bind (encode term_) (\hexpr -> Flows.pure (Ast.LocalBindingValue (Utils.simpleValueBinding hname hexpr Nothing)))))+      in (Flows.bind (Flows.mapList encodeBinding bindings) (\hbindings -> Flows.bind (encode env) (\hinner -> Flows.pure (Ast.ExpressionLet (Ast.LetExpression {+        Ast.letExpressionBindings = hbindings,+        Ast.letExpressionInner = hinner})))))+    Core.TermList v1 -> (Flows.bind (Flows.mapList encode v1) (\helems -> Flows.pure (Ast.ExpressionList helems)))+    Core.TermLiteral v1 -> (encodeLiteral v1)+    Core.TermMap v1 ->  +      let lhs = (Utils.hsvar "M.fromList") +          encodePair = (\pair ->  +                  let k = (fst pair) +                      v = (snd pair)+                      hk = (encode k)+                      hv = (encode v)+                  in (Flows.map (\x -> Ast.ExpressionTuple x) (Flows.sequence [+                    hk,+                    hv])))+      in (Flows.bind (Flows.map (\x -> Ast.ExpressionList x) (Flows.mapList encodePair (Maps.toList v1))) (\rhs -> Flows.pure (Utils.hsapp lhs rhs)))+    Core.TermOptional v1 -> (Optionals.cases v1 (Flows.pure (Utils.hsvar "Nothing")) (\t -> Flows.bind (encode t) (\ht -> Flows.pure (Utils.hsapp (Utils.hsvar "Just") ht))))+    Core.TermProduct v1 -> (Flows.bind (Flows.mapList encode v1) (\hterms -> Flows.pure (Ast.ExpressionTuple hterms)))+    Core.TermRecord v1 ->  +      let sname = (Core.recordTypeName v1) +          fields = (Core.recordFields v1)+          toFieldUpdate = (\field ->  +                  let fn = (Core.fieldName field) +                      ft = (Core.fieldTerm field)+                      fieldRef = (Utils.recordFieldReference namespaces sname fn)+                  in (Flows.bind (encode ft) (\hft -> Flows.pure (Ast.FieldUpdate {+                    Ast.fieldUpdateName = fieldRef,+                    Ast.fieldUpdateValue = hft}))))+          typeName = (Utils.elementReference namespaces sname)+      in (Flows.bind (Flows.mapList toFieldUpdate fields) (\updates -> Flows.pure (Ast.ExpressionConstructRecord (Ast.ConstructRecordExpression {+        Ast.constructRecordExpressionName = typeName,+        Ast.constructRecordExpressionFields = updates}))))+    Core.TermSet v1 ->  +      let lhs = (Utils.hsvar "S.fromList")+      in (Flows.bind (encodeTerm namespaces (Core.TermList (Sets.toList v1))) (\rhs -> Flows.pure (Utils.hsapp lhs rhs)))+    Core.TermTypeLambda v1 ->  +      let term1 = (Core.typeLambdaBody v1)+      in (encode term1)+    Core.TermTypeApplication v1 ->  +      let term1 = (Core.typedTermTerm v1)+      in (encode term1)+    Core.TermUnion v1 ->  +      let sname = (Core.injectionTypeName v1) +          field = (Core.injectionField v1)+          fn = (Core.fieldName field)+          ft = (Core.fieldTerm field)+          lhs = (Ast.ExpressionVariable (Utils.unionFieldReference namespaces sname fn))+          dflt = (Flows.map (Utils.hsapp lhs) (encode ft))+      in ((\x -> case x of+        Core.TermUnit -> (Flows.pure lhs)+        _ -> dflt) (Rewriting.deannotateTerm ft))+    Core.TermUnit -> (Flows.pure (Ast.ExpressionTuple []))+    Core.TermVariable v1 -> (Flows.pure (Ast.ExpressionVariable (Utils.elementReference namespaces v1)))+    Core.TermWrap v1 ->  +      let tname = (Core.wrappedTermTypeName v1) +          term_ = (Core.wrappedTermObject v1)+          lhs = (Ast.ExpressionVariable (Utils.elementReference namespaces tname))+      in (Flows.bind (encode term_) (\rhs -> Flows.pure (Utils.hsapp lhs rhs)))+    _ -> (Flows.fail (Strings.cat2 "unexpected term: " (Core___.term term)))) (Rewriting.deannotateTerm term))++encodeType :: (Module.Namespaces Ast.ModuleName -> Core.Type -> Compute.Flow t0 Ast.Type)+encodeType namespaces typ =  +  let encode = (encodeType namespaces) +      ref = (\name -> Flows.pure (Ast.TypeVariable (Utils.elementReference namespaces name)))+      unitTuple = (Ast.TypeTuple [])+  in (Monads.withTrace "encode type" ((\x -> case x of+    Core.TypeApplication v1 ->  +      let lhs = (Core.applicationTypeFunction v1) +          rhs = (Core.applicationTypeArgument v1)+      in (Flows.bind (encode lhs) (\hlhs -> Flows.bind (encode rhs) (\hrhs -> Flows.pure (Utils.toTypeApplication [+        hlhs,+        hrhs]))))+    Core.TypeFunction v1 ->  +      let dom = (Core.functionTypeDomain v1) +          cod = (Core.functionTypeCodomain v1)+      in (Flows.bind (encode dom) (\hdom -> Flows.bind (encode cod) (\hcod -> Flows.pure (Ast.TypeFunction (Ast.FunctionType {+        Ast.functionTypeDomain = hdom,+        Ast.functionTypeCodomain = hcod})))))+    Core.TypeForall v1 ->  +      let v = (Core.forallTypeParameter v1) +          body = (Core.forallTypeBody v1)+      in (encode body)+    Core.TypeList v1 -> (Flows.bind (encode v1) (\hlt -> Flows.pure (Ast.TypeList hlt)))+    Core.TypeLiteral v1 -> ((\x -> case x of+      Core.LiteralTypeBoolean -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Bool")))+      Core.LiteralTypeFloat v2 -> ((\x -> case x of+        Core.FloatTypeFloat32 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Float")))+        Core.FloatTypeFloat64 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Double")))+        Core.FloatTypeBigfloat -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Double")))) v2)+      Core.LiteralTypeInteger v2 -> ((\x -> case x of+        Core.IntegerTypeBigint -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Integer")))+        Core.IntegerTypeInt8 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "I.Int8")))+        Core.IntegerTypeInt16 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "I.Int16")))+        Core.IntegerTypeInt32 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "Int")))+        Core.IntegerTypeInt64 -> (Flows.pure (Ast.TypeVariable (Utils.rawName "I.Int64")))+        _ -> (Flows.fail (Strings.cat2 "unexpected integer type: " (Core___.integerType v2)))) v2)+      Core.LiteralTypeString -> (Flows.pure (Ast.TypeVariable (Utils.rawName "String")))+      _ -> (Flows.fail (Strings.cat2 "unexpected literal type: " (Core___.literalType v1)))) v1)+    Core.TypeMap v1 ->  +      let kt = (Core.mapTypeKeys v1) +          vt = (Core.mapTypeValues v1)+      in (Flows.map Utils.toTypeApplication (Flows.sequence [+        Flows.pure (Ast.TypeVariable (Utils.rawName "M.Map")),+        encode kt,+        (encode vt)]))+    Core.TypeOptional v1 -> (Flows.map Utils.toTypeApplication (Flows.sequence [+      Flows.pure (Ast.TypeVariable (Utils.rawName "Maybe")),+      (encode v1)]))+    Core.TypeProduct v1 -> (Flows.bind (Flows.mapList encode v1) (\htypes -> Flows.pure (Ast.TypeTuple htypes)))+    Core.TypeRecord v1 -> (ref (Core.rowTypeTypeName v1))+    Core.TypeSet v1 -> (Flows.map Utils.toTypeApplication (Flows.sequence [+      Flows.pure (Ast.TypeVariable (Utils.rawName "S.Set")),+      (encode v1)]))+    Core.TypeUnion v1 ->  +      let typeName = (Core.rowTypeTypeName v1)+      in (ref typeName)+    Core.TypeUnit -> (Flows.pure unitTuple)+    Core.TypeVariable v1 -> (ref v1)+    Core.TypeWrap v1 ->  +      let name = (Core.wrappedTypeTypeName v1)+      in (ref name)+    _ -> (Flows.fail (Strings.cat2 "unexpected type: " (Core___.type_ typ)))) (Rewriting.deannotateType typ)))++encodeTypeWithClassAssertions :: (Module.Namespaces Ast.ModuleName -> M.Map Core.Name (S.Set Mantle.TypeClass) -> Core.Type -> Compute.Flow Graph.Graph Ast.Type)+encodeTypeWithClassAssertions namespaces explicitClasses typ =  +  let classes = (Maps.union explicitClasses (getImplicitTypeClasses typ)) +      implicitClasses = (getImplicitTypeClasses typ)+      encodeAssertion = (\pair ->  +              let name = (fst pair) +                  cls = (snd pair)+                  hname = (Utils.rawName ((\x -> case x of+                          Mantle.TypeClassEquality -> "Eq"+                          Mantle.TypeClassOrdering -> "Ord") cls))+                  htype = (Ast.TypeVariable (Utils.rawName (Core.unName name)))+              in (Ast.AssertionClass (Ast.ClassAssertion {+                Ast.classAssertionName = hname,+                Ast.classAssertionTypes = [+                  htype]})))+      assertPairs = (Lists.concat (Lists.map toPairs (Maps.toList classes)))+      toPairs = (\mapEntry ->  +              let name = (fst mapEntry) +                  clsSet = (snd mapEntry)+                  toPair = (\c -> (name, c))+              in (Lists.map toPair (Sets.toList clsSet)))+  in (Monads.withTrace "encode with assertions" (Flows.bind (adaptTypeToHaskellAndEncode namespaces typ) (\htyp -> Logic.ifElse (Lists.null assertPairs) (Flows.pure htyp) ( +    let encoded = (Lists.map encodeAssertion assertPairs) +        hassert = (Logic.ifElse (Equality.gt (Lists.length encoded) 1) (Lists.head encoded) (Ast.AssertionTuple encoded))+    in (Flows.pure (Ast.TypeCtx (Ast.ContextType {+      Ast.contextTypeCtx = hassert,+      Ast.contextTypeType = htyp})))))))++findOrdVariables :: (Core.Type -> S.Set Core.Name)+findOrdVariables typ =  +  let fold = (\names -> \typ_ -> (\x -> case x of+          Core.TypeMap v1 ->  +            let kt = (Core.mapTypeKeys v1)+            in (tryType names kt)+          Core.TypeSet v1 -> (tryType names v1)+          _ -> names) typ_) +      isTypeVariable = (\v ->  +              let nameStr = (Core.unName v) +                  hasNoNamespace = (Optionals.isNothing (Names.namespaceOf v))+                  startsWithT = (Equality.equal (Strings.charAt 0 nameStr) 116)+              in (Logic.and hasNoNamespace startsWithT))+      tryType = (\names -> \t -> (\x -> case x of+              Core.TypeVariable v1 -> (Logic.ifElse (isTypeVariable v1) (Sets.insert v1 names) names)+              _ -> names) (Rewriting.deannotateType t))+  in (Rewriting.foldOverType Coders.TraversalOrderPre fold Sets.empty typ)++getImplicitTypeClasses :: (Core.Type -> M.Map Core.Name (S.Set Mantle.TypeClass))+getImplicitTypeClasses typ =  +  let toPair = (\name -> (name, (Sets.fromList [+          Mantle.TypeClassOrdering])))+  in (Maps.fromList (Lists.map toPair (Sets.toList (findOrdVariables typ))))++moduleToHaskellModule :: (Module.Module -> Compute.Flow Graph.Graph Ast.Module)+moduleToHaskellModule mod = (Flows.bind (Utils.namespacesForModule mod) (\namespaces -> Modules.transformModule Language.haskellLanguage (encodeTerm namespaces) (constructModule namespaces) mod))++moduleToHaskell :: (Module.Module -> Compute.Flow Graph.Graph (M.Map String String))+moduleToHaskell mod = (Flows.bind (moduleToHaskellModule mod) (\hsmod ->  +  let s = (Serialization.printExpr (Serialization.parenthesize (Serde.moduleToExpr hsmod))) +      filepath = (Names.namespaceToFilePath Mantle.CaseConventionPascal (Module.FileExtension "hs") (Module.moduleNamespace mod))+  in (Flows.pure (Maps.singleton filepath s))))++nameDecls :: (t0 -> Module.Namespaces Ast.ModuleName -> Core.Name -> Core.Type -> [Ast.DeclarationWithComments])+nameDecls g namespaces name typ =  +  let nm = (Core.unName name) +      toDecl = (\n -> \pair ->  +              let k = (fst pair) +                  v = (snd pair)+                  decl = (Ast.DeclarationValueBinding (Ast.ValueBindingSimple (Ast.SimpleValueBinding {+                          Ast.simpleValueBindingPattern = (Utils.applicationPattern (Utils.simpleName k) []),+                          Ast.simpleValueBindingRhs = (Ast.RightHandSide (Ast.ExpressionApplication (Ast.ApplicationExpression {+                            Ast.applicationExpressionFunction = (Ast.ExpressionVariable (Utils.elementReference namespaces n)),+                            Ast.applicationExpressionArgument = (Ast.ExpressionLiteral (Ast.LiteralString v))}))),+                          Ast.simpleValueBindingLocalBindings = Nothing})))+              in Ast.DeclarationWithComments {+                Ast.declarationWithCommentsBody = decl,+                Ast.declarationWithCommentsComments = Nothing})+      nameDecl = (constantForTypeName name, nm)+      fieldDecls = (Lists.map toConstant (Lexical.fieldsOf typ))+      toConstant = (\fieldType ->  +              let fname = (Core.fieldTypeName fieldType)+              in (constantForFieldName name fname, (Core.unName fname)))+  in (Logic.ifElse useCoreImport (Lists.cons (toDecl (Core.Name "hydra.core.Name") nameDecl) (Lists.map (toDecl (Core.Name "hydra.core.Name")) fieldDecls)) [])++toDataDeclaration :: (M.Map Core.Type (Compute.Coder Graph.Graph t0 Core.Term Ast.Expression) -> Module.Namespaces Ast.ModuleName -> (Core.Binding, Core.TypedTerm) -> Compute.Flow Graph.Graph Ast.DeclarationWithComments)+toDataDeclaration coders namespaces pair =  +  let el = (fst pair) +      tt = (snd pair)+      term = (Core.typedTermTerm tt)+      typ = (Core.typedTermType tt)+      coder = (Optionals.fromJust (Maps.lookup typ coders))+      hname = (Utils.simpleName (Names.localNameOf (Core.bindingName el)))+      rewriteValueBinding = (\vb -> (\x -> case x of+              Ast.ValueBindingSimple v1 ->  +                let pattern_ = (Ast.simpleValueBindingPattern v1) +                    rhs = (Ast.simpleValueBindingRhs v1)+                    bindings = (Ast.simpleValueBindingLocalBindings v1)+                in ((\x -> case x of+                  Ast.PatternApplication v2 ->  +                    let name_ = (Ast.applicationPatternName v2) +                        args = (Ast.applicationPatternArgs v2)+                        rhsExpr = (Ast.unRightHandSide rhs)+                    in ((\x -> case x of+                      Ast.ExpressionLambda v3 ->  +                        let vars = (Ast.lambdaExpressionBindings v3) +                            body = (Ast.lambdaExpressionInner v3)+                            newPattern = (Utils.applicationPattern name_ (Lists.concat2 args vars))+                            newRhs = (Ast.RightHandSide body)+                        in (rewriteValueBinding (Ast.ValueBindingSimple (Ast.SimpleValueBinding {+                          Ast.simpleValueBindingPattern = newPattern,+                          Ast.simpleValueBindingRhs = newRhs,+                          Ast.simpleValueBindingLocalBindings = bindings})))+                      _ -> vb) rhsExpr)+                  _ -> vb) pattern_)) vb)+      toDecl = (\comments -> \hname_ -> \term_ -> \coder_ -> \bindings -> (\x -> case x of+              Core.TermLet v1 ->  +                let lbindings = (Core.letBindings v1) +                    env = (Core.letEnvironment v1)+                    toBinding = (\hname_ -> \hterm_ -> Ast.LocalBindingValue (Utils.simpleValueBinding hname_ hterm_ Nothing))+                    ts = (Lists.map (\binding -> Core.typeSchemeType (Optionals.fromJust (Core.bindingType binding))) lbindings)+                in (Flows.bind (Flows.mapList (\t -> Modules.constructCoder Language.haskellLanguage (encodeTerm namespaces) t) ts) (\coders_ ->  +                  let hnames = (Lists.map (\binding -> Utils.simpleName (Core.unName (Core.bindingName binding))) lbindings) +                      terms = (Lists.map Core.bindingTerm lbindings)+                  in (Flows.bind (Flows.sequence (Lists.zipWith (\e -> \t -> Compute.coderEncode e t) coders_ terms)) (\hterms ->  +                    let hbindings = (Lists.zipWith toBinding hnames hterms)+                    in (toDecl comments hname_ env coder_ (Just (Ast.LocalBindings hbindings)))))))+              _ -> (Flows.bind (Compute.coderEncode coder_ term_) (\hterm ->  +                let vb = (Utils.simpleValueBinding hname_ hterm bindings)+                in (Flows.bind (Annotations.getTypeClasses (Rewriting.removeTypesFromTerm (Core.bindingTerm el))) (\explicitClasses -> Flows.bind (encodeTypeWithClassAssertions namespaces explicitClasses typ) (\htype ->  +                  let decl = (Ast.DeclarationTypedBinding (Ast.TypedBinding {+                          Ast.typedBindingTypeSignature = Ast.TypeSignature {+                            Ast.typeSignatureName = hname_,+                            Ast.typeSignatureType = htype},+                          Ast.typedBindingValueBinding = (rewriteValueBinding vb)}))+                  in (Flows.pure (Ast.DeclarationWithComments {+                    Ast.declarationWithCommentsBody = decl,+                    Ast.declarationWithCommentsComments = comments})))))))) (Rewriting.deannotateTerm term_))+  in (Flows.bind (Annotations.getTermDescription term) (\comments -> toDecl comments hname term coder Nothing))++toTypeDeclarations :: (Module.Namespaces Ast.ModuleName -> Core.Binding -> Core.Term -> Compute.Flow Graph.Graph [Ast.DeclarationWithComments])+toTypeDeclarations namespaces el term =  +  let elementName = (Core.bindingName el) +      lname = (Names.localNameOf elementName)+      hname = (Utils.simpleName lname)+      declHead = (\name -> \vars_ -> Logic.ifElse (Lists.null vars_) (Ast.DeclarationHeadSimple name) ( +              let h = (Lists.head vars_) +                  rest = (Lists.tail vars_)+                  hvar = (Ast.Variable (Utils.simpleName (Core.unName h)))+              in (Ast.DeclarationHeadApplication (Ast.ApplicationDeclarationHead {+                Ast.applicationDeclarationHeadFunction = (declHead name rest),+                Ast.applicationDeclarationHeadOperand = hvar}))))+      newtypeCons = (\el_ -> \typ_ ->  +              let hname = (Utils.simpleName (Utils.newtypeAccessorName (Core.bindingName el_)))+              in (Flows.bind (adaptTypeToHaskellAndEncode namespaces typ_) (\htype ->  +                let hfield = Ast.FieldWithComments {+                        Ast.fieldWithCommentsField = Ast.Field {+                          Ast.fieldName = hname,+                          Ast.fieldType = htype},+                        Ast.fieldWithCommentsComments = Nothing} +                    constructorName = (Utils.simpleName (Names.localNameOf (Core.bindingName el_)))+                in (Flows.pure (Ast.ConstructorWithComments {+                  Ast.constructorWithCommentsBody = (Ast.ConstructorRecord (Ast.RecordConstructor {+                    Ast.recordConstructorName = constructorName,+                    Ast.recordConstructorFields = [+                      hfield]})),+                  Ast.constructorWithCommentsComments = Nothing})))))+      recordCons = (\lname_ -> \fields ->  +              let toField = (\fieldType ->  +                      let fname = (Core.fieldTypeName fieldType) +                          ftype = (Core.fieldTypeType fieldType)+                          hname_ = (Utils.simpleName (Strings.cat2 (Formatting.decapitalize lname_) (Formatting.capitalize (Core.unName fname))))+                      in (Flows.bind (adaptTypeToHaskellAndEncode namespaces ftype) (\htype -> Flows.bind (Annotations.getTypeDescription ftype) (\comments -> Flows.pure (Ast.FieldWithComments {+                        Ast.fieldWithCommentsField = Ast.Field {+                          Ast.fieldName = hname_,+                          Ast.fieldType = htype},+                        Ast.fieldWithCommentsComments = comments})))))+              in (Flows.bind (Flows.mapList toField fields) (\hFields -> Flows.pure (Ast.ConstructorWithComments {+                Ast.constructorWithCommentsBody = (Ast.ConstructorRecord (Ast.RecordConstructor {+                  Ast.recordConstructorName = (Utils.simpleName lname_),+                  Ast.recordConstructorFields = hFields})),+                Ast.constructorWithCommentsComments = Nothing}))))+      unionCons = (\g_ -> \lname_ -> \fieldType ->  +              let fname = (Core.fieldTypeName fieldType) +                  ftype = (Core.fieldTypeType fieldType)+                  deconflict = (\name ->  +                          let tname = (Names.unqualifyName (Module.QualifiedName {+                                  Module.qualifiedNameNamespace = (Just (fst (Module.namespacesFocus namespaces))),+                                  Module.qualifiedNameLocal = name}))+                          in (Logic.ifElse (Optionals.isJust (Maps.lookup tname (Graph.graphElements g_))) (deconflict (Strings.cat2 name "_")) name))+              in (Flows.bind (Annotations.getTypeDescription ftype) (\comments ->  +                let nm = (deconflict (Strings.cat2 (Formatting.capitalize lname_) (Formatting.capitalize (Core.unName fname))))+                in (Flows.bind (Logic.ifElse (Equality.equal (Rewriting.deannotateType ftype) Core.TypeUnit) (Flows.pure []) (Flows.bind (adaptTypeToHaskellAndEncode namespaces ftype) (\htype -> Flows.pure [+                  htype]))) (\typeList -> Flows.pure (Ast.ConstructorWithComments {+                  Ast.constructorWithCommentsBody = (Ast.ConstructorOrdinary (Ast.OrdinaryConstructor {+                    Ast.ordinaryConstructorName = (Utils.simpleName nm),+                    Ast.ordinaryConstructorFields = typeList})),+                  Ast.constructorWithCommentsComments = comments}))))))+  in (Monads.withTrace (Strings.cat2 "type element " (Core.unName elementName)) (Flows.bind Monads.getState (\g -> Flows.bind (Core_.type_ term) (\t -> Flows.bind (Schemas.isSerializable el) (\isSer ->  +    let deriv = (Ast.Deriving (Logic.ifElse isSer (Lists.map Utils.rawName [+            "Eq",+            "Ord",+            "Read",+            "Show"]) [])) +        unpackResult = (Utils.unpackForallType g t)+        vars = (fst unpackResult)+        t_ = (snd unpackResult)+        hd = (declHead hname (Lists.reverse vars))+    in (Flows.bind ((\x -> case x of+      Core.TypeRecord v1 -> (Flows.bind (recordCons lname (Core.rowTypeFields v1)) (\cons -> Flows.pure (Ast.DeclarationData (Ast.DataDeclaration {+        Ast.dataDeclarationKeyword = Ast.DataOrNewtypeData,+        Ast.dataDeclarationContext = [],+        Ast.dataDeclarationHead = hd,+        Ast.dataDeclarationConstructors = [+          cons],+        Ast.dataDeclarationDeriving = [+          deriv]}))))+      Core.TypeUnion v1 -> (Flows.bind (Flows.mapList (unionCons g lname) (Core.rowTypeFields v1)) (\cons -> Flows.pure (Ast.DeclarationData (Ast.DataDeclaration {+        Ast.dataDeclarationKeyword = Ast.DataOrNewtypeData,+        Ast.dataDeclarationContext = [],+        Ast.dataDeclarationHead = hd,+        Ast.dataDeclarationConstructors = cons,+        Ast.dataDeclarationDeriving = [+          deriv]}))))+      Core.TypeWrap v1 ->  +        let tname = (Core.wrappedTypeTypeName v1) +            wt = (Core.wrappedTypeObject v1)+        in (Flows.bind (newtypeCons el wt) (\cons -> Flows.pure (Ast.DeclarationData (Ast.DataDeclaration {+          Ast.dataDeclarationKeyword = Ast.DataOrNewtypeNewtype,+          Ast.dataDeclarationContext = [],+          Ast.dataDeclarationHead = hd,+          Ast.dataDeclarationConstructors = [+            cons],+          Ast.dataDeclarationDeriving = [+            deriv]}))))+      _ -> (Flows.bind (adaptTypeToHaskellAndEncode namespaces t) (\htype -> Flows.pure (Ast.DeclarationType (Ast.TypeDeclaration {+        Ast.typeDeclarationName = hd,+        Ast.typeDeclarationType = htype}))))) (Rewriting.deannotateType t_)) (\decl -> Flows.bind (Annotations.getTermDescription term) (\comments -> Flows.bind (Logic.ifElse includeTypeDefinitions (Flows.bind (typeDecl namespaces elementName t) (\decl_ -> Flows.pure [+      decl_])) (Flows.pure [])) (\tdecls ->  +      let mainDecl = Ast.DeclarationWithComments {+              Ast.declarationWithCommentsBody = decl,+              Ast.declarationWithCommentsComments = comments} +          nameDecls_ = (nameDecls g namespaces elementName t)+      in (Flows.pure (Lists.concat [+        [+          mainDecl],+        nameDecls_,+        tdecls])))))))))))++typeDecl :: (Module.Namespaces Ast.ModuleName -> Core.Name -> Core.Type -> Compute.Flow Graph.Graph Ast.DeclarationWithComments)+typeDecl namespaces name typ =  +  let typeName = (\ns -> \name_ -> Names.qname ns (typeNameLocal name_)) +      typeNameLocal = (\name_ -> Strings.cat [+              "_",+              Names.localNameOf name_,+              "_type_"])+      rawTerm = (Core__.type_ typ)+      rewrite = (\recurse -> \term ->  +              let variantResult = (Decoding.variant (Core.Name "hydra.core.Type") term) +                  forType = (\field ->  +                          let fname = (Core.fieldName field) +                              fterm = (Core.fieldTerm field)+                          in (Logic.ifElse (Equality.equal fname (Core.Name "record")) Nothing (Logic.ifElse (Equality.equal fname (Core.Name "variable")) (Optionals.bind (Decoding.name fterm) forVariableType) Nothing)))+                  forVariableType = (\name_ ->  +                          let qname = (Names.qualifyName name_) +                              mns = (Module.qualifiedNameNamespace qname)+                              local = (Module.qualifiedNameLocal qname)+                          in (Optionals.map (\ns -> Core.TermVariable (Names.qname ns (Strings.cat [+                            "_",+                            local,+                            "_type_"]))) mns))+              in (Optionals.fromMaybe (recurse term) (Optionals.bind variantResult forType)))+      finalTerm = (Rewriting.rewriteTerm rewrite rawTerm)+  in (Flows.bind (Modules.constructCoder Language.haskellLanguage (encodeTerm namespaces) (Core.TypeVariable (Core.Name "hydra.core.Type"))) (\coder -> Flows.bind (Compute.coderEncode coder finalTerm) (\expr ->  +    let rhs = (Ast.RightHandSide expr) +        hname = (Utils.simpleName (typeNameLocal name))+        pat = (Utils.applicationPattern hname [])+        decl = (Ast.DeclarationValueBinding (Ast.ValueBindingSimple (Ast.SimpleValueBinding {+                Ast.simpleValueBindingPattern = pat,+                Ast.simpleValueBindingRhs = rhs,+                Ast.simpleValueBindingLocalBindings = Nothing})))+    in (Flows.pure (Ast.DeclarationWithComments {+      Ast.declarationWithCommentsBody = decl,+      Ast.declarationWithCommentsComments = Nothing})))))
+ src/gen-main/haskell/Hydra/Ext/Haskell/Language.hs view
@@ -0,0 +1,132 @@+-- | Language constraints and reserved words for Haskell++module Hydra.Ext.Haskell.Language where++import qualified Hydra.Coders as Coders+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Language constraints for Haskell+haskellLanguage :: Coders.Language+haskellLanguage = Coders.Language {+  Coders.languageName = (Coders.LanguageName "hydra.ext.haskell"),+  Coders.languageConstraints = Coders.LanguageConstraints {+    Coders.languageConstraintsEliminationVariants = eliminationVariants,+    Coders.languageConstraintsLiteralVariants = literalVariants,+    Coders.languageConstraintsFloatTypes = floatTypes,+    Coders.languageConstraintsFunctionVariants = functionVariants,+    Coders.languageConstraintsIntegerTypes = integerTypes,+    Coders.languageConstraintsTermVariants = termVariants,+    Coders.languageConstraintsTypeVariants = typeVariants,+    Coders.languageConstraintsTypes = typePredicate}} +  where +    eliminationVariants = (Sets.fromList [+      Mantle.EliminationVariantProduct,+      Mantle.EliminationVariantRecord,+      Mantle.EliminationVariantUnion,+      Mantle.EliminationVariantWrap])+    literalVariants = (Sets.fromList [+      Mantle.LiteralVariantBoolean,+      Mantle.LiteralVariantFloat,+      Mantle.LiteralVariantInteger,+      Mantle.LiteralVariantString])+    floatTypes = (Sets.fromList [+      Core.FloatTypeFloat32,+      Core.FloatTypeFloat64])+    functionVariants = (Sets.fromList [+      Mantle.FunctionVariantElimination,+      Mantle.FunctionVariantLambda,+      Mantle.FunctionVariantPrimitive])+    integerTypes = (Sets.fromList [+      Core.IntegerTypeBigint,+      Core.IntegerTypeInt8,+      Core.IntegerTypeInt16,+      Core.IntegerTypeInt32,+      Core.IntegerTypeInt64])+    termVariants = (Sets.fromList [+      Mantle.TermVariantApplication,+      Mantle.TermVariantFunction,+      Mantle.TermVariantLet,+      Mantle.TermVariantList,+      Mantle.TermVariantLiteral,+      Mantle.TermVariantMap,+      Mantle.TermVariantOptional,+      Mantle.TermVariantProduct,+      Mantle.TermVariantRecord,+      Mantle.TermVariantSet,+      Mantle.TermVariantUnion,+      Mantle.TermVariantUnit,+      Mantle.TermVariantVariable,+      Mantle.TermVariantWrap])+    typeVariants = (Sets.fromList [+      Mantle.TypeVariantAnnotated,+      Mantle.TypeVariantApplication,+      Mantle.TypeVariantFunction,+      Mantle.TypeVariantForall,+      Mantle.TypeVariantList,+      Mantle.TypeVariantLiteral,+      Mantle.TypeVariantMap,+      Mantle.TypeVariantOptional,+      Mantle.TypeVariantProduct,+      Mantle.TypeVariantRecord,+      Mantle.TypeVariantSet,+      Mantle.TypeVariantUnion,+      Mantle.TypeVariantUnit,+      Mantle.TypeVariantVariable,+      Mantle.TypeVariantWrap])+    typePredicate = (\_ -> True)++-- | Created on 2025-02-28 using GHCi 9.6.6+-- | +-- | You can reproduce these lists of symbols by issuing the command `:browse Prelude` in GHCi, pasting the results into+-- | /tmp/browse_Prelude.txt, and then running the Bash command provided with each list.+-- | +-- | See also https://www.haskell.org/onlinereport/standard-prelude.html+reservedWords :: (S.Set String)+reservedWords = (Sets.fromList (Lists.concat2 keywordSymbols reservedSymbols)) +  where +    keywordSymbols = [+      "case",+      "class",+      "data",+      "default",+      "deriving",+      "do",+      "else",+      "forall",+      "foreign",+      "if",+      "import",+      "in",+      "infix",+      "infixl",+      "infixr",+      "instance",+      "let",+      "module",+      "newtype",+      "of",+      "then",+      "type",+      "where"]+    reservedSymbols = [+      "Bool",+      "Double",+      "False",+      "Float",+      "Int",+      "Integer",+      "Just",+      "Maybe",+      "Nothing",+      "Ord",+      "Show",+      "String",+      "True"]
+ src/gen-main/haskell/Hydra/Ext/Haskell/Operators.hs view
@@ -0,0 +1,129 @@+-- | AST operators for Haskell++module Hydra.Ext.Haskell.Operators where++import qualified Hydra.Ast as Ast+import qualified Hydra.Lib.Math as Math+import qualified Hydra.Serialization as Serialization+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++andOp :: Ast.Op+andOp = (Serialization.op "&&" 3 Ast.AssociativityRight)++apOp :: Ast.Op+apOp = (Serialization.op "<*>" 4 Ast.AssociativityLeft)++-- | No source+appOp :: Ast.Op+appOp = Ast.Op {+  Ast.opSymbol = (Ast.Symbol ""),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsNone,+    Ast.paddingRight = Ast.WsSpace},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityLeft}++applyOp :: Ast.Op+applyOp = (Serialization.op "$" 0 Ast.AssociativityRight)++arrowOp :: Ast.Op+arrowOp = (Serialization.op "->" (Math.neg 1) Ast.AssociativityRight)++-- | No source+assertOp :: Ast.Op+assertOp = (Serialization.op "=>" 0 Ast.AssociativityNone)++bindOp :: Ast.Op+bindOp = (Serialization.op ">>=" 1 Ast.AssociativityLeft)++-- | No source+caseOp :: Ast.Op+caseOp = (Serialization.op "->" 0 Ast.AssociativityNone)++composeOp :: Ast.Op+composeOp = (Serialization.op "." 9 Ast.AssociativityLeft)++concatOp :: Ast.Op+concatOp = (Serialization.op "++" 5 Ast.AssociativityRight)++consOp :: Ast.Op+consOp = (Serialization.op ":" 5 Ast.AssociativityRight)++-- | No source+defineOp :: Ast.Op+defineOp = (Serialization.op "=" 0 Ast.AssociativityNone)++diamondOp :: Ast.Op+diamondOp = (Serialization.op "<>" 6 Ast.AssociativityRight)++divOp :: Ast.Op+divOp = (Serialization.op "`div`" 7 Ast.AssociativityLeft)++divideOp :: Ast.Op+divideOp = (Serialization.op "/" 7 Ast.AssociativityLeft)++elemOp :: Ast.Op+elemOp = (Serialization.op "`elem`" 4 Ast.AssociativityNone)++equalOp :: Ast.Op+equalOp = (Serialization.op "==" 4 Ast.AssociativityNone)++fmapOp :: Ast.Op+fmapOp = (Serialization.op "<$>" 4 Ast.AssociativityLeft)++gtOp :: Ast.Op+gtOp = (Serialization.op ">" 4 Ast.AssociativityNone)++gteOp :: Ast.Op+gteOp = (Serialization.op ">=" 4 Ast.AssociativityNone)++indexOp :: Ast.Op+indexOp = (Serialization.op "!!" 9 Ast.AssociativityLeft)++-- | No source+lambdaOp :: Ast.Op+lambdaOp = (Serialization.op "->" (Math.neg 1) Ast.AssociativityRight)++ltOp :: Ast.Op+ltOp = (Serialization.op "<" 4 Ast.AssociativityNone)++lteOp :: Ast.Op+lteOp = (Serialization.op ">=" 4 Ast.AssociativityNone)++-- | Originally: associativityLeft+minusOp :: Ast.Op+minusOp = (Serialization.op "-" 6 Ast.AssociativityBoth)++modOp :: Ast.Op+modOp = (Serialization.op "`mod`" 7 Ast.AssociativityLeft)++-- | Originally: associativityLeft+multOp :: Ast.Op+multOp = (Serialization.op "*" 7 Ast.AssociativityBoth)++neqOp :: Ast.Op+neqOp = (Serialization.op "/=" 4 Ast.AssociativityNone)++notElemOp :: Ast.Op+notElemOp = (Serialization.op "`notElem`" 4 Ast.AssociativityNone)++orOp :: Ast.Op+orOp = (Serialization.op "||" 2 Ast.AssociativityRight)++-- | Originally: associativityLeft+plusOp :: Ast.Op+plusOp = (Serialization.op "+" 6 Ast.AssociativityBoth)++quotOp :: Ast.Op+quotOp = (Serialization.op "`quot`" 7 Ast.AssociativityLeft)++remOp :: Ast.Op+remOp = (Serialization.op "`rem`" 7 Ast.AssociativityLeft)++-- | No source+typeOp :: Ast.Op+typeOp = (Serialization.op "::" 0 Ast.AssociativityNone)
+ src/gen-main/haskell/Hydra/Ext/Haskell/Serde.hs view
@@ -0,0 +1,385 @@+-- | Haskell operator precendence and associativity are drawn from:+-- | https://self-learning-java-tutorial.blogspot.com/2016/04/haskell-operator-precedence.html+-- | Other operators were investigated using GHCi, e.g. ":info (->)"+-- | Operator names are drawn (loosely) from:+-- | https://stackoverflow.com/questions/7746894/are-there-pronounceable-names-for-common-haskell-operators++module Hydra.Ext.Haskell.Serde where++import qualified Hydra.Ast as Ast+import qualified Hydra.Ext.Haskell.Ast as Ast_+import qualified Hydra.Ext.Haskell.Operators as Operators+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.Optionals as Optionals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Serialization as Serialization+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++alternativeToExpr :: (Ast_.Alternative -> Ast.Expr)+alternativeToExpr alt = (Serialization.ifx Operators.caseOp (patternToExpr (Ast_.alternativePattern alt)) (caseRhsToExpr (Ast_.alternativeRhs alt)))++applicationExpressionToExpr :: (Ast_.ApplicationExpression -> Ast.Expr)+applicationExpressionToExpr app = (Serialization.ifx Operators.appOp (expressionToExpr (Ast_.applicationExpressionFunction app)) (expressionToExpr (Ast_.applicationExpressionArgument app)))++applicationPatternToExpr :: (Ast_.ApplicationPattern -> Ast.Expr)+applicationPatternToExpr appPat =  +  let name = (Ast_.applicationPatternName appPat) +      pats = (Ast_.applicationPatternArgs appPat)+  in (Serialization.spaceSep (Lists.cons (nameToExpr name) (Lists.map patternToExpr pats)))++assertionToExpr :: (Ast_.Assertion -> Ast.Expr)+assertionToExpr sert = ((\x -> case x of+  Ast_.AssertionClass v1 -> (classAssertionToExpr v1)+  Ast_.AssertionTuple v1 -> (Serialization.parenList False (Lists.map assertionToExpr v1))) sert)++caseExpressionToExpr :: (Ast_.CaseExpression -> Ast.Expr)+caseExpressionToExpr caseExpr =  +  let cs = (Ast_.caseExpressionCase caseExpr) +      alts = (Ast_.caseExpressionAlternatives caseExpr)+      ofOp = Ast.Op {+              Ast.opSymbol = (Ast.Symbol "of"),+              Ast.opPadding = Ast.Padding {+                Ast.paddingLeft = Ast.WsSpace,+                Ast.paddingRight = (Ast.WsBreakAndIndent "  ")},+              Ast.opPrecedence = (Ast.Precedence 0),+              Ast.opAssociativity = Ast.AssociativityNone}+      lhs = (Serialization.spaceSep [+              Serialization.cst "case",+              (expressionToExpr cs)])+      rhs = (Serialization.newlineSep (Lists.map alternativeToExpr alts))+  in (Serialization.ifx ofOp lhs rhs)++caseRhsToExpr :: (Ast_.CaseRhs -> Ast.Expr)+caseRhsToExpr rhs = (expressionToExpr (Ast_.unCaseRhs rhs))++classAssertionToExpr :: (Ast_.ClassAssertion -> Ast.Expr)+classAssertionToExpr clsAsrt =  +  let name = (Ast_.classAssertionName clsAsrt) +      types = (Ast_.classAssertionTypes clsAsrt)+  in (Serialization.spaceSep [+    nameToExpr name,+    (Serialization.commaSep Serialization.halfBlockStyle (Lists.map typeToExpr types))])++constructorToExpr :: (Ast_.Constructor -> Ast.Expr)+constructorToExpr cons = ((\x -> case x of+  Ast_.ConstructorOrdinary v1 ->  +    let name = (Ast_.ordinaryConstructorName v1) +        types = (Ast_.ordinaryConstructorFields v1)+    in (Serialization.spaceSep [+      nameToExpr name,+      (Serialization.spaceSep (Lists.map typeToExpr types))])+  Ast_.ConstructorRecord v1 ->  +    let name = (Ast_.recordConstructorName v1) +        fields = (Ast_.recordConstructorFields v1)+    in (Serialization.spaceSep [+      nameToExpr name,+      (Serialization.curlyBracesList Nothing Serialization.halfBlockStyle (Lists.map fieldWithCommentsToExpr fields))])) cons)++constructorWithCommentsToExpr :: (Ast_.ConstructorWithComments -> Ast.Expr)+constructorWithCommentsToExpr consWithComments =  +  let body = (Ast_.constructorWithCommentsBody consWithComments) +      mc = (Ast_.constructorWithCommentsComments consWithComments)+  in (Optionals.maybe (constructorToExpr body) (\c -> Serialization.newlineSep [+    Serialization.cst (toHaskellComments c),+    (constructorToExpr body)]) mc)++dataOrNewtypeToExpr :: (Ast_.DataOrNewtype -> Ast.Expr)+dataOrNewtypeToExpr kw = ((\x -> case x of+  Ast_.DataOrNewtypeData -> (Serialization.cst "data")+  Ast_.DataOrNewtypeNewtype -> (Serialization.cst "newtype")) kw)++declarationHeadToExpr :: (Ast_.DeclarationHead -> Ast.Expr)+declarationHeadToExpr hd = ((\x -> case x of+  Ast_.DeclarationHeadApplication v1 ->  +    let fun = (Ast_.applicationDeclarationHeadFunction v1) +        op = (Ast_.applicationDeclarationHeadOperand v1)+    in (Serialization.spaceSep [+      declarationHeadToExpr fun,+      (variableToExpr op)])+  Ast_.DeclarationHeadSimple v1 -> (nameToExpr v1)) hd)++declarationToExpr :: (Ast_.Declaration -> Ast.Expr)+declarationToExpr decl = ((\x -> case x of+  Ast_.DeclarationData v1 ->  +    let kw = (Ast_.dataDeclarationKeyword v1) +        hd = (Ast_.dataDeclarationHead v1)+        cons = (Ast_.dataDeclarationConstructors v1)+        deriv = (Ast_.dataDeclarationDeriving v1)+        derivCat = (Lists.concat (Lists.map Ast_.unDeriving deriv))+        constructors = (Serialization.orSep Serialization.halfBlockStyle (Lists.map constructorWithCommentsToExpr cons))+        derivingClause = (Logic.ifElse (Lists.null derivCat) [] [+                Serialization.spaceSep [+                  Serialization.cst "deriving",+                  (Serialization.parenList False (Lists.map nameToExpr derivCat))]])+        mainParts = [+                Serialization.spaceSep [+                  dataOrNewtypeToExpr kw,+                  declarationHeadToExpr hd,+                  (Serialization.cst "=")],+                constructors]+    in (Serialization.indentBlock (Lists.concat2 mainParts derivingClause))+  Ast_.DeclarationType v1 ->  +    let hd = (Ast_.typeDeclarationName v1) +        typ = (Ast_.typeDeclarationType v1)+    in (Serialization.spaceSep [+      Serialization.cst "type",+      declarationHeadToExpr hd,+      Serialization.cst "=",+      (typeToExpr typ)])+  Ast_.DeclarationValueBinding v1 -> (valueBindingToExpr v1)+  Ast_.DeclarationTypedBinding v1 ->  +    let typeSig = (Ast_.typedBindingTypeSignature v1) +        vb = (Ast_.typedBindingValueBinding v1)+        name = (Ast_.typeSignatureName typeSig)+        htype = (Ast_.typeSignatureType typeSig)+    in (Serialization.newlineSep [+      Serialization.ifx Operators.typeOp (nameToExpr name) (typeToExpr htype),+      (valueBindingToExpr vb)])) decl)++declarationWithCommentsToExpr :: (Ast_.DeclarationWithComments -> Ast.Expr)+declarationWithCommentsToExpr declWithComments =  +  let body = (Ast_.declarationWithCommentsBody declWithComments) +      mc = (Ast_.declarationWithCommentsComments declWithComments)+  in (Optionals.maybe (declarationToExpr body) (\c -> Serialization.newlineSep [+    Serialization.cst (toHaskellComments c),+    (declarationToExpr body)]) mc)++expressionToExpr :: (Ast_.Expression -> Ast.Expr)+expressionToExpr expr = ((\x -> case x of+  Ast_.ExpressionApplication v1 -> (applicationExpressionToExpr v1)+  Ast_.ExpressionCase v1 -> (caseExpressionToExpr v1)+  Ast_.ExpressionConstructRecord v1 -> (constructRecordExpressionToExpr v1)+  Ast_.ExpressionDo v1 -> (Serialization.indentBlock (Lists.cons (Serialization.cst "do") (Lists.map statementToExpr v1)))+  Ast_.ExpressionIf v1 -> (ifExpressionToExpr v1)+  Ast_.ExpressionLiteral v1 -> (literalToExpr v1)+  Ast_.ExpressionLambda v1 -> (Serialization.parenthesize (lambdaExpressionToExpr v1))+  Ast_.ExpressionLet v1 ->  +    let bindings = (Ast_.letExpressionBindings v1) +        inner = (Ast_.letExpressionInner v1)+        encodeBinding = (\binding -> Serialization.indentSubsequentLines "      " (localBindingToExpr binding))+    in (Serialization.indentBlock [+      Serialization.cst "",+      Serialization.spaceSep [+        Serialization.cst "let",+        (Serialization.customIndentBlock "    " (Lists.map encodeBinding bindings))],+      (Serialization.spaceSep [+        Serialization.cst "in",+        (expressionToExpr inner)])])+  Ast_.ExpressionList v1 -> (Serialization.bracketList Serialization.halfBlockStyle (Lists.map expressionToExpr v1))+  Ast_.ExpressionParens v1 -> (Serialization.parenthesize (expressionToExpr v1))+  Ast_.ExpressionTuple v1 -> (Serialization.parenList False (Lists.map expressionToExpr v1))+  Ast_.ExpressionVariable v1 -> (nameToExpr v1)) expr)++constructRecordExpressionToExpr :: (Ast_.ConstructRecordExpression -> Ast.Expr)+constructRecordExpressionToExpr constructRecord =  +  let name = (Ast_.constructRecordExpressionName constructRecord) +      updates = (Ast_.constructRecordExpressionFields constructRecord)+      fromUpdate = (\update ->  +              let fn = (Ast_.fieldUpdateName update) +                  val = (Ast_.fieldUpdateValue update)+              in (Serialization.ifx Operators.defineOp (nameToExpr fn) (expressionToExpr val)))+      body = (Serialization.commaSep Serialization.halfBlockStyle (Lists.map fromUpdate updates))+  in (Serialization.spaceSep [+    nameToExpr name,+    (Serialization.brackets Serialization.curlyBraces Serialization.halfBlockStyle body)])++fieldToExpr :: (Ast_.Field -> Ast.Expr)+fieldToExpr field =  +  let name = (Ast_.fieldName field) +      typ = (Ast_.fieldType field)+  in (Serialization.spaceSep [+    nameToExpr name,+    Serialization.cst "::",+    (typeToExpr typ)])++fieldWithCommentsToExpr :: (Ast_.FieldWithComments -> Ast.Expr)+fieldWithCommentsToExpr fieldWithComments =  +  let field = (Ast_.fieldWithCommentsField fieldWithComments) +      mc = (Ast_.fieldWithCommentsComments fieldWithComments)+  in (Optionals.maybe (fieldToExpr field) (\c -> Serialization.newlineSep [+    Serialization.cst (toHaskellComments c),+    (fieldToExpr field)]) mc)++ifExpressionToExpr :: (Ast_.IfExpression -> Ast.Expr)+ifExpressionToExpr ifExpr =  +  let eif = (Ast_.ifExpressionCondition ifExpr) +      ethen = (Ast_.ifExpressionThen ifExpr)+      eelse = (Ast_.ifExpressionElse ifExpr)+      ifOp = Ast.Op {+              Ast.opSymbol = (Ast.Symbol ""),+              Ast.opPadding = Ast.Padding {+                Ast.paddingLeft = Ast.WsNone,+                Ast.paddingRight = (Ast.WsBreakAndIndent "  ")},+              Ast.opPrecedence = (Ast.Precedence 0),+              Ast.opAssociativity = Ast.AssociativityNone}+      body = (Serialization.newlineSep [+              Serialization.spaceSep [+                Serialization.cst "then",+                (expressionToExpr ethen)],+              (Serialization.spaceSep [+                Serialization.cst "else",+                (expressionToExpr eelse)])])+  in (Serialization.ifx ifOp (Serialization.spaceSep [+    Serialization.cst "if",+    (expressionToExpr eif)]) body)++importExportSpecToExpr :: (Ast_.ImportExportSpec -> Ast.Expr)+importExportSpecToExpr spec = (nameToExpr (Ast_.importExportSpecName spec))++importToExpr :: (Ast_.Import -> Ast.Expr)+importToExpr import_ =  +  let qual = (Ast_.importQualified import_) +      modName = (Ast_.importModule import_)+      mod = (Ast_.importAs import_)+      mspec = (Ast_.importSpec import_)+      name = (Ast_.unModuleName modName)+      hidingSec = (\spec -> (\x -> case x of+              Ast_.SpecImportHiding v1 -> (Serialization.spaceSep [+                Serialization.cst "hiding ",+                (Serialization.parens (Serialization.commaSep Serialization.inlineStyle (Lists.map importExportSpecToExpr v1)))])) spec)+      parts = (Optionals.cat [+              Just (Serialization.cst "import"),+              Logic.ifElse qual (Just (Serialization.cst "qualified")) Nothing,+              Just (Serialization.cst name),+              Optionals.map (\m -> Serialization.cst (Strings.cat2 "as " (Ast_.unModuleName m))) mod,+              (Optionals.map hidingSec mspec)])+  in (Serialization.spaceSep parts)++lambdaExpressionToExpr :: (Ast_.LambdaExpression -> Ast.Expr)+lambdaExpressionToExpr lambdaExpr =  +  let bindings = (Ast_.lambdaExpressionBindings lambdaExpr) +      inner = (Ast_.lambdaExpressionInner lambdaExpr)+      head = (Serialization.spaceSep (Lists.map patternToExpr bindings))+      body = (expressionToExpr inner)+  in (Serialization.ifx Operators.lambdaOp (Serialization.prefix "\\" head) body)++literalToExpr :: (Ast_.Literal -> Ast.Expr)+literalToExpr lit = (Serialization.cst ((\x -> case x of+  Ast_.LiteralChar v1 -> (Literals.showString (Literals.showUint16 v1))+  Ast_.LiteralDouble v1 -> (Logic.ifElse (Equality.lt v1 0.0) (Strings.cat2 "(0" (Strings.cat2 (Literals.showFloat64 v1) ")")) (Literals.showFloat64 v1))+  Ast_.LiteralFloat v1 -> (Logic.ifElse (Equality.lt v1 0.0) (Strings.cat2 "(0" (Strings.cat2 (Literals.showFloat32 v1) ")")) (Literals.showFloat32 v1))+  Ast_.LiteralInt v1 -> (Logic.ifElse (Equality.lt v1 0) (Strings.cat2 "(0" (Strings.cat2 (Literals.showInt32 v1) ")")) (Literals.showInt32 v1))+  Ast_.LiteralInteger v1 -> (Literals.showBigint v1)+  Ast_.LiteralString v1 -> (Literals.showString v1)) lit))++localBindingToExpr :: (Ast_.LocalBinding -> Ast.Expr)+localBindingToExpr binding = ((\x -> case x of+  Ast_.LocalBindingSignature v1 -> (typeSignatureToExpr v1)+  Ast_.LocalBindingValue v1 -> (valueBindingToExpr v1)) binding)++moduleHeadToExpr :: (Ast_.ModuleHead -> Ast.Expr)+moduleHeadToExpr moduleHead =  +  let mc = (Ast_.moduleHeadComments moduleHead) +      modName = (Ast_.moduleHeadName moduleHead)+      mname = (Ast_.unModuleName modName)+      head = (Serialization.spaceSep [+              Serialization.cst "module",+              Serialization.cst mname,+              (Serialization.cst "where")])+  in (Optionals.maybe head (\c -> Serialization.newlineSep [+    Serialization.cst (toHaskellComments c),+    Serialization.cst "",+    head]) mc)++moduleToExpr :: (Ast_.Module -> Ast.Expr)+moduleToExpr module_ =  +  let mh = (Ast_.moduleHead module_) +      imports = (Ast_.moduleImports module_)+      decls = (Ast_.moduleDeclarations module_)+      headerLine = (Optionals.maybe [] (\h -> [+              moduleHeadToExpr h]) mh)+      declLines = (Lists.map declarationWithCommentsToExpr decls)+      importLines = (Logic.ifElse (Lists.null imports) [] [+              Serialization.newlineSep (Lists.map importToExpr imports)])+  in (Serialization.doubleNewlineSep (Lists.concat [+    headerLine,+    importLines,+    declLines]))++nameToExpr :: (Ast_.Name -> Ast.Expr)+nameToExpr name = (Serialization.cst ((\x -> case x of+  Ast_.NameImplicit v1 -> (Strings.cat2 "?" (writeQualifiedName v1))+  Ast_.NameNormal v1 -> (writeQualifiedName v1)+  Ast_.NameParens v1 -> (Strings.cat [+    "(",+    writeQualifiedName v1,+    ")"])) name))++patternToExpr :: (Ast_.Pattern -> Ast.Expr)+patternToExpr pat = ((\x -> case x of+  Ast_.PatternApplication v1 -> (applicationPatternToExpr v1)+  Ast_.PatternList v1 -> (Serialization.bracketList Serialization.halfBlockStyle (Lists.map patternToExpr v1))+  Ast_.PatternLiteral v1 -> (literalToExpr v1)+  Ast_.PatternName v1 -> (nameToExpr v1)+  Ast_.PatternParens v1 -> (Serialization.parenthesize (patternToExpr v1))+  Ast_.PatternTuple v1 -> (Serialization.parenList False (Lists.map patternToExpr v1))+  Ast_.PatternWildcard -> (Serialization.cst "_")) pat)++rightHandSideToExpr :: (Ast_.RightHandSide -> Ast.Expr)+rightHandSideToExpr rhs = (expressionToExpr (Ast_.unRightHandSide rhs))++statementToExpr :: (Ast_.Statement -> Ast.Expr)+statementToExpr stmt = (expressionToExpr (Ast_.unStatement stmt))++typeSignatureToExpr :: (Ast_.TypeSignature -> Ast.Expr)+typeSignatureToExpr typeSig =  +  let name = (Ast_.typeSignatureName typeSig) +      typ = (Ast_.typeSignatureType typeSig)+  in (Serialization.spaceSep [+    nameToExpr name,+    Serialization.cst "::",+    (typeToExpr typ)])++typeToExpr :: (Ast_.Type -> Ast.Expr)+typeToExpr htype = ((\x -> case x of+  Ast_.TypeApplication v1 ->  +    let lhs = (Ast_.applicationTypeContext v1) +        rhs = (Ast_.applicationTypeArgument v1)+    in (Serialization.ifx Operators.appOp (typeToExpr lhs) (typeToExpr rhs))+  Ast_.TypeCtx v1 ->  +    let ctx = (Ast_.contextTypeCtx v1) +        typ = (Ast_.contextTypeType v1)+    in (Serialization.ifx Operators.assertOp (assertionToExpr ctx) (typeToExpr typ))+  Ast_.TypeFunction v1 ->  +    let dom = (Ast_.functionTypeDomain v1) +        cod = (Ast_.functionTypeCodomain v1)+    in (Serialization.ifx Operators.arrowOp (typeToExpr dom) (typeToExpr cod))+  Ast_.TypeList v1 -> (Serialization.bracketList Serialization.inlineStyle [+    typeToExpr v1])+  Ast_.TypeTuple v1 -> (Serialization.parenList False (Lists.map typeToExpr v1))+  Ast_.TypeVariable v1 -> (nameToExpr v1)) htype)++valueBindingToExpr :: (Ast_.ValueBinding -> Ast.Expr)+valueBindingToExpr vb = ((\x -> case x of+  Ast_.ValueBindingSimple v1 ->  +    let pat = (Ast_.simpleValueBindingPattern v1) +        rhs = (Ast_.simpleValueBindingRhs v1)+        local = (Ast_.simpleValueBindingLocalBindings v1)+        body = (Serialization.ifx Operators.defineOp (patternToExpr pat) (rightHandSideToExpr rhs))+    in (Optionals.maybe body (\localBindings ->  +      let bindings = (Ast_.unLocalBindings localBindings)+      in (Serialization.indentBlock [+        body,+        (Serialization.indentBlock (Lists.cons (Serialization.cst "where") (Lists.map localBindingToExpr bindings)))])) local)) vb)++variableToExpr :: (Ast_.Variable -> Ast.Expr)+variableToExpr variable = (nameToExpr (Ast_.unVariable variable))++toHaskellComments :: (String -> String)+toHaskellComments c = (Strings.intercalate "\n" (Lists.map (\s -> Strings.cat2 "-- | " s) (Strings.lines c)))++writeQualifiedName :: (Ast_.QualifiedName -> String)+writeQualifiedName qname =  +  let qualifiers = (Ast_.qualifiedNameQualifiers qname) +      unqual = (Ast_.qualifiedNameUnqualified qname)+      h = (\namePart -> Ast_.unNamePart namePart)+      allParts = (Lists.concat2 (Lists.map h qualifiers) [+              h unqual])+  in (Strings.intercalate "." allParts)
+ src/gen-main/haskell/Hydra/Ext/Haskell/Utils.hs view
@@ -0,0 +1,172 @@+-- | Utilities for working with Haskell syntax trees++module Hydra.Ext.Haskell.Utils where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Ext.Haskell.Ast as Ast+import qualified Hydra.Ext.Haskell.Language as Language+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Module as Module+import qualified Hydra.Names as Names+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++applicationPattern :: (Ast.Name -> [Ast.Pattern] -> Ast.Pattern)+applicationPattern name args = (Ast.PatternApplication (Ast.ApplicationPattern {+  Ast.applicationPatternName = name,+  Ast.applicationPatternArgs = args}))++elementReference :: (Module.Namespaces Ast.ModuleName -> Core.Name -> Ast.Name)+elementReference namespaces name =  +  let namespacePair = (Module.namespacesFocus namespaces) +      gname = (fst namespacePair)+      gmod = (Ast.unModuleName (snd namespacePair))+      namespacesMap = (Module.namespacesMapping namespaces)+      qname = (Names.qualifyName name)+      local = (Module.qualifiedNameLocal qname)+      escLocal = (sanitizeHaskellName local)+      mns = (Module.qualifiedNameNamespace qname)+  in (Optionals.cases (Module.qualifiedNameNamespace qname) (simpleName local) (\ns -> Optionals.cases (Maps.lookup ns namespacesMap) (simpleName local) (\mn ->  +    let aliasStr = (Ast.unModuleName mn)+    in (Logic.ifElse (Equality.equal ns gname) (simpleName escLocal) (rawName (Strings.cat [+      aliasStr,+      ".",+      (sanitizeHaskellName local)]))))))++hsapp :: (Ast.Expression -> Ast.Expression -> Ast.Expression)+hsapp l r = (Ast.ExpressionApplication (Ast.ApplicationExpression {+  Ast.applicationExpressionFunction = l,+  Ast.applicationExpressionArgument = r}))++hslambda :: (Ast.Name -> Ast.Expression -> Ast.Expression)+hslambda name rhs = (Ast.ExpressionLambda (Ast.LambdaExpression {+  Ast.lambdaExpressionBindings = [+    Ast.PatternName name],+  Ast.lambdaExpressionInner = rhs}))++hslit :: (Ast.Literal -> Ast.Expression)+hslit lit = (Ast.ExpressionLiteral lit)++hsvar :: (String -> Ast.Expression)+hsvar s = (Ast.ExpressionVariable (rawName s))++namespacesForModule :: (Module.Module -> Compute.Flow Graph.Graph (Module.Namespaces Ast.ModuleName))+namespacesForModule mod = (Flows.bind (Schemas.moduleDependencyNamespaces True True True True mod) (\nss ->  +  let ns = (Module.moduleNamespace mod) +      focusPair = (toPair ns)+      nssAsList = (Sets.toList nss)+      nssPairs = (Lists.map toPair nssAsList)+      emptyState = (Maps.empty, Sets.empty)+      finalState = (Lists.foldl addPair emptyState nssPairs)+      resultMap = (fst finalState)+      toModuleName = (\namespace ->  +              let namespaceStr = (Module.unNamespace namespace) +                  parts = (Strings.splitOn "." namespaceStr)+                  lastPart = (Lists.last parts)+                  capitalized = (Formatting.capitalize lastPart)+              in (Ast.ModuleName capitalized))+      toPair = (\name -> (name, (toModuleName name)))+      addPair = (\state -> \namePair ->  +              let currentMap = (fst state) +                  currentSet = (snd state)+                  name = (fst namePair)+                  alias = (snd namePair)+                  aliasStr = (Ast.unModuleName alias)+              in (Logic.ifElse (Sets.member alias currentSet) (addPair state (name, (Ast.ModuleName (Strings.cat2 aliasStr "_")))) (Maps.insert name alias currentMap, (Sets.insert alias currentSet))))+  in (Flows.pure (Module.Namespaces {+    Module.namespacesFocus = focusPair,+    Module.namespacesMapping = resultMap}))))++newtypeAccessorName :: (Core.Name -> String)+newtypeAccessorName name = (Strings.cat2 "un" (Names.localNameOf name))++rawName :: (String -> Ast.Name)+rawName n = (Ast.NameNormal (Ast.QualifiedName {+  Ast.qualifiedNameQualifiers = [],+  Ast.qualifiedNameUnqualified = (Ast.NamePart n)}))++recordFieldReference :: (Module.Namespaces Ast.ModuleName -> Core.Name -> Core.Name -> Ast.Name)+recordFieldReference namespaces sname fname =  +  let fnameStr = (Core.unName fname) +      qname = (Names.qualifyName sname)+      ns = (Module.qualifiedNameNamespace qname)+      typeNameStr = (typeNameForRecord sname)+      decapitalized = (Formatting.decapitalize typeNameStr)+      capitalized = (Formatting.capitalize fnameStr)+      nm = (Strings.cat2 decapitalized capitalized)+      qualName = Module.QualifiedName {+              Module.qualifiedNameNamespace = ns,+              Module.qualifiedNameLocal = nm}+      unqualName = (Names.unqualifyName qualName)+  in (elementReference namespaces unqualName)++sanitizeHaskellName :: (String -> String)+sanitizeHaskellName = (Formatting.sanitizeWithUnderscores Language.reservedWords)++simpleName :: (String -> Ast.Name)+simpleName arg_ = (rawName (sanitizeHaskellName arg_))++simpleValueBinding :: (Ast.Name -> Ast.Expression -> Maybe Ast.LocalBindings -> Ast.ValueBinding)+simpleValueBinding hname rhs bindings =  +  let pat = (Ast.PatternApplication (Ast.ApplicationPattern {+          Ast.applicationPatternName = hname,+          Ast.applicationPatternArgs = []})) +      rightHandSide = (Ast.RightHandSide rhs)+  in (Ast.ValueBindingSimple (Ast.SimpleValueBinding {+    Ast.simpleValueBindingPattern = pat,+    Ast.simpleValueBindingRhs = rightHandSide,+    Ast.simpleValueBindingLocalBindings = bindings}))++toTypeApplication :: ([Ast.Type] -> Ast.Type)+toTypeApplication types =  +  let app = (\l -> Logic.ifElse (Equality.gt (Lists.length l) 1) (Ast.TypeApplication (Ast.ApplicationType {+          Ast.applicationTypeContext = (app (Lists.tail l)),+          Ast.applicationTypeArgument = (Lists.head l)})) (Lists.head l))+  in (app (Lists.reverse types))++typeNameForRecord :: (Core.Name -> String)+typeNameForRecord sname =  +  let snameStr = (Core.unName sname) +      parts = (Strings.splitOn "." snameStr)+  in (Lists.last parts)++unionFieldReference :: (Module.Namespaces Ast.ModuleName -> Core.Name -> Core.Name -> Ast.Name)+unionFieldReference namespaces sname fname =  +  let fnameStr = (Core.unName fname) +      qname = (Names.qualifyName sname)+      ns = (Module.qualifiedNameNamespace qname)+      typeNameStr = (typeNameForRecord sname)+      capitalizedTypeName = (Formatting.capitalize typeNameStr)+      capitalizedFieldName = (Formatting.capitalize fnameStr)+      nm = (Strings.cat2 capitalizedTypeName capitalizedFieldName)+      qualName = Module.QualifiedName {+              Module.qualifiedNameNamespace = ns,+              Module.qualifiedNameLocal = nm}+      unqualName = (Names.unqualifyName qualName)+  in (elementReference namespaces unqualName)++unpackForallType :: (t0 -> Core.Type -> ([Core.Name], Core.Type))+unpackForallType cx t = ((\x -> case x of+  Core.TypeForall v1 ->  +    let v = (Core.forallTypeParameter v1) +        tbody = (Core.forallTypeBody v1)+        recursiveResult = (unpackForallType cx tbody)+        vars = (fst recursiveResult)+        finalType = (snd recursiveResult)+    in (Lists.cons v vars, finalType)+  _ -> ([], t)) (Rewriting.deannotateType t))
− src/gen-main/haskell/Hydra/Ext/Java/Language.hs 
@@ -1,237 +0,0 @@--- | Language constraints for Java--module Hydra.Ext.Java.Language where--import qualified Hydra.Basics as Basics-import qualified Hydra.Coders as Coders-import qualified Hydra.Core as Core-import qualified Hydra.Lib.Equality as Equality-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Sets as Sets-import qualified Hydra.Mantle as Mantle-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | The maximum supported length of a tuple in Hydra-Java. Note: if this constant is changed, also change Tuples.java correspondingly-javaMaxTupleLength :: Int-javaMaxTupleLength = 9---- | Language constraints for Java-javaLanguage :: Coders.Language-javaLanguage = Coders.Language {-  Coders.languageName = (Coders.LanguageName "hydra/ext/java"),-  Coders.languageConstraints = Coders.LanguageConstraints {-    Coders.languageConstraintsEliminationVariants = (Sets.fromList Basics.eliminationVariants),-    Coders.languageConstraintsLiteralVariants = (Sets.fromList [-      Mantle.LiteralVariantBoolean,-      Mantle.LiteralVariantFloat,-      Mantle.LiteralVariantInteger,-      Mantle.LiteralVariantString]),-    Coders.languageConstraintsFloatTypes = (Sets.fromList [-      Core.FloatTypeFloat32,-      Core.FloatTypeFloat64]),-    Coders.languageConstraintsFunctionVariants = (Sets.fromList Basics.functionVariants),-    Coders.languageConstraintsIntegerTypes = (Sets.fromList [-      Core.IntegerTypeBigint,-      Core.IntegerTypeInt8,-      Core.IntegerTypeInt16,-      Core.IntegerTypeInt32,-      Core.IntegerTypeInt64,-      Core.IntegerTypeUint16]),-    Coders.languageConstraintsTermVariants = (Sets.fromList [-      Mantle.TermVariantApplication,-      Mantle.TermVariantFunction,-      Mantle.TermVariantLet,-      Mantle.TermVariantList,-      Mantle.TermVariantLiteral,-      Mantle.TermVariantMap,-      Mantle.TermVariantOptional,-      Mantle.TermVariantProduct,-      Mantle.TermVariantRecord,-      Mantle.TermVariantSet,-      Mantle.TermVariantUnion,-      Mantle.TermVariantVariable,-      Mantle.TermVariantWrap]),-    Coders.languageConstraintsTypeVariants = (Sets.fromList [-      Mantle.TypeVariantAnnotated,-      Mantle.TypeVariantApplication,-      Mantle.TypeVariantFunction,-      Mantle.TypeVariantLambda,-      Mantle.TypeVariantList,-      Mantle.TypeVariantLiteral,-      Mantle.TypeVariantMap,-      Mantle.TypeVariantOptional,-      Mantle.TypeVariantProduct,-      Mantle.TypeVariantRecord,-      Mantle.TypeVariantSet,-      Mantle.TypeVariantUnion,-      Mantle.TypeVariantVariable,-      Mantle.TypeVariantWrap]),-    Coders.languageConstraintsTypes = (\x -> case x of-      Core.TypeProduct v319 -> (Equality.ltInt32 (Lists.length v319) javaMaxTupleLength)-      _ -> True)}}---- | A set of reserved words in Java-reservedWords :: (Set String)-reservedWords = (Sets.fromList (Lists.concat [-  specialNames,-  classNames,-  keywords,-  literals])) -  where -    specialNames = [-      "Elements"]-    classNames = [-      "AbstractMethodError",-      "Appendable",-      "ArithmeticException",-      "ArrayIndexOutOfBoundsException",-      "ArrayStoreException",-      "AssertionError",-      "AutoCloseable",-      "Boolean",-      "BootstrapMethodError",-      "Byte",-      "CharSequence",-      "Character",-      "Class",-      "ClassCastException",-      "ClassCircularityError",-      "ClassFormatError",-      "ClassLoader",-      "ClassNotFoundException",-      "ClassValue",-      "CloneNotSupportedException",-      "Cloneable",-      "Comparable",-      "Compiler",-      "Deprecated",-      "Double",-      "Enum",-      "EnumConstantNotPresentException",-      "Error",-      "Exception",-      "ExceptionInInitializerError",-      "Float",-      "IllegalAccessError",-      "IllegalAccessException",-      "IllegalArgumentException",-      "IllegalMonitorStateException",-      "IllegalStateException",-      "IllegalThreadStateException",-      "IncompatibleClassChangeError",-      "IndexOutOfBoundsException",-      "InheritableThreadLocal",-      "InstantiationError",-      "InstantiationException",-      "Integer",-      "InternalError",-      "InterruptedException",-      "Iterable",-      "LinkageError",-      "Long",-      "Math",-      "NegativeArraySizeException",-      "NoClassDefFoundError",-      "NoSuchFieldError",-      "NoSuchFieldException",-      "NoSuchMethodError",-      "NoSuchMethodException",-      "NullPointerException",-      "Number",-      "NumberFormatException",-      "Object",-      "OutOfMemoryError",-      "Override",-      "Package",-      "Process",-      "ProcessBuilder",-      "Readable",-      "ReflectiveOperationException",-      "Runnable",-      "Runtime",-      "RuntimeException",-      "RuntimePermission",-      "SafeVarargs",-      "SecurityException",-      "SecurityManager",-      "Short",-      "StackOverflowError",-      "StackTraceElement",-      "StrictMath",-      "String",-      "StringBuffer",-      "StringBuilder",-      "StringIndexOutOfBoundsException",-      "SuppressWarnings",-      "System",-      "Thread",-      "ThreadDeath",-      "ThreadGroup",-      "ThreadLocal",-      "Throwable",-      "TypeNotPresentException",-      "UnknownError",-      "UnsatisfiedLinkError",-      "UnsupportedClassVersionError",-      "UnsupportedOperationException",-      "VerifyError",-      "VirtualMachineError",-      "Void"]-    keywords = [-      "abstract",-      "assert",-      "boolean",-      "break",-      "byte",-      "case",-      "catch",-      "char",-      "class",-      "const",-      "continue",-      "default",-      "do",-      "double",-      "else",-      "enum",-      "extends",-      "final",-      "finally",-      "float",-      "for",-      "goto",-      "if",-      "implements",-      "import",-      "instanceof",-      "int",-      "interface",-      "long",-      "native",-      "new",-      "package",-      "private",-      "protected",-      "public",-      "return",-      "short",-      "static",-      "strictfp",-      "super",-      "switch",-      "synchronized",-      "this",-      "throw",-      "throws",-      "transient",-      "try",-      "void",-      "volatile",-      "while"]-    literals = [-      "false",-      "null",-      "true"]
− src/gen-main/haskell/Hydra/Ext/Java/Syntax.hs 
@@ -1,3276 +0,0 @@--- | A Java syntax module. Based on the Oracle Java SE 12 BNF:--- |   https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html--- | Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments.--module Hydra.Ext.Java.Syntax where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--newtype Identifier = -  Identifier {-    unIdentifier :: String}-  deriving (Eq, Ord, Read, Show)--_Identifier = (Core.Name "hydra/ext/java/syntax.Identifier")--newtype TypeIdentifier = -  TypeIdentifier {-    unTypeIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_TypeIdentifier = (Core.Name "hydra/ext/java/syntax.TypeIdentifier")--data Literal = -  LiteralNull  |-  LiteralInteger IntegerLiteral |-  LiteralFloatingPoint FloatingPointLiteral |-  LiteralBoolean Bool |-  LiteralCharacter Int |-  LiteralString StringLiteral-  deriving (Eq, Ord, Read, Show)--_Literal = (Core.Name "hydra/ext/java/syntax.Literal")--_Literal_null = (Core.Name "null")--_Literal_integer = (Core.Name "integer")--_Literal_floatingPoint = (Core.Name "floatingPoint")--_Literal_boolean = (Core.Name "boolean")--_Literal_character = (Core.Name "character")--_Literal_string = (Core.Name "string")---- | Note: this is an approximation which ignores encoding-newtype IntegerLiteral = -  IntegerLiteral {-    unIntegerLiteral :: Integer}-  deriving (Eq, Ord, Read, Show)--_IntegerLiteral = (Core.Name "hydra/ext/java/syntax.IntegerLiteral")---- | Note: this is an approximation which ignores encoding-newtype FloatingPointLiteral = -  FloatingPointLiteral {-    unFloatingPointLiteral :: Double}-  deriving (Eq, Ord, Read, Show)--_FloatingPointLiteral = (Core.Name "hydra/ext/java/syntax.FloatingPointLiteral")---- | Note: this is an approximation which ignores encoding-newtype StringLiteral = -  StringLiteral {-    unStringLiteral :: String}-  deriving (Eq, Ord, Read, Show)--_StringLiteral = (Core.Name "hydra/ext/java/syntax.StringLiteral")--data Type = -  TypePrimitive PrimitiveTypeWithAnnotations |-  TypeReference ReferenceType-  deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/java/syntax.Type")--_Type_primitive = (Core.Name "primitive")--_Type_reference = (Core.Name "reference")--data PrimitiveTypeWithAnnotations = -  PrimitiveTypeWithAnnotations {-    primitiveTypeWithAnnotationsType :: PrimitiveType,-    primitiveTypeWithAnnotationsAnnotations :: [Annotation]}-  deriving (Eq, Ord, Read, Show)--_PrimitiveTypeWithAnnotations = (Core.Name "hydra/ext/java/syntax.PrimitiveTypeWithAnnotations")--_PrimitiveTypeWithAnnotations_type = (Core.Name "type")--_PrimitiveTypeWithAnnotations_annotations = (Core.Name "annotations")--data PrimitiveType = -  PrimitiveTypeNumeric NumericType |-  PrimitiveTypeBoolean -  deriving (Eq, Ord, Read, Show)--_PrimitiveType = (Core.Name "hydra/ext/java/syntax.PrimitiveType")--_PrimitiveType_numeric = (Core.Name "numeric")--_PrimitiveType_boolean = (Core.Name "boolean")--data NumericType = -  NumericTypeIntegral IntegralType |-  NumericTypeFloatingPoint FloatingPointType-  deriving (Eq, Ord, Read, Show)--_NumericType = (Core.Name "hydra/ext/java/syntax.NumericType")--_NumericType_integral = (Core.Name "integral")--_NumericType_floatingPoint = (Core.Name "floatingPoint")--data IntegralType = -  IntegralTypeByte  |-  IntegralTypeShort  |-  IntegralTypeInt  |-  IntegralTypeLong  |-  IntegralTypeChar -  deriving (Eq, Ord, Read, Show)--_IntegralType = (Core.Name "hydra/ext/java/syntax.IntegralType")--_IntegralType_byte = (Core.Name "byte")--_IntegralType_short = (Core.Name "short")--_IntegralType_int = (Core.Name "int")--_IntegralType_long = (Core.Name "long")--_IntegralType_char = (Core.Name "char")--data FloatingPointType = -  FloatingPointTypeFloat  |-  FloatingPointTypeDouble -  deriving (Eq, Ord, Read, Show)--_FloatingPointType = (Core.Name "hydra/ext/java/syntax.FloatingPointType")--_FloatingPointType_float = (Core.Name "float")--_FloatingPointType_double = (Core.Name "double")--data ReferenceType = -  ReferenceTypeClassOrInterface ClassOrInterfaceType |-  ReferenceTypeVariable TypeVariable |-  ReferenceTypeArray ArrayType-  deriving (Eq, Ord, Read, Show)--_ReferenceType = (Core.Name "hydra/ext/java/syntax.ReferenceType")--_ReferenceType_classOrInterface = (Core.Name "classOrInterface")--_ReferenceType_variable = (Core.Name "variable")--_ReferenceType_array = (Core.Name "array")--data ClassOrInterfaceType = -  ClassOrInterfaceTypeClass ClassType |-  ClassOrInterfaceTypeInterface InterfaceType-  deriving (Eq, Ord, Read, Show)--_ClassOrInterfaceType = (Core.Name "hydra/ext/java/syntax.ClassOrInterfaceType")--_ClassOrInterfaceType_class = (Core.Name "class")--_ClassOrInterfaceType_interface = (Core.Name "interface")--data ClassType = -  ClassType {-    classTypeAnnotations :: [Annotation],-    classTypeQualifier :: ClassTypeQualifier,-    classTypeIdentifier :: TypeIdentifier,-    classTypeArguments :: [TypeArgument]}-  deriving (Eq, Ord, Read, Show)--_ClassType = (Core.Name "hydra/ext/java/syntax.ClassType")--_ClassType_annotations = (Core.Name "annotations")--_ClassType_qualifier = (Core.Name "qualifier")--_ClassType_identifier = (Core.Name "identifier")--_ClassType_arguments = (Core.Name "arguments")--data ClassTypeQualifier = -  ClassTypeQualifierNone  |-  ClassTypeQualifierPackage PackageName |-  ClassTypeQualifierParent ClassOrInterfaceType-  deriving (Eq, Ord, Read, Show)--_ClassTypeQualifier = (Core.Name "hydra/ext/java/syntax.ClassTypeQualifier")--_ClassTypeQualifier_none = (Core.Name "none")--_ClassTypeQualifier_package = (Core.Name "package")--_ClassTypeQualifier_parent = (Core.Name "parent")--newtype InterfaceType = -  InterfaceType {-    unInterfaceType :: ClassType}-  deriving (Eq, Ord, Read, Show)--_InterfaceType = (Core.Name "hydra/ext/java/syntax.InterfaceType")--data TypeVariable = -  TypeVariable {-    typeVariableAnnotations :: [Annotation],-    typeVariableIdentifier :: TypeIdentifier}-  deriving (Eq, Ord, Read, Show)--_TypeVariable = (Core.Name "hydra/ext/java/syntax.TypeVariable")--_TypeVariable_annotations = (Core.Name "annotations")--_TypeVariable_identifier = (Core.Name "identifier")--data ArrayType = -  ArrayType {-    arrayTypeDims :: Dims,-    arrayTypeVariant :: ArrayType_Variant}-  deriving (Eq, Ord, Read, Show)--_ArrayType = (Core.Name "hydra/ext/java/syntax.ArrayType")--_ArrayType_dims = (Core.Name "dims")--_ArrayType_variant = (Core.Name "variant")--data ArrayType_Variant = -  ArrayType_VariantPrimitive PrimitiveTypeWithAnnotations |-  ArrayType_VariantClassOrInterface ClassOrInterfaceType |-  ArrayType_VariantVariable TypeVariable-  deriving (Eq, Ord, Read, Show)--_ArrayType_Variant = (Core.Name "hydra/ext/java/syntax.ArrayType.Variant")--_ArrayType_Variant_primitive = (Core.Name "primitive")--_ArrayType_Variant_classOrInterface = (Core.Name "classOrInterface")--_ArrayType_Variant_variable = (Core.Name "variable")--newtype Dims = -  Dims {-    unDims :: [[Annotation]]}-  deriving (Eq, Ord, Read, Show)--_Dims = (Core.Name "hydra/ext/java/syntax.Dims")--data TypeParameter = -  TypeParameter {-    typeParameterModifiers :: [TypeParameterModifier],-    typeParameterIdentifier :: TypeIdentifier,-    typeParameterBound :: (Maybe TypeBound)}-  deriving (Eq, Ord, Read, Show)--_TypeParameter = (Core.Name "hydra/ext/java/syntax.TypeParameter")--_TypeParameter_modifiers = (Core.Name "modifiers")--_TypeParameter_identifier = (Core.Name "identifier")--_TypeParameter_bound = (Core.Name "bound")--newtype TypeParameterModifier = -  TypeParameterModifier {-    unTypeParameterModifier :: Annotation}-  deriving (Eq, Ord, Read, Show)--_TypeParameterModifier = (Core.Name "hydra/ext/java/syntax.TypeParameterModifier")--data TypeBound = -  TypeBoundVariable TypeVariable |-  TypeBoundClassOrInterface TypeBound_ClassOrInterface-  deriving (Eq, Ord, Read, Show)--_TypeBound = (Core.Name "hydra/ext/java/syntax.TypeBound")--_TypeBound_variable = (Core.Name "variable")--_TypeBound_classOrInterface = (Core.Name "classOrInterface")--data TypeBound_ClassOrInterface = -  TypeBound_ClassOrInterface {-    typeBound_ClassOrInterfaceType :: ClassOrInterfaceType,-    typeBound_ClassOrInterfaceAdditional :: [AdditionalBound]}-  deriving (Eq, Ord, Read, Show)--_TypeBound_ClassOrInterface = (Core.Name "hydra/ext/java/syntax.TypeBound.ClassOrInterface")--_TypeBound_ClassOrInterface_type = (Core.Name "type")--_TypeBound_ClassOrInterface_additional = (Core.Name "additional")--newtype AdditionalBound = -  AdditionalBound {-    unAdditionalBound :: InterfaceType}-  deriving (Eq, Ord, Read, Show)--_AdditionalBound = (Core.Name "hydra/ext/java/syntax.AdditionalBound")--data TypeArgument = -  TypeArgumentReference ReferenceType |-  TypeArgumentWildcard Wildcard-  deriving (Eq, Ord, Read, Show)--_TypeArgument = (Core.Name "hydra/ext/java/syntax.TypeArgument")--_TypeArgument_reference = (Core.Name "reference")--_TypeArgument_wildcard = (Core.Name "wildcard")--data Wildcard = -  Wildcard {-    wildcardAnnotations :: [Annotation],-    wildcardWildcard :: (Maybe WildcardBounds)}-  deriving (Eq, Ord, Read, Show)--_Wildcard = (Core.Name "hydra/ext/java/syntax.Wildcard")--_Wildcard_annotations = (Core.Name "annotations")--_Wildcard_wildcard = (Core.Name "wildcard")--data WildcardBounds = -  WildcardBoundsExtends ReferenceType |-  WildcardBoundsSuper ReferenceType-  deriving (Eq, Ord, Read, Show)--_WildcardBounds = (Core.Name "hydra/ext/java/syntax.WildcardBounds")--_WildcardBounds_extends = (Core.Name "extends")--_WildcardBounds_super = (Core.Name "super")--data ModuleName = -  ModuleName {-    moduleNameIdentifier :: Identifier,-    moduleNameName :: (Maybe ModuleName)}-  deriving (Eq, Ord, Read, Show)--_ModuleName = (Core.Name "hydra/ext/java/syntax.ModuleName")--_ModuleName_identifier = (Core.Name "identifier")--_ModuleName_name = (Core.Name "name")--newtype PackageName = -  PackageName {-    unPackageName :: [Identifier]}-  deriving (Eq, Ord, Read, Show)--_PackageName = (Core.Name "hydra/ext/java/syntax.PackageName")--data TypeName = -  TypeName {-    typeNameIdentifier :: TypeIdentifier,-    typeNameQualifier :: (Maybe PackageOrTypeName)}-  deriving (Eq, Ord, Read, Show)--_TypeName = (Core.Name "hydra/ext/java/syntax.TypeName")--_TypeName_identifier = (Core.Name "identifier")--_TypeName_qualifier = (Core.Name "qualifier")--data ExpressionName = -  ExpressionName {-    expressionNameQualifier :: (Maybe AmbiguousName),-    expressionNameIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_ExpressionName = (Core.Name "hydra/ext/java/syntax.ExpressionName")--_ExpressionName_qualifier = (Core.Name "qualifier")--_ExpressionName_identifier = (Core.Name "identifier")--newtype MethodName = -  MethodName {-    unMethodName :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MethodName = (Core.Name "hydra/ext/java/syntax.MethodName")--newtype PackageOrTypeName = -  PackageOrTypeName {-    unPackageOrTypeName :: [Identifier]}-  deriving (Eq, Ord, Read, Show)--_PackageOrTypeName = (Core.Name "hydra/ext/java/syntax.PackageOrTypeName")--newtype AmbiguousName = -  AmbiguousName {-    unAmbiguousName :: [Identifier]}-  deriving (Eq, Ord, Read, Show)--_AmbiguousName = (Core.Name "hydra/ext/java/syntax.AmbiguousName")--data CompilationUnit = -  CompilationUnitOrdinary OrdinaryCompilationUnit |-  CompilationUnitModular ModularCompilationUnit-  deriving (Eq, Ord, Read, Show)--_CompilationUnit = (Core.Name "hydra/ext/java/syntax.CompilationUnit")--_CompilationUnit_ordinary = (Core.Name "ordinary")--_CompilationUnit_modular = (Core.Name "modular")--data OrdinaryCompilationUnit = -  OrdinaryCompilationUnit {-    ordinaryCompilationUnitPackage :: (Maybe PackageDeclaration),-    ordinaryCompilationUnitImports :: [ImportDeclaration],-    ordinaryCompilationUnitTypes :: [TypeDeclarationWithComments]}-  deriving (Eq, Ord, Read, Show)--_OrdinaryCompilationUnit = (Core.Name "hydra/ext/java/syntax.OrdinaryCompilationUnit")--_OrdinaryCompilationUnit_package = (Core.Name "package")--_OrdinaryCompilationUnit_imports = (Core.Name "imports")--_OrdinaryCompilationUnit_types = (Core.Name "types")--data ModularCompilationUnit = -  ModularCompilationUnit {-    modularCompilationUnitImports :: [ImportDeclaration],-    modularCompilationUnitModule :: ModuleDeclaration}-  deriving (Eq, Ord, Read, Show)--_ModularCompilationUnit = (Core.Name "hydra/ext/java/syntax.ModularCompilationUnit")--_ModularCompilationUnit_imports = (Core.Name "imports")--_ModularCompilationUnit_module = (Core.Name "module")--data PackageDeclaration = -  PackageDeclaration {-    packageDeclarationModifiers :: [PackageModifier],-    packageDeclarationIdentifiers :: [Identifier]}-  deriving (Eq, Ord, Read, Show)--_PackageDeclaration = (Core.Name "hydra/ext/java/syntax.PackageDeclaration")--_PackageDeclaration_modifiers = (Core.Name "modifiers")--_PackageDeclaration_identifiers = (Core.Name "identifiers")--newtype PackageModifier = -  PackageModifier {-    unPackageModifier :: Annotation}-  deriving (Eq, Ord, Read, Show)--_PackageModifier = (Core.Name "hydra/ext/java/syntax.PackageModifier")--data ImportDeclaration = -  ImportDeclarationSingleType SingleTypeImportDeclaration |-  ImportDeclarationTypeImportOnDemand TypeImportOnDemandDeclaration |-  ImportDeclarationSingleStaticImport SingleStaticImportDeclaration |-  ImportDeclarationStaticImportOnDemand StaticImportOnDemandDeclaration-  deriving (Eq, Ord, Read, Show)--_ImportDeclaration = (Core.Name "hydra/ext/java/syntax.ImportDeclaration")--_ImportDeclaration_singleType = (Core.Name "singleType")--_ImportDeclaration_typeImportOnDemand = (Core.Name "typeImportOnDemand")--_ImportDeclaration_singleStaticImport = (Core.Name "singleStaticImport")--_ImportDeclaration_staticImportOnDemand = (Core.Name "staticImportOnDemand")--newtype SingleTypeImportDeclaration = -  SingleTypeImportDeclaration {-    unSingleTypeImportDeclaration :: TypeName}-  deriving (Eq, Ord, Read, Show)--_SingleTypeImportDeclaration = (Core.Name "hydra/ext/java/syntax.SingleTypeImportDeclaration")--newtype TypeImportOnDemandDeclaration = -  TypeImportOnDemandDeclaration {-    unTypeImportOnDemandDeclaration :: PackageOrTypeName}-  deriving (Eq, Ord, Read, Show)--_TypeImportOnDemandDeclaration = (Core.Name "hydra/ext/java/syntax.TypeImportOnDemandDeclaration")--data SingleStaticImportDeclaration = -  SingleStaticImportDeclaration {-    singleStaticImportDeclarationTypeName :: TypeName,-    singleStaticImportDeclarationIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_SingleStaticImportDeclaration = (Core.Name "hydra/ext/java/syntax.SingleStaticImportDeclaration")--_SingleStaticImportDeclaration_typeName = (Core.Name "typeName")--_SingleStaticImportDeclaration_identifier = (Core.Name "identifier")--newtype StaticImportOnDemandDeclaration = -  StaticImportOnDemandDeclaration {-    unStaticImportOnDemandDeclaration :: TypeName}-  deriving (Eq, Ord, Read, Show)--_StaticImportOnDemandDeclaration = (Core.Name "hydra/ext/java/syntax.StaticImportOnDemandDeclaration")--data TypeDeclaration = -  TypeDeclarationClass ClassDeclaration |-  TypeDeclarationInterface InterfaceDeclaration |-  TypeDeclarationNone -  deriving (Eq, Ord, Read, Show)--_TypeDeclaration = (Core.Name "hydra/ext/java/syntax.TypeDeclaration")--_TypeDeclaration_class = (Core.Name "class")--_TypeDeclaration_interface = (Core.Name "interface")--_TypeDeclaration_none = (Core.Name "none")--data TypeDeclarationWithComments = -  TypeDeclarationWithComments {-    typeDeclarationWithCommentsValue :: TypeDeclaration,-    typeDeclarationWithCommentsComments :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_TypeDeclarationWithComments = (Core.Name "hydra/ext/java/syntax.TypeDeclarationWithComments")--_TypeDeclarationWithComments_value = (Core.Name "value")--_TypeDeclarationWithComments_comments = (Core.Name "comments")--data ModuleDeclaration = -  ModuleDeclaration {-    moduleDeclarationAnnotations :: [Annotation],-    moduleDeclarationOpen :: Bool,-    moduleDeclarationIdentifiers :: [Identifier],-    moduleDeclarationDirectives :: [[ModuleDirective]]}-  deriving (Eq, Ord, Read, Show)--_ModuleDeclaration = (Core.Name "hydra/ext/java/syntax.ModuleDeclaration")--_ModuleDeclaration_annotations = (Core.Name "annotations")--_ModuleDeclaration_open = (Core.Name "open")--_ModuleDeclaration_identifiers = (Core.Name "identifiers")--_ModuleDeclaration_directives = (Core.Name "directives")--data ModuleDirective = -  ModuleDirectiveRequires ModuleDirective_Requires |-  ModuleDirectiveExports ModuleDirective_ExportsOrOpens |-  ModuleDirectiveOpens ModuleDirective_ExportsOrOpens |-  ModuleDirectiveUses TypeName |-  ModuleDirectiveProvides ModuleDirective_Provides-  deriving (Eq, Ord, Read, Show)--_ModuleDirective = (Core.Name "hydra/ext/java/syntax.ModuleDirective")--_ModuleDirective_requires = (Core.Name "requires")--_ModuleDirective_exports = (Core.Name "exports")--_ModuleDirective_opens = (Core.Name "opens")--_ModuleDirective_uses = (Core.Name "uses")--_ModuleDirective_provides = (Core.Name "provides")--data ModuleDirective_Requires = -  ModuleDirective_Requires {-    moduleDirective_RequiresModifiers :: [RequiresModifier],-    moduleDirective_RequiresModule :: ModuleName}-  deriving (Eq, Ord, Read, Show)--_ModuleDirective_Requires = (Core.Name "hydra/ext/java/syntax.ModuleDirective.Requires")--_ModuleDirective_Requires_modifiers = (Core.Name "modifiers")--_ModuleDirective_Requires_module = (Core.Name "module")--data ModuleDirective_ExportsOrOpens = -  ModuleDirective_ExportsOrOpens {-    moduleDirective_ExportsOrOpensPackage :: PackageName,-    -- | At least one module-    moduleDirective_ExportsOrOpensModules :: [ModuleName]}-  deriving (Eq, Ord, Read, Show)--_ModuleDirective_ExportsOrOpens = (Core.Name "hydra/ext/java/syntax.ModuleDirective.ExportsOrOpens")--_ModuleDirective_ExportsOrOpens_package = (Core.Name "package")--_ModuleDirective_ExportsOrOpens_modules = (Core.Name "modules")--data ModuleDirective_Provides = -  ModuleDirective_Provides {-    moduleDirective_ProvidesTo :: TypeName,-    -- | At least one type-    moduleDirective_ProvidesWith :: [TypeName]}-  deriving (Eq, Ord, Read, Show)--_ModuleDirective_Provides = (Core.Name "hydra/ext/java/syntax.ModuleDirective.Provides")--_ModuleDirective_Provides_to = (Core.Name "to")--_ModuleDirective_Provides_with = (Core.Name "with")--data RequiresModifier = -  RequiresModifierTransitive  |-  RequiresModifierStatic -  deriving (Eq, Ord, Read, Show)--_RequiresModifier = (Core.Name "hydra/ext/java/syntax.RequiresModifier")--_RequiresModifier_transitive = (Core.Name "transitive")--_RequiresModifier_static = (Core.Name "static")--data ClassDeclaration = -  ClassDeclarationNormal NormalClassDeclaration |-  ClassDeclarationEnum EnumDeclaration-  deriving (Eq, Ord, Read, Show)--_ClassDeclaration = (Core.Name "hydra/ext/java/syntax.ClassDeclaration")--_ClassDeclaration_normal = (Core.Name "normal")--_ClassDeclaration_enum = (Core.Name "enum")--data NormalClassDeclaration = -  NormalClassDeclaration {-    normalClassDeclarationModifiers :: [ClassModifier],-    normalClassDeclarationIdentifier :: TypeIdentifier,-    normalClassDeclarationParameters :: [TypeParameter],-    normalClassDeclarationExtends :: (Maybe ClassType),-    normalClassDeclarationImplements :: [InterfaceType],-    normalClassDeclarationBody :: ClassBody}-  deriving (Eq, Ord, Read, Show)--_NormalClassDeclaration = (Core.Name "hydra/ext/java/syntax.NormalClassDeclaration")--_NormalClassDeclaration_modifiers = (Core.Name "modifiers")--_NormalClassDeclaration_identifier = (Core.Name "identifier")--_NormalClassDeclaration_parameters = (Core.Name "parameters")--_NormalClassDeclaration_extends = (Core.Name "extends")--_NormalClassDeclaration_implements = (Core.Name "implements")--_NormalClassDeclaration_body = (Core.Name "body")--data ClassModifier = -  ClassModifierAnnotation Annotation |-  ClassModifierPublic  |-  ClassModifierProtected  |-  ClassModifierPrivate  |-  ClassModifierAbstract  |-  ClassModifierStatic  |-  ClassModifierFinal  |-  ClassModifierStrictfp -  deriving (Eq, Ord, Read, Show)--_ClassModifier = (Core.Name "hydra/ext/java/syntax.ClassModifier")--_ClassModifier_annotation = (Core.Name "annotation")--_ClassModifier_public = (Core.Name "public")--_ClassModifier_protected = (Core.Name "protected")--_ClassModifier_private = (Core.Name "private")--_ClassModifier_abstract = (Core.Name "abstract")--_ClassModifier_static = (Core.Name "static")--_ClassModifier_final = (Core.Name "final")--_ClassModifier_strictfp = (Core.Name "strictfp")--newtype ClassBody = -  ClassBody {-    unClassBody :: [ClassBodyDeclarationWithComments]}-  deriving (Eq, Ord, Read, Show)--_ClassBody = (Core.Name "hydra/ext/java/syntax.ClassBody")--data ClassBodyDeclaration = -  ClassBodyDeclarationClassMember ClassMemberDeclaration |-  ClassBodyDeclarationInstanceInitializer InstanceInitializer |-  ClassBodyDeclarationStaticInitializer StaticInitializer |-  ClassBodyDeclarationConstructorDeclaration ConstructorDeclaration-  deriving (Eq, Ord, Read, Show)--_ClassBodyDeclaration = (Core.Name "hydra/ext/java/syntax.ClassBodyDeclaration")--_ClassBodyDeclaration_classMember = (Core.Name "classMember")--_ClassBodyDeclaration_instanceInitializer = (Core.Name "instanceInitializer")--_ClassBodyDeclaration_staticInitializer = (Core.Name "staticInitializer")--_ClassBodyDeclaration_constructorDeclaration = (Core.Name "constructorDeclaration")--data ClassBodyDeclarationWithComments = -  ClassBodyDeclarationWithComments {-    classBodyDeclarationWithCommentsValue :: ClassBodyDeclaration,-    classBodyDeclarationWithCommentsComments :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_ClassBodyDeclarationWithComments = (Core.Name "hydra/ext/java/syntax.ClassBodyDeclarationWithComments")--_ClassBodyDeclarationWithComments_value = (Core.Name "value")--_ClassBodyDeclarationWithComments_comments = (Core.Name "comments")--data ClassMemberDeclaration = -  ClassMemberDeclarationField FieldDeclaration |-  ClassMemberDeclarationMethod MethodDeclaration |-  ClassMemberDeclarationClass ClassDeclaration |-  ClassMemberDeclarationInterface InterfaceDeclaration |-  ClassMemberDeclarationNone -  deriving (Eq, Ord, Read, Show)--_ClassMemberDeclaration = (Core.Name "hydra/ext/java/syntax.ClassMemberDeclaration")--_ClassMemberDeclaration_field = (Core.Name "field")--_ClassMemberDeclaration_method = (Core.Name "method")--_ClassMemberDeclaration_class = (Core.Name "class")--_ClassMemberDeclaration_interface = (Core.Name "interface")--_ClassMemberDeclaration_none = (Core.Name "none")--data FieldDeclaration = -  FieldDeclaration {-    fieldDeclarationModifiers :: [FieldModifier],-    fieldDeclarationUnannType :: UnannType,-    fieldDeclarationVariableDeclarators :: [VariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_FieldDeclaration = (Core.Name "hydra/ext/java/syntax.FieldDeclaration")--_FieldDeclaration_modifiers = (Core.Name "modifiers")--_FieldDeclaration_unannType = (Core.Name "unannType")--_FieldDeclaration_variableDeclarators = (Core.Name "variableDeclarators")--data FieldModifier = -  FieldModifierAnnotation Annotation |-  FieldModifierPublic  |-  FieldModifierProtected  |-  FieldModifierPrivate  |-  FieldModifierStatic  |-  FieldModifierFinal  |-  FieldModifierTransient  |-  FieldModifierVolatile -  deriving (Eq, Ord, Read, Show)--_FieldModifier = (Core.Name "hydra/ext/java/syntax.FieldModifier")--_FieldModifier_annotation = (Core.Name "annotation")--_FieldModifier_public = (Core.Name "public")--_FieldModifier_protected = (Core.Name "protected")--_FieldModifier_private = (Core.Name "private")--_FieldModifier_static = (Core.Name "static")--_FieldModifier_final = (Core.Name "final")--_FieldModifier_transient = (Core.Name "transient")--_FieldModifier_volatile = (Core.Name "volatile")--data VariableDeclarator = -  VariableDeclarator {-    variableDeclaratorId :: VariableDeclaratorId,-    variableDeclaratorInitializer :: (Maybe VariableInitializer)}-  deriving (Eq, Ord, Read, Show)--_VariableDeclarator = (Core.Name "hydra/ext/java/syntax.VariableDeclarator")--_VariableDeclarator_id = (Core.Name "id")--_VariableDeclarator_initializer = (Core.Name "initializer")--data VariableDeclaratorId = -  VariableDeclaratorId {-    variableDeclaratorIdIdentifier :: Identifier,-    variableDeclaratorIdDims :: (Maybe Dims)}-  deriving (Eq, Ord, Read, Show)--_VariableDeclaratorId = (Core.Name "hydra/ext/java/syntax.VariableDeclaratorId")--_VariableDeclaratorId_identifier = (Core.Name "identifier")--_VariableDeclaratorId_dims = (Core.Name "dims")--data VariableInitializer = -  VariableInitializerExpression Expression |-  VariableInitializerArrayInitializer ArrayInitializer-  deriving (Eq, Ord, Read, Show)--_VariableInitializer = (Core.Name "hydra/ext/java/syntax.VariableInitializer")--_VariableInitializer_expression = (Core.Name "expression")--_VariableInitializer_arrayInitializer = (Core.Name "arrayInitializer")---- | A Type which does not allow annotations-newtype UnannType = -  UnannType {-    unUnannType :: Type}-  deriving (Eq, Ord, Read, Show)--_UnannType = (Core.Name "hydra/ext/java/syntax.UnannType")---- | A ClassType which does not allow annotations-newtype UnannClassType = -  UnannClassType {-    unUnannClassType :: ClassType}-  deriving (Eq, Ord, Read, Show)--_UnannClassType = (Core.Name "hydra/ext/java/syntax.UnannClassType")--data MethodDeclaration = -  MethodDeclaration {-    -- | Note: simple methods cannot have annotations-    methodDeclarationAnnotations :: [Annotation],-    methodDeclarationModifiers :: [MethodModifier],-    methodDeclarationHeader :: MethodHeader,-    methodDeclarationBody :: MethodBody}-  deriving (Eq, Ord, Read, Show)--_MethodDeclaration = (Core.Name "hydra/ext/java/syntax.MethodDeclaration")--_MethodDeclaration_annotations = (Core.Name "annotations")--_MethodDeclaration_modifiers = (Core.Name "modifiers")--_MethodDeclaration_header = (Core.Name "header")--_MethodDeclaration_body = (Core.Name "body")--data MethodModifier = -  MethodModifierAnnotation Annotation |-  MethodModifierPublic  |-  MethodModifierProtected  |-  MethodModifierPrivate  |-  MethodModifierAbstract  |-  MethodModifierStatic  |-  MethodModifierFinal  |-  MethodModifierSynchronized  |-  MethodModifierNative  |-  MethodModifierStrictfb -  deriving (Eq, Ord, Read, Show)--_MethodModifier = (Core.Name "hydra/ext/java/syntax.MethodModifier")--_MethodModifier_annotation = (Core.Name "annotation")--_MethodModifier_public = (Core.Name "public")--_MethodModifier_protected = (Core.Name "protected")--_MethodModifier_private = (Core.Name "private")--_MethodModifier_abstract = (Core.Name "abstract")--_MethodModifier_static = (Core.Name "static")--_MethodModifier_final = (Core.Name "final")--_MethodModifier_synchronized = (Core.Name "synchronized")--_MethodModifier_native = (Core.Name "native")--_MethodModifier_strictfb = (Core.Name "strictfb")--data MethodHeader = -  MethodHeader {-    methodHeaderParameters :: [TypeParameter],-    methodHeaderResult :: Result,-    methodHeaderDeclarator :: MethodDeclarator,-    methodHeaderThrows :: (Maybe Throws)}-  deriving (Eq, Ord, Read, Show)--_MethodHeader = (Core.Name "hydra/ext/java/syntax.MethodHeader")--_MethodHeader_parameters = (Core.Name "parameters")--_MethodHeader_result = (Core.Name "result")--_MethodHeader_declarator = (Core.Name "declarator")--_MethodHeader_throws = (Core.Name "throws")--data Result = -  ResultType UnannType |-  ResultVoid -  deriving (Eq, Ord, Read, Show)--_Result = (Core.Name "hydra/ext/java/syntax.Result")--_Result_type = (Core.Name "type")--_Result_void = (Core.Name "void")--data MethodDeclarator = -  MethodDeclarator {-    methodDeclaratorIdentifier :: Identifier,-    methodDeclaratorReceiverParameter :: (Maybe ReceiverParameter),-    methodDeclaratorFormalParameters :: [FormalParameter]}-  deriving (Eq, Ord, Read, Show)--_MethodDeclarator = (Core.Name "hydra/ext/java/syntax.MethodDeclarator")--_MethodDeclarator_identifier = (Core.Name "identifier")--_MethodDeclarator_receiverParameter = (Core.Name "receiverParameter")--_MethodDeclarator_formalParameters = (Core.Name "formalParameters")--data ReceiverParameter = -  ReceiverParameter {-    receiverParameterAnnotations :: [Annotation],-    receiverParameterUnannType :: UnannType,-    receiverParameterIdentifier :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_ReceiverParameter = (Core.Name "hydra/ext/java/syntax.ReceiverParameter")--_ReceiverParameter_annotations = (Core.Name "annotations")--_ReceiverParameter_unannType = (Core.Name "unannType")--_ReceiverParameter_identifier = (Core.Name "identifier")--data FormalParameter = -  FormalParameterSimple FormalParameter_Simple |-  FormalParameterVariableArity VariableArityParameter-  deriving (Eq, Ord, Read, Show)--_FormalParameter = (Core.Name "hydra/ext/java/syntax.FormalParameter")--_FormalParameter_simple = (Core.Name "simple")--_FormalParameter_variableArity = (Core.Name "variableArity")--data FormalParameter_Simple = -  FormalParameter_Simple {-    formalParameter_SimpleModifiers :: [VariableModifier],-    formalParameter_SimpleType :: UnannType,-    formalParameter_SimpleId :: VariableDeclaratorId}-  deriving (Eq, Ord, Read, Show)--_FormalParameter_Simple = (Core.Name "hydra/ext/java/syntax.FormalParameter.Simple")--_FormalParameter_Simple_modifiers = (Core.Name "modifiers")--_FormalParameter_Simple_type = (Core.Name "type")--_FormalParameter_Simple_id = (Core.Name "id")--data VariableArityParameter = -  VariableArityParameter {-    variableArityParameterModifiers :: VariableModifier,-    variableArityParameterType :: UnannType,-    variableArityParameterAnnotations :: [Annotation],-    variableArityParameterIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_VariableArityParameter = (Core.Name "hydra/ext/java/syntax.VariableArityParameter")--_VariableArityParameter_modifiers = (Core.Name "modifiers")--_VariableArityParameter_type = (Core.Name "type")--_VariableArityParameter_annotations = (Core.Name "annotations")--_VariableArityParameter_identifier = (Core.Name "identifier")--data VariableModifier = -  VariableModifierAnnotation Annotation |-  VariableModifierFinal -  deriving (Eq, Ord, Read, Show)--_VariableModifier = (Core.Name "hydra/ext/java/syntax.VariableModifier")--_VariableModifier_annotation = (Core.Name "annotation")--_VariableModifier_final = (Core.Name "final")--newtype Throws = -  Throws {-    unThrows :: [ExceptionType]}-  deriving (Eq, Ord, Read, Show)--_Throws = (Core.Name "hydra/ext/java/syntax.Throws")--data ExceptionType = -  ExceptionTypeClass ClassType |-  ExceptionTypeVariable TypeVariable-  deriving (Eq, Ord, Read, Show)--_ExceptionType = (Core.Name "hydra/ext/java/syntax.ExceptionType")--_ExceptionType_class = (Core.Name "class")--_ExceptionType_variable = (Core.Name "variable")--data MethodBody = -  MethodBodyBlock Block |-  MethodBodyNone -  deriving (Eq, Ord, Read, Show)--_MethodBody = (Core.Name "hydra/ext/java/syntax.MethodBody")--_MethodBody_block = (Core.Name "block")--_MethodBody_none = (Core.Name "none")--newtype InstanceInitializer = -  InstanceInitializer {-    unInstanceInitializer :: Block}-  deriving (Eq, Ord, Read, Show)--_InstanceInitializer = (Core.Name "hydra/ext/java/syntax.InstanceInitializer")--newtype StaticInitializer = -  StaticInitializer {-    unStaticInitializer :: Block}-  deriving (Eq, Ord, Read, Show)--_StaticInitializer = (Core.Name "hydra/ext/java/syntax.StaticInitializer")--data ConstructorDeclaration = -  ConstructorDeclaration {-    constructorDeclarationModifiers :: [ConstructorModifier],-    constructorDeclarationConstructor :: ConstructorDeclarator,-    constructorDeclarationThrows :: (Maybe Throws),-    constructorDeclarationBody :: ConstructorBody}-  deriving (Eq, Ord, Read, Show)--_ConstructorDeclaration = (Core.Name "hydra/ext/java/syntax.ConstructorDeclaration")--_ConstructorDeclaration_modifiers = (Core.Name "modifiers")--_ConstructorDeclaration_constructor = (Core.Name "constructor")--_ConstructorDeclaration_throws = (Core.Name "throws")--_ConstructorDeclaration_body = (Core.Name "body")--data ConstructorModifier = -  ConstructorModifierAnnotation Annotation |-  ConstructorModifierPublic  |-  ConstructorModifierProtected  |-  ConstructorModifierPrivate -  deriving (Eq, Ord, Read, Show)--_ConstructorModifier = (Core.Name "hydra/ext/java/syntax.ConstructorModifier")--_ConstructorModifier_annotation = (Core.Name "annotation")--_ConstructorModifier_public = (Core.Name "public")--_ConstructorModifier_protected = (Core.Name "protected")--_ConstructorModifier_private = (Core.Name "private")--data ConstructorDeclarator = -  ConstructorDeclarator {-    constructorDeclaratorParameters :: [TypeParameter],-    constructorDeclaratorName :: SimpleTypeName,-    constructorDeclaratorReceiverParameter :: (Maybe ReceiverParameter),-    constructorDeclaratorFormalParameters :: [FormalParameter]}-  deriving (Eq, Ord, Read, Show)--_ConstructorDeclarator = (Core.Name "hydra/ext/java/syntax.ConstructorDeclarator")--_ConstructorDeclarator_parameters = (Core.Name "parameters")--_ConstructorDeclarator_name = (Core.Name "name")--_ConstructorDeclarator_receiverParameter = (Core.Name "receiverParameter")--_ConstructorDeclarator_formalParameters = (Core.Name "formalParameters")--newtype SimpleTypeName = -  SimpleTypeName {-    unSimpleTypeName :: TypeIdentifier}-  deriving (Eq, Ord, Read, Show)--_SimpleTypeName = (Core.Name "hydra/ext/java/syntax.SimpleTypeName")--data ConstructorBody = -  ConstructorBody {-    constructorBodyInvocation :: (Maybe ExplicitConstructorInvocation),-    constructorBodyStatements :: [BlockStatement]}-  deriving (Eq, Ord, Read, Show)--_ConstructorBody = (Core.Name "hydra/ext/java/syntax.ConstructorBody")--_ConstructorBody_invocation = (Core.Name "invocation")--_ConstructorBody_statements = (Core.Name "statements")--data ExplicitConstructorInvocation = -  ExplicitConstructorInvocation {-    explicitConstructorInvocationTypeArguments :: [TypeArgument],-    explicitConstructorInvocationArguments :: [Expression],-    explicitConstructorInvocationVariant :: ExplicitConstructorInvocation_Variant}-  deriving (Eq, Ord, Read, Show)--_ExplicitConstructorInvocation = (Core.Name "hydra/ext/java/syntax.ExplicitConstructorInvocation")--_ExplicitConstructorInvocation_typeArguments = (Core.Name "typeArguments")--_ExplicitConstructorInvocation_arguments = (Core.Name "arguments")--_ExplicitConstructorInvocation_variant = (Core.Name "variant")--data ExplicitConstructorInvocation_Variant = -  ExplicitConstructorInvocation_VariantThis  |-  ExplicitConstructorInvocation_VariantSuper (Maybe ExpressionName) |-  ExplicitConstructorInvocation_VariantPrimary Primary-  deriving (Eq, Ord, Read, Show)--_ExplicitConstructorInvocation_Variant = (Core.Name "hydra/ext/java/syntax.ExplicitConstructorInvocation.Variant")--_ExplicitConstructorInvocation_Variant_this = (Core.Name "this")--_ExplicitConstructorInvocation_Variant_super = (Core.Name "super")--_ExplicitConstructorInvocation_Variant_primary = (Core.Name "primary")--data EnumDeclaration = -  EnumDeclaration {-    enumDeclarationModifiers :: [ClassModifier],-    enumDeclarationIdentifier :: TypeIdentifier,-    enumDeclarationImplements :: [InterfaceType],-    enumDeclarationBody :: EnumBody}-  deriving (Eq, Ord, Read, Show)--_EnumDeclaration = (Core.Name "hydra/ext/java/syntax.EnumDeclaration")--_EnumDeclaration_modifiers = (Core.Name "modifiers")--_EnumDeclaration_identifier = (Core.Name "identifier")--_EnumDeclaration_implements = (Core.Name "implements")--_EnumDeclaration_body = (Core.Name "body")--newtype EnumBody = -  EnumBody {-    unEnumBody :: [EnumBody_Element]}-  deriving (Eq, Ord, Read, Show)--_EnumBody = (Core.Name "hydra/ext/java/syntax.EnumBody")--data EnumBody_Element = -  EnumBody_Element {-    enumBody_ElementConstants :: [EnumConstant],-    enumBody_ElementBodyDeclarations :: [ClassBodyDeclaration]}-  deriving (Eq, Ord, Read, Show)--_EnumBody_Element = (Core.Name "hydra/ext/java/syntax.EnumBody.Element")--_EnumBody_Element_constants = (Core.Name "constants")--_EnumBody_Element_bodyDeclarations = (Core.Name "bodyDeclarations")--data EnumConstant = -  EnumConstant {-    enumConstantModifiers :: [EnumConstantModifier],-    enumConstantIdentifier :: Identifier,-    enumConstantArguments :: [[Expression]],-    enumConstantBody :: (Maybe ClassBody)}-  deriving (Eq, Ord, Read, Show)--_EnumConstant = (Core.Name "hydra/ext/java/syntax.EnumConstant")--_EnumConstant_modifiers = (Core.Name "modifiers")--_EnumConstant_identifier = (Core.Name "identifier")--_EnumConstant_arguments = (Core.Name "arguments")--_EnumConstant_body = (Core.Name "body")--newtype EnumConstantModifier = -  EnumConstantModifier {-    unEnumConstantModifier :: Annotation}-  deriving (Eq, Ord, Read, Show)--_EnumConstantModifier = (Core.Name "hydra/ext/java/syntax.EnumConstantModifier")--data InterfaceDeclaration = -  InterfaceDeclarationNormalInterface NormalInterfaceDeclaration |-  InterfaceDeclarationAnnotationType AnnotationTypeDeclaration-  deriving (Eq, Ord, Read, Show)--_InterfaceDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceDeclaration")--_InterfaceDeclaration_normalInterface = (Core.Name "normalInterface")--_InterfaceDeclaration_annotationType = (Core.Name "annotationType")--data NormalInterfaceDeclaration = -  NormalInterfaceDeclaration {-    normalInterfaceDeclarationModifiers :: [InterfaceModifier],-    normalInterfaceDeclarationIdentifier :: TypeIdentifier,-    normalInterfaceDeclarationParameters :: [TypeParameter],-    normalInterfaceDeclarationExtends :: [InterfaceType],-    normalInterfaceDeclarationBody :: InterfaceBody}-  deriving (Eq, Ord, Read, Show)--_NormalInterfaceDeclaration = (Core.Name "hydra/ext/java/syntax.NormalInterfaceDeclaration")--_NormalInterfaceDeclaration_modifiers = (Core.Name "modifiers")--_NormalInterfaceDeclaration_identifier = (Core.Name "identifier")--_NormalInterfaceDeclaration_parameters = (Core.Name "parameters")--_NormalInterfaceDeclaration_extends = (Core.Name "extends")--_NormalInterfaceDeclaration_body = (Core.Name "body")--data InterfaceModifier = -  InterfaceModifierAnnotation Annotation |-  InterfaceModifierPublic  |-  InterfaceModifierProtected  |-  InterfaceModifierPrivate  |-  InterfaceModifierAbstract  |-  InterfaceModifierStatic  |-  InterfaceModifierStrictfb -  deriving (Eq, Ord, Read, Show)--_InterfaceModifier = (Core.Name "hydra/ext/java/syntax.InterfaceModifier")--_InterfaceModifier_annotation = (Core.Name "annotation")--_InterfaceModifier_public = (Core.Name "public")--_InterfaceModifier_protected = (Core.Name "protected")--_InterfaceModifier_private = (Core.Name "private")--_InterfaceModifier_abstract = (Core.Name "abstract")--_InterfaceModifier_static = (Core.Name "static")--_InterfaceModifier_strictfb = (Core.Name "strictfb")--newtype InterfaceBody = -  InterfaceBody {-    unInterfaceBody :: [InterfaceMemberDeclaration]}-  deriving (Eq, Ord, Read, Show)--_InterfaceBody = (Core.Name "hydra/ext/java/syntax.InterfaceBody")--data InterfaceMemberDeclaration = -  InterfaceMemberDeclarationConstant ConstantDeclaration |-  InterfaceMemberDeclarationInterfaceMethod InterfaceMethodDeclaration |-  InterfaceMemberDeclarationClass ClassDeclaration |-  InterfaceMemberDeclarationInterface InterfaceDeclaration-  deriving (Eq, Ord, Read, Show)--_InterfaceMemberDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceMemberDeclaration")--_InterfaceMemberDeclaration_constant = (Core.Name "constant")--_InterfaceMemberDeclaration_interfaceMethod = (Core.Name "interfaceMethod")--_InterfaceMemberDeclaration_class = (Core.Name "class")--_InterfaceMemberDeclaration_interface = (Core.Name "interface")--data ConstantDeclaration = -  ConstantDeclaration {-    constantDeclarationModifiers :: [ConstantModifier],-    constantDeclarationType :: UnannType,-    constantDeclarationVariables :: [VariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_ConstantDeclaration = (Core.Name "hydra/ext/java/syntax.ConstantDeclaration")--_ConstantDeclaration_modifiers = (Core.Name "modifiers")--_ConstantDeclaration_type = (Core.Name "type")--_ConstantDeclaration_variables = (Core.Name "variables")--data ConstantModifier = -  ConstantModifierAnnotation Annotation |-  ConstantModifierPublic  |-  ConstantModifierStatic  |-  ConstantModifierFinal -  deriving (Eq, Ord, Read, Show)--_ConstantModifier = (Core.Name "hydra/ext/java/syntax.ConstantModifier")--_ConstantModifier_annotation = (Core.Name "annotation")--_ConstantModifier_public = (Core.Name "public")--_ConstantModifier_static = (Core.Name "static")--_ConstantModifier_final = (Core.Name "final")--data InterfaceMethodDeclaration = -  InterfaceMethodDeclaration {-    interfaceMethodDeclarationModifiers :: [InterfaceMethodModifier],-    interfaceMethodDeclarationHeader :: MethodHeader,-    interfaceMethodDeclarationBody :: MethodBody}-  deriving (Eq, Ord, Read, Show)--_InterfaceMethodDeclaration = (Core.Name "hydra/ext/java/syntax.InterfaceMethodDeclaration")--_InterfaceMethodDeclaration_modifiers = (Core.Name "modifiers")--_InterfaceMethodDeclaration_header = (Core.Name "header")--_InterfaceMethodDeclaration_body = (Core.Name "body")--data InterfaceMethodModifier = -  InterfaceMethodModifierAnnotation Annotation |-  InterfaceMethodModifierPublic  |-  InterfaceMethodModifierPrivate  |-  InterfaceMethodModifierAbstract  |-  InterfaceMethodModifierDefault  |-  InterfaceMethodModifierStatic  |-  InterfaceMethodModifierStrictfp -  deriving (Eq, Ord, Read, Show)--_InterfaceMethodModifier = (Core.Name "hydra/ext/java/syntax.InterfaceMethodModifier")--_InterfaceMethodModifier_annotation = (Core.Name "annotation")--_InterfaceMethodModifier_public = (Core.Name "public")--_InterfaceMethodModifier_private = (Core.Name "private")--_InterfaceMethodModifier_abstract = (Core.Name "abstract")--_InterfaceMethodModifier_default = (Core.Name "default")--_InterfaceMethodModifier_static = (Core.Name "static")--_InterfaceMethodModifier_strictfp = (Core.Name "strictfp")--data AnnotationTypeDeclaration = -  AnnotationTypeDeclaration {-    annotationTypeDeclarationModifiers :: [InterfaceModifier],-    annotationTypeDeclarationIdentifier :: TypeIdentifier,-    annotationTypeDeclarationBody :: AnnotationTypeBody}-  deriving (Eq, Ord, Read, Show)--_AnnotationTypeDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeDeclaration")--_AnnotationTypeDeclaration_modifiers = (Core.Name "modifiers")--_AnnotationTypeDeclaration_identifier = (Core.Name "identifier")--_AnnotationTypeDeclaration_body = (Core.Name "body")--newtype AnnotationTypeBody = -  AnnotationTypeBody {-    unAnnotationTypeBody :: [[AnnotationTypeMemberDeclaration]]}-  deriving (Eq, Ord, Read, Show)--_AnnotationTypeBody = (Core.Name "hydra/ext/java/syntax.AnnotationTypeBody")--data AnnotationTypeMemberDeclaration = -  AnnotationTypeMemberDeclarationAnnotationType AnnotationTypeElementDeclaration |-  AnnotationTypeMemberDeclarationConstant ConstantDeclaration |-  AnnotationTypeMemberDeclarationClass ClassDeclaration |-  AnnotationTypeMemberDeclarationInterface InterfaceDeclaration-  deriving (Eq, Ord, Read, Show)--_AnnotationTypeMemberDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeMemberDeclaration")--_AnnotationTypeMemberDeclaration_annotationType = (Core.Name "annotationType")--_AnnotationTypeMemberDeclaration_constant = (Core.Name "constant")--_AnnotationTypeMemberDeclaration_class = (Core.Name "class")--_AnnotationTypeMemberDeclaration_interface = (Core.Name "interface")--data AnnotationTypeElementDeclaration = -  AnnotationTypeElementDeclaration {-    annotationTypeElementDeclarationModifiers :: [AnnotationTypeElementModifier],-    annotationTypeElementDeclarationType :: UnannType,-    annotationTypeElementDeclarationIdentifier :: Identifier,-    annotationTypeElementDeclarationDims :: (Maybe Dims),-    annotationTypeElementDeclarationDefault :: (Maybe DefaultValue)}-  deriving (Eq, Ord, Read, Show)--_AnnotationTypeElementDeclaration = (Core.Name "hydra/ext/java/syntax.AnnotationTypeElementDeclaration")--_AnnotationTypeElementDeclaration_modifiers = (Core.Name "modifiers")--_AnnotationTypeElementDeclaration_type = (Core.Name "type")--_AnnotationTypeElementDeclaration_identifier = (Core.Name "identifier")--_AnnotationTypeElementDeclaration_dims = (Core.Name "dims")--_AnnotationTypeElementDeclaration_default = (Core.Name "default")--data AnnotationTypeElementModifier = -  AnnotationTypeElementModifierPublic Annotation |-  AnnotationTypeElementModifierAbstract -  deriving (Eq, Ord, Read, Show)--_AnnotationTypeElementModifier = (Core.Name "hydra/ext/java/syntax.AnnotationTypeElementModifier")--_AnnotationTypeElementModifier_public = (Core.Name "public")--_AnnotationTypeElementModifier_abstract = (Core.Name "abstract")--newtype DefaultValue = -  DefaultValue {-    unDefaultValue :: ElementValue}-  deriving (Eq, Ord, Read, Show)--_DefaultValue = (Core.Name "hydra/ext/java/syntax.DefaultValue")--data Annotation = -  AnnotationNormal NormalAnnotation |-  AnnotationMarker MarkerAnnotation |-  AnnotationSingleElement SingleElementAnnotation-  deriving (Eq, Ord, Read, Show)--_Annotation = (Core.Name "hydra/ext/java/syntax.Annotation")--_Annotation_normal = (Core.Name "normal")--_Annotation_marker = (Core.Name "marker")--_Annotation_singleElement = (Core.Name "singleElement")--data NormalAnnotation = -  NormalAnnotation {-    normalAnnotationTypeName :: TypeName,-    normalAnnotationPairs :: [ElementValuePair]}-  deriving (Eq, Ord, Read, Show)--_NormalAnnotation = (Core.Name "hydra/ext/java/syntax.NormalAnnotation")--_NormalAnnotation_typeName = (Core.Name "typeName")--_NormalAnnotation_pairs = (Core.Name "pairs")--data ElementValuePair = -  ElementValuePair {-    elementValuePairKey :: Identifier,-    elementValuePairValue :: ElementValue}-  deriving (Eq, Ord, Read, Show)--_ElementValuePair = (Core.Name "hydra/ext/java/syntax.ElementValuePair")--_ElementValuePair_key = (Core.Name "key")--_ElementValuePair_value = (Core.Name "value")--data ElementValue = -  ElementValueConditionalExpression ConditionalExpression |-  ElementValueElementValueArrayInitializer ElementValueArrayInitializer |-  ElementValueAnnotation Annotation-  deriving (Eq, Ord, Read, Show)--_ElementValue = (Core.Name "hydra/ext/java/syntax.ElementValue")--_ElementValue_conditionalExpression = (Core.Name "conditionalExpression")--_ElementValue_elementValueArrayInitializer = (Core.Name "elementValueArrayInitializer")--_ElementValue_annotation = (Core.Name "annotation")--newtype ElementValueArrayInitializer = -  ElementValueArrayInitializer {-    unElementValueArrayInitializer :: [ElementValue]}-  deriving (Eq, Ord, Read, Show)--_ElementValueArrayInitializer = (Core.Name "hydra/ext/java/syntax.ElementValueArrayInitializer")--newtype MarkerAnnotation = -  MarkerAnnotation {-    unMarkerAnnotation :: TypeName}-  deriving (Eq, Ord, Read, Show)--_MarkerAnnotation = (Core.Name "hydra/ext/java/syntax.MarkerAnnotation")--data SingleElementAnnotation = -  SingleElementAnnotation {-    singleElementAnnotationName :: TypeName,-    singleElementAnnotationValue :: (Maybe ElementValue)}-  deriving (Eq, Ord, Read, Show)--_SingleElementAnnotation = (Core.Name "hydra/ext/java/syntax.SingleElementAnnotation")--_SingleElementAnnotation_name = (Core.Name "name")--_SingleElementAnnotation_value = (Core.Name "value")--newtype ArrayInitializer = -  ArrayInitializer {-    unArrayInitializer :: [[VariableInitializer]]}-  deriving (Eq, Ord, Read, Show)--_ArrayInitializer = (Core.Name "hydra/ext/java/syntax.ArrayInitializer")--newtype Block = -  Block {-    unBlock :: [BlockStatement]}-  deriving (Eq, Ord, Read, Show)--_Block = (Core.Name "hydra/ext/java/syntax.Block")--data BlockStatement = -  BlockStatementLocalVariableDeclaration LocalVariableDeclarationStatement |-  BlockStatementClass ClassDeclaration |-  BlockStatementStatement Statement-  deriving (Eq, Ord, Read, Show)--_BlockStatement = (Core.Name "hydra/ext/java/syntax.BlockStatement")--_BlockStatement_localVariableDeclaration = (Core.Name "localVariableDeclaration")--_BlockStatement_class = (Core.Name "class")--_BlockStatement_statement = (Core.Name "statement")--newtype LocalVariableDeclarationStatement = -  LocalVariableDeclarationStatement {-    unLocalVariableDeclarationStatement :: LocalVariableDeclaration}-  deriving (Eq, Ord, Read, Show)--_LocalVariableDeclarationStatement = (Core.Name "hydra/ext/java/syntax.LocalVariableDeclarationStatement")--data LocalVariableDeclaration = -  LocalVariableDeclaration {-    localVariableDeclarationModifiers :: [VariableModifier],-    localVariableDeclarationType :: LocalVariableType,-    localVariableDeclarationDeclarators :: [VariableDeclarator]}-  deriving (Eq, Ord, Read, Show)--_LocalVariableDeclaration = (Core.Name "hydra/ext/java/syntax.LocalVariableDeclaration")--_LocalVariableDeclaration_modifiers = (Core.Name "modifiers")--_LocalVariableDeclaration_type = (Core.Name "type")--_LocalVariableDeclaration_declarators = (Core.Name "declarators")--data LocalVariableType = -  LocalVariableTypeType UnannType |-  LocalVariableTypeVar -  deriving (Eq, Ord, Read, Show)--_LocalVariableType = (Core.Name "hydra/ext/java/syntax.LocalVariableType")--_LocalVariableType_type = (Core.Name "type")--_LocalVariableType_var = (Core.Name "var")--data Statement = -  StatementWithoutTrailing StatementWithoutTrailingSubstatement |-  StatementLabeled LabeledStatement |-  StatementIfThen IfThenStatement |-  StatementIfThenElse IfThenElseStatement |-  StatementWhile WhileStatement |-  StatementFor ForStatement-  deriving (Eq, Ord, Read, Show)--_Statement = (Core.Name "hydra/ext/java/syntax.Statement")--_Statement_withoutTrailing = (Core.Name "withoutTrailing")--_Statement_labeled = (Core.Name "labeled")--_Statement_ifThen = (Core.Name "ifThen")--_Statement_ifThenElse = (Core.Name "ifThenElse")--_Statement_while = (Core.Name "while")--_Statement_for = (Core.Name "for")--data StatementNoShortIf = -  StatementNoShortIfWithoutTrailing StatementWithoutTrailingSubstatement |-  StatementNoShortIfLabeled LabeledStatementNoShortIf |-  StatementNoShortIfIfThenElse IfThenElseStatementNoShortIf |-  StatementNoShortIfWhile WhileStatementNoShortIf |-  StatementNoShortIfFor ForStatementNoShortIf-  deriving (Eq, Ord, Read, Show)--_StatementNoShortIf = (Core.Name "hydra/ext/java/syntax.StatementNoShortIf")--_StatementNoShortIf_withoutTrailing = (Core.Name "withoutTrailing")--_StatementNoShortIf_labeled = (Core.Name "labeled")--_StatementNoShortIf_ifThenElse = (Core.Name "ifThenElse")--_StatementNoShortIf_while = (Core.Name "while")--_StatementNoShortIf_for = (Core.Name "for")--data StatementWithoutTrailingSubstatement = -  StatementWithoutTrailingSubstatementBlock Block |-  StatementWithoutTrailingSubstatementEmpty EmptyStatement |-  StatementWithoutTrailingSubstatementExpression ExpressionStatement |-  StatementWithoutTrailingSubstatementAssert AssertStatement |-  StatementWithoutTrailingSubstatementSwitch SwitchStatement |-  StatementWithoutTrailingSubstatementDo DoStatement |-  StatementWithoutTrailingSubstatementBreak BreakStatement |-  StatementWithoutTrailingSubstatementContinue ContinueStatement |-  StatementWithoutTrailingSubstatementReturn ReturnStatement |-  StatementWithoutTrailingSubstatementSynchronized SynchronizedStatement |-  StatementWithoutTrailingSubstatementThrow ThrowStatement |-  StatementWithoutTrailingSubstatementTry TryStatement-  deriving (Eq, Ord, Read, Show)--_StatementWithoutTrailingSubstatement = (Core.Name "hydra/ext/java/syntax.StatementWithoutTrailingSubstatement")--_StatementWithoutTrailingSubstatement_block = (Core.Name "block")--_StatementWithoutTrailingSubstatement_empty = (Core.Name "empty")--_StatementWithoutTrailingSubstatement_expression = (Core.Name "expression")--_StatementWithoutTrailingSubstatement_assert = (Core.Name "assert")--_StatementWithoutTrailingSubstatement_switch = (Core.Name "switch")--_StatementWithoutTrailingSubstatement_do = (Core.Name "do")--_StatementWithoutTrailingSubstatement_break = (Core.Name "break")--_StatementWithoutTrailingSubstatement_continue = (Core.Name "continue")--_StatementWithoutTrailingSubstatement_return = (Core.Name "return")--_StatementWithoutTrailingSubstatement_synchronized = (Core.Name "synchronized")--_StatementWithoutTrailingSubstatement_throw = (Core.Name "throw")--_StatementWithoutTrailingSubstatement_try = (Core.Name "try")--data EmptyStatement = -  EmptyStatement {}-  deriving (Eq, Ord, Read, Show)--_EmptyStatement = (Core.Name "hydra/ext/java/syntax.EmptyStatement")--data LabeledStatement = -  LabeledStatement {-    labeledStatementIdentifier :: Identifier,-    labeledStatementStatement :: Statement}-  deriving (Eq, Ord, Read, Show)--_LabeledStatement = (Core.Name "hydra/ext/java/syntax.LabeledStatement")--_LabeledStatement_identifier = (Core.Name "identifier")--_LabeledStatement_statement = (Core.Name "statement")--data LabeledStatementNoShortIf = -  LabeledStatementNoShortIf {-    labeledStatementNoShortIfIdentifier :: Identifier,-    labeledStatementNoShortIfStatement :: StatementNoShortIf}-  deriving (Eq, Ord, Read, Show)--_LabeledStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.LabeledStatementNoShortIf")--_LabeledStatementNoShortIf_identifier = (Core.Name "identifier")--_LabeledStatementNoShortIf_statement = (Core.Name "statement")--newtype ExpressionStatement = -  ExpressionStatement {-    unExpressionStatement :: StatementExpression}-  deriving (Eq, Ord, Read, Show)--_ExpressionStatement = (Core.Name "hydra/ext/java/syntax.ExpressionStatement")--data StatementExpression = -  StatementExpressionAssignment Assignment |-  StatementExpressionPreIncrement PreIncrementExpression |-  StatementExpressionPreDecrement PreDecrementExpression |-  StatementExpressionPostIncrement PostIncrementExpression |-  StatementExpressionPostDecrement PostDecrementExpression |-  StatementExpressionMethodInvocation MethodInvocation |-  StatementExpressionClassInstanceCreation ClassInstanceCreationExpression-  deriving (Eq, Ord, Read, Show)--_StatementExpression = (Core.Name "hydra/ext/java/syntax.StatementExpression")--_StatementExpression_assignment = (Core.Name "assignment")--_StatementExpression_preIncrement = (Core.Name "preIncrement")--_StatementExpression_preDecrement = (Core.Name "preDecrement")--_StatementExpression_postIncrement = (Core.Name "postIncrement")--_StatementExpression_postDecrement = (Core.Name "postDecrement")--_StatementExpression_methodInvocation = (Core.Name "methodInvocation")--_StatementExpression_classInstanceCreation = (Core.Name "classInstanceCreation")--data IfThenStatement = -  IfThenStatement {-    ifThenStatementExpression :: Expression,-    ifThenStatementStatement :: Statement}-  deriving (Eq, Ord, Read, Show)--_IfThenStatement = (Core.Name "hydra/ext/java/syntax.IfThenStatement")--_IfThenStatement_expression = (Core.Name "expression")--_IfThenStatement_statement = (Core.Name "statement")--data IfThenElseStatement = -  IfThenElseStatement {-    ifThenElseStatementCond :: (Maybe Expression),-    ifThenElseStatementThen :: StatementNoShortIf,-    ifThenElseStatementElse :: Statement}-  deriving (Eq, Ord, Read, Show)--_IfThenElseStatement = (Core.Name "hydra/ext/java/syntax.IfThenElseStatement")--_IfThenElseStatement_cond = (Core.Name "cond")--_IfThenElseStatement_then = (Core.Name "then")--_IfThenElseStatement_else = (Core.Name "else")--data IfThenElseStatementNoShortIf = -  IfThenElseStatementNoShortIf {-    ifThenElseStatementNoShortIfCond :: (Maybe Expression),-    ifThenElseStatementNoShortIfThen :: StatementNoShortIf,-    ifThenElseStatementNoShortIfElse :: StatementNoShortIf}-  deriving (Eq, Ord, Read, Show)--_IfThenElseStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.IfThenElseStatementNoShortIf")--_IfThenElseStatementNoShortIf_cond = (Core.Name "cond")--_IfThenElseStatementNoShortIf_then = (Core.Name "then")--_IfThenElseStatementNoShortIf_else = (Core.Name "else")--data AssertStatement = -  AssertStatementSingle Expression |-  AssertStatementPair AssertStatement_Pair-  deriving (Eq, Ord, Read, Show)--_AssertStatement = (Core.Name "hydra/ext/java/syntax.AssertStatement")--_AssertStatement_single = (Core.Name "single")--_AssertStatement_pair = (Core.Name "pair")--data AssertStatement_Pair = -  AssertStatement_Pair {-    assertStatement_PairFirst :: Expression,-    assertStatement_PairSecond :: Expression}-  deriving (Eq, Ord, Read, Show)--_AssertStatement_Pair = (Core.Name "hydra/ext/java/syntax.AssertStatement.Pair")--_AssertStatement_Pair_first = (Core.Name "first")--_AssertStatement_Pair_second = (Core.Name "second")--data SwitchStatement = -  SwitchStatement {-    switchStatementCond :: Expression,-    switchStatementBlock :: SwitchBlock}-  deriving (Eq, Ord, Read, Show)--_SwitchStatement = (Core.Name "hydra/ext/java/syntax.SwitchStatement")--_SwitchStatement_cond = (Core.Name "cond")--_SwitchStatement_block = (Core.Name "block")--newtype SwitchBlock = -  SwitchBlock {-    unSwitchBlock :: [SwitchBlock_Pair]}-  deriving (Eq, Ord, Read, Show)--_SwitchBlock = (Core.Name "hydra/ext/java/syntax.SwitchBlock")--data SwitchBlock_Pair = -  SwitchBlock_Pair {-    switchBlock_PairStatements :: [SwitchBlockStatementGroup],-    switchBlock_PairLabels :: [SwitchLabel]}-  deriving (Eq, Ord, Read, Show)--_SwitchBlock_Pair = (Core.Name "hydra/ext/java/syntax.SwitchBlock.Pair")--_SwitchBlock_Pair_statements = (Core.Name "statements")--_SwitchBlock_Pair_labels = (Core.Name "labels")--data SwitchBlockStatementGroup = -  SwitchBlockStatementGroup {-    switchBlockStatementGroupLabels :: [SwitchLabel],-    switchBlockStatementGroupStatements :: [BlockStatement]}-  deriving (Eq, Ord, Read, Show)--_SwitchBlockStatementGroup = (Core.Name "hydra/ext/java/syntax.SwitchBlockStatementGroup")--_SwitchBlockStatementGroup_labels = (Core.Name "labels")--_SwitchBlockStatementGroup_statements = (Core.Name "statements")--data SwitchLabel = -  SwitchLabelConstant ConstantExpression |-  SwitchLabelEnumConstant EnumConstantName |-  SwitchLabelDefault -  deriving (Eq, Ord, Read, Show)--_SwitchLabel = (Core.Name "hydra/ext/java/syntax.SwitchLabel")--_SwitchLabel_constant = (Core.Name "constant")--_SwitchLabel_enumConstant = (Core.Name "enumConstant")--_SwitchLabel_default = (Core.Name "default")--newtype EnumConstantName = -  EnumConstantName {-    unEnumConstantName :: Identifier}-  deriving (Eq, Ord, Read, Show)--_EnumConstantName = (Core.Name "hydra/ext/java/syntax.EnumConstantName")--data WhileStatement = -  WhileStatement {-    whileStatementCond :: (Maybe Expression),-    whileStatementBody :: Statement}-  deriving (Eq, Ord, Read, Show)--_WhileStatement = (Core.Name "hydra/ext/java/syntax.WhileStatement")--_WhileStatement_cond = (Core.Name "cond")--_WhileStatement_body = (Core.Name "body")--data WhileStatementNoShortIf = -  WhileStatementNoShortIf {-    whileStatementNoShortIfCond :: (Maybe Expression),-    whileStatementNoShortIfBody :: StatementNoShortIf}-  deriving (Eq, Ord, Read, Show)--_WhileStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.WhileStatementNoShortIf")--_WhileStatementNoShortIf_cond = (Core.Name "cond")--_WhileStatementNoShortIf_body = (Core.Name "body")--data DoStatement = -  DoStatement {-    doStatementBody :: Statement,-    doStatementConde :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_DoStatement = (Core.Name "hydra/ext/java/syntax.DoStatement")--_DoStatement_body = (Core.Name "body")--_DoStatement_conde = (Core.Name "conde")--data ForStatement = -  ForStatementBasic BasicForStatement |-  ForStatementEnhanced EnhancedForStatement-  deriving (Eq, Ord, Read, Show)--_ForStatement = (Core.Name "hydra/ext/java/syntax.ForStatement")--_ForStatement_basic = (Core.Name "basic")--_ForStatement_enhanced = (Core.Name "enhanced")--data ForStatementNoShortIf = -  ForStatementNoShortIfBasic BasicForStatementNoShortIf |-  ForStatementNoShortIfEnhanced EnhancedForStatementNoShortIf-  deriving (Eq, Ord, Read, Show)--_ForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.ForStatementNoShortIf")--_ForStatementNoShortIf_basic = (Core.Name "basic")--_ForStatementNoShortIf_enhanced = (Core.Name "enhanced")--data BasicForStatement = -  BasicForStatement {-    basicForStatementCond :: ForCond,-    basicForStatementBody :: Statement}-  deriving (Eq, Ord, Read, Show)--_BasicForStatement = (Core.Name "hydra/ext/java/syntax.BasicForStatement")--_BasicForStatement_cond = (Core.Name "cond")--_BasicForStatement_body = (Core.Name "body")--data ForCond = -  ForCond {-    forCondInit :: (Maybe ForInit),-    forCondCond :: (Maybe Expression),-    forCondUpdate :: (Maybe ForUpdate)}-  deriving (Eq, Ord, Read, Show)--_ForCond = (Core.Name "hydra/ext/java/syntax.ForCond")--_ForCond_init = (Core.Name "init")--_ForCond_cond = (Core.Name "cond")--_ForCond_update = (Core.Name "update")--data BasicForStatementNoShortIf = -  BasicForStatementNoShortIf {-    basicForStatementNoShortIfCond :: ForCond,-    basicForStatementNoShortIfBody :: StatementNoShortIf}-  deriving (Eq, Ord, Read, Show)--_BasicForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.BasicForStatementNoShortIf")--_BasicForStatementNoShortIf_cond = (Core.Name "cond")--_BasicForStatementNoShortIf_body = (Core.Name "body")--data ForInit = -  ForInitStatements [StatementExpression] |-  ForInitLocalVariable LocalVariableDeclaration-  deriving (Eq, Ord, Read, Show)--_ForInit = (Core.Name "hydra/ext/java/syntax.ForInit")--_ForInit_statements = (Core.Name "statements")--_ForInit_localVariable = (Core.Name "localVariable")--newtype ForUpdate = -  ForUpdate {-    unForUpdate :: [StatementExpression]}-  deriving (Eq, Ord, Read, Show)--_ForUpdate = (Core.Name "hydra/ext/java/syntax.ForUpdate")--data EnhancedForStatement = -  EnhancedForStatement {-    enhancedForStatementCond :: EnhancedForCond,-    enhancedForStatementBody :: Statement}-  deriving (Eq, Ord, Read, Show)--_EnhancedForStatement = (Core.Name "hydra/ext/java/syntax.EnhancedForStatement")--_EnhancedForStatement_cond = (Core.Name "cond")--_EnhancedForStatement_body = (Core.Name "body")--data EnhancedForCond = -  EnhancedForCond {-    enhancedForCondModifiers :: [VariableModifier],-    enhancedForCondType :: LocalVariableType,-    enhancedForCondId :: VariableDeclaratorId,-    enhancedForCondExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_EnhancedForCond = (Core.Name "hydra/ext/java/syntax.EnhancedForCond")--_EnhancedForCond_modifiers = (Core.Name "modifiers")--_EnhancedForCond_type = (Core.Name "type")--_EnhancedForCond_id = (Core.Name "id")--_EnhancedForCond_expression = (Core.Name "expression")--data EnhancedForStatementNoShortIf = -  EnhancedForStatementNoShortIf {-    enhancedForStatementNoShortIfCond :: EnhancedForCond,-    enhancedForStatementNoShortIfBody :: StatementNoShortIf}-  deriving (Eq, Ord, Read, Show)--_EnhancedForStatementNoShortIf = (Core.Name "hydra/ext/java/syntax.EnhancedForStatementNoShortIf")--_EnhancedForStatementNoShortIf_cond = (Core.Name "cond")--_EnhancedForStatementNoShortIf_body = (Core.Name "body")--newtype BreakStatement = -  BreakStatement {-    unBreakStatement :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_BreakStatement = (Core.Name "hydra/ext/java/syntax.BreakStatement")--newtype ContinueStatement = -  ContinueStatement {-    unContinueStatement :: (Maybe Identifier)}-  deriving (Eq, Ord, Read, Show)--_ContinueStatement = (Core.Name "hydra/ext/java/syntax.ContinueStatement")--newtype ReturnStatement = -  ReturnStatement {-    unReturnStatement :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_ReturnStatement = (Core.Name "hydra/ext/java/syntax.ReturnStatement")--newtype ThrowStatement = -  ThrowStatement {-    unThrowStatement :: Expression}-  deriving (Eq, Ord, Read, Show)--_ThrowStatement = (Core.Name "hydra/ext/java/syntax.ThrowStatement")--data SynchronizedStatement = -  SynchronizedStatement {-    synchronizedStatementExpression :: Expression,-    synchronizedStatementBlock :: Block}-  deriving (Eq, Ord, Read, Show)--_SynchronizedStatement = (Core.Name "hydra/ext/java/syntax.SynchronizedStatement")--_SynchronizedStatement_expression = (Core.Name "expression")--_SynchronizedStatement_block = (Core.Name "block")--data TryStatement = -  TryStatementSimple TryStatement_Simple |-  TryStatementWithFinally TryStatement_WithFinally |-  TryStatementWithResources TryWithResourcesStatement-  deriving (Eq, Ord, Read, Show)--_TryStatement = (Core.Name "hydra/ext/java/syntax.TryStatement")--_TryStatement_simple = (Core.Name "simple")--_TryStatement_withFinally = (Core.Name "withFinally")--_TryStatement_withResources = (Core.Name "withResources")--data TryStatement_Simple = -  TryStatement_Simple {-    tryStatement_SimpleBlock :: Block,-    tryStatement_SimpleCatches :: Catches}-  deriving (Eq, Ord, Read, Show)--_TryStatement_Simple = (Core.Name "hydra/ext/java/syntax.TryStatement.Simple")--_TryStatement_Simple_block = (Core.Name "block")--_TryStatement_Simple_catches = (Core.Name "catches")--data TryStatement_WithFinally = -  TryStatement_WithFinally {-    tryStatement_WithFinallyBlock :: Block,-    tryStatement_WithFinallyCatches :: (Maybe Catches),-    tryStatement_WithFinallyFinally :: Finally}-  deriving (Eq, Ord, Read, Show)--_TryStatement_WithFinally = (Core.Name "hydra/ext/java/syntax.TryStatement.WithFinally")--_TryStatement_WithFinally_block = (Core.Name "block")--_TryStatement_WithFinally_catches = (Core.Name "catches")--_TryStatement_WithFinally_finally = (Core.Name "finally")--newtype Catches = -  Catches {-    unCatches :: [CatchClause]}-  deriving (Eq, Ord, Read, Show)--_Catches = (Core.Name "hydra/ext/java/syntax.Catches")--data CatchClause = -  CatchClause {-    catchClauseParameter :: (Maybe CatchFormalParameter),-    catchClauseBlock :: Block}-  deriving (Eq, Ord, Read, Show)--_CatchClause = (Core.Name "hydra/ext/java/syntax.CatchClause")--_CatchClause_parameter = (Core.Name "parameter")--_CatchClause_block = (Core.Name "block")--data CatchFormalParameter = -  CatchFormalParameter {-    catchFormalParameterModifiers :: [VariableModifier],-    catchFormalParameterType :: CatchType,-    catchFormalParameterId :: VariableDeclaratorId}-  deriving (Eq, Ord, Read, Show)--_CatchFormalParameter = (Core.Name "hydra/ext/java/syntax.CatchFormalParameter")--_CatchFormalParameter_modifiers = (Core.Name "modifiers")--_CatchFormalParameter_type = (Core.Name "type")--_CatchFormalParameter_id = (Core.Name "id")--data CatchType = -  CatchType {-    catchTypeType :: UnannClassType,-    catchTypeTypes :: [ClassType]}-  deriving (Eq, Ord, Read, Show)--_CatchType = (Core.Name "hydra/ext/java/syntax.CatchType")--_CatchType_type = (Core.Name "type")--_CatchType_types = (Core.Name "types")--newtype Finally = -  Finally {-    unFinally :: Block}-  deriving (Eq, Ord, Read, Show)--_Finally = (Core.Name "hydra/ext/java/syntax.Finally")--data TryWithResourcesStatement = -  TryWithResourcesStatement {-    tryWithResourcesStatementResourceSpecification :: ResourceSpecification,-    tryWithResourcesStatementBlock :: Block,-    tryWithResourcesStatementCatches :: (Maybe Catches),-    tryWithResourcesStatementFinally :: (Maybe Finally)}-  deriving (Eq, Ord, Read, Show)--_TryWithResourcesStatement = (Core.Name "hydra/ext/java/syntax.TryWithResourcesStatement")--_TryWithResourcesStatement_resourceSpecification = (Core.Name "resourceSpecification")--_TryWithResourcesStatement_block = (Core.Name "block")--_TryWithResourcesStatement_catches = (Core.Name "catches")--_TryWithResourcesStatement_finally = (Core.Name "finally")--newtype ResourceSpecification = -  ResourceSpecification {-    unResourceSpecification :: [Resource]}-  deriving (Eq, Ord, Read, Show)--_ResourceSpecification = (Core.Name "hydra/ext/java/syntax.ResourceSpecification")--data Resource = -  ResourceLocal Resource_Local |-  ResourceVariable VariableAccess-  deriving (Eq, Ord, Read, Show)--_Resource = (Core.Name "hydra/ext/java/syntax.Resource")--_Resource_local = (Core.Name "local")--_Resource_variable = (Core.Name "variable")--data Resource_Local = -  Resource_Local {-    resource_LocalModifiers :: [VariableModifier],-    resource_LocalType :: LocalVariableType,-    resource_LocalIdentifier :: Identifier,-    resource_LocalExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_Resource_Local = (Core.Name "hydra/ext/java/syntax.Resource.Local")--_Resource_Local_modifiers = (Core.Name "modifiers")--_Resource_Local_type = (Core.Name "type")--_Resource_Local_identifier = (Core.Name "identifier")--_Resource_Local_expression = (Core.Name "expression")--data VariableAccess = -  VariableAccessExpressionName ExpressionName |-  VariableAccessFieldAccess FieldAccess-  deriving (Eq, Ord, Read, Show)--_VariableAccess = (Core.Name "hydra/ext/java/syntax.VariableAccess")--_VariableAccess_expressionName = (Core.Name "expressionName")--_VariableAccess_fieldAccess = (Core.Name "fieldAccess")--data Primary = -  PrimaryNoNewArray PrimaryNoNewArray |-  PrimaryArrayCreation ArrayCreationExpression-  deriving (Eq, Ord, Read, Show)--_Primary = (Core.Name "hydra/ext/java/syntax.Primary")--_Primary_noNewArray = (Core.Name "noNewArray")--_Primary_arrayCreation = (Core.Name "arrayCreation")--data PrimaryNoNewArray = -  PrimaryNoNewArrayLiteral Literal |-  PrimaryNoNewArrayClassLiteral ClassLiteral |-  PrimaryNoNewArrayThis  |-  PrimaryNoNewArrayDotThis TypeName |-  PrimaryNoNewArrayParens Expression |-  PrimaryNoNewArrayClassInstance ClassInstanceCreationExpression |-  PrimaryNoNewArrayFieldAccess FieldAccess |-  PrimaryNoNewArrayArrayAccess ArrayAccess |-  PrimaryNoNewArrayMethodInvocation MethodInvocation |-  PrimaryNoNewArrayMethodReference MethodReference-  deriving (Eq, Ord, Read, Show)--_PrimaryNoNewArray = (Core.Name "hydra/ext/java/syntax.PrimaryNoNewArray")--_PrimaryNoNewArray_literal = (Core.Name "literal")--_PrimaryNoNewArray_classLiteral = (Core.Name "classLiteral")--_PrimaryNoNewArray_this = (Core.Name "this")--_PrimaryNoNewArray_dotThis = (Core.Name "dotThis")--_PrimaryNoNewArray_parens = (Core.Name "parens")--_PrimaryNoNewArray_classInstance = (Core.Name "classInstance")--_PrimaryNoNewArray_fieldAccess = (Core.Name "fieldAccess")--_PrimaryNoNewArray_arrayAccess = (Core.Name "arrayAccess")--_PrimaryNoNewArray_methodInvocation = (Core.Name "methodInvocation")--_PrimaryNoNewArray_methodReference = (Core.Name "methodReference")--data ClassLiteral = -  ClassLiteralType TypeNameArray |-  ClassLiteralNumericType NumericTypeArray |-  ClassLiteralBoolean BooleanArray |-  ClassLiteralVoid -  deriving (Eq, Ord, Read, Show)--_ClassLiteral = (Core.Name "hydra/ext/java/syntax.ClassLiteral")--_ClassLiteral_type = (Core.Name "type")--_ClassLiteral_numericType = (Core.Name "numericType")--_ClassLiteral_boolean = (Core.Name "boolean")--_ClassLiteral_void = (Core.Name "void")--data TypeNameArray = -  TypeNameArraySimple TypeName |-  TypeNameArrayArray TypeNameArray-  deriving (Eq, Ord, Read, Show)--_TypeNameArray = (Core.Name "hydra/ext/java/syntax.TypeNameArray")--_TypeNameArray_simple = (Core.Name "simple")--_TypeNameArray_array = (Core.Name "array")--data NumericTypeArray = -  NumericTypeArraySimple NumericType |-  NumericTypeArrayArray NumericTypeArray-  deriving (Eq, Ord, Read, Show)--_NumericTypeArray = (Core.Name "hydra/ext/java/syntax.NumericTypeArray")--_NumericTypeArray_simple = (Core.Name "simple")--_NumericTypeArray_array = (Core.Name "array")--data BooleanArray = -  BooleanArraySimple  |-  BooleanArrayArray BooleanArray-  deriving (Eq, Ord, Read, Show)--_BooleanArray = (Core.Name "hydra/ext/java/syntax.BooleanArray")--_BooleanArray_simple = (Core.Name "simple")--_BooleanArray_array = (Core.Name "array")--data ClassInstanceCreationExpression = -  ClassInstanceCreationExpression {-    classInstanceCreationExpressionQualifier :: (Maybe ClassInstanceCreationExpression_Qualifier),-    classInstanceCreationExpressionExpression :: UnqualifiedClassInstanceCreationExpression}-  deriving (Eq, Ord, Read, Show)--_ClassInstanceCreationExpression = (Core.Name "hydra/ext/java/syntax.ClassInstanceCreationExpression")--_ClassInstanceCreationExpression_qualifier = (Core.Name "qualifier")--_ClassInstanceCreationExpression_expression = (Core.Name "expression")--data ClassInstanceCreationExpression_Qualifier = -  ClassInstanceCreationExpression_QualifierExpression ExpressionName |-  ClassInstanceCreationExpression_QualifierPrimary Primary-  deriving (Eq, Ord, Read, Show)--_ClassInstanceCreationExpression_Qualifier = (Core.Name "hydra/ext/java/syntax.ClassInstanceCreationExpression.Qualifier")--_ClassInstanceCreationExpression_Qualifier_expression = (Core.Name "expression")--_ClassInstanceCreationExpression_Qualifier_primary = (Core.Name "primary")--data UnqualifiedClassInstanceCreationExpression = -  UnqualifiedClassInstanceCreationExpression {-    unqualifiedClassInstanceCreationExpressionTypeArguments :: [TypeArgument],-    unqualifiedClassInstanceCreationExpressionClassOrInterface :: ClassOrInterfaceTypeToInstantiate,-    unqualifiedClassInstanceCreationExpressionArguments :: [Expression],-    unqualifiedClassInstanceCreationExpressionBody :: (Maybe ClassBody)}-  deriving (Eq, Ord, Read, Show)--_UnqualifiedClassInstanceCreationExpression = (Core.Name "hydra/ext/java/syntax.UnqualifiedClassInstanceCreationExpression")--_UnqualifiedClassInstanceCreationExpression_typeArguments = (Core.Name "typeArguments")--_UnqualifiedClassInstanceCreationExpression_classOrInterface = (Core.Name "classOrInterface")--_UnqualifiedClassInstanceCreationExpression_arguments = (Core.Name "arguments")--_UnqualifiedClassInstanceCreationExpression_body = (Core.Name "body")--data ClassOrInterfaceTypeToInstantiate = -  ClassOrInterfaceTypeToInstantiate {-    classOrInterfaceTypeToInstantiateIdentifiers :: [AnnotatedIdentifier],-    classOrInterfaceTypeToInstantiateTypeArguments :: (Maybe TypeArgumentsOrDiamond)}-  deriving (Eq, Ord, Read, Show)--_ClassOrInterfaceTypeToInstantiate = (Core.Name "hydra/ext/java/syntax.ClassOrInterfaceTypeToInstantiate")--_ClassOrInterfaceTypeToInstantiate_identifiers = (Core.Name "identifiers")--_ClassOrInterfaceTypeToInstantiate_typeArguments = (Core.Name "typeArguments")--data AnnotatedIdentifier = -  AnnotatedIdentifier {-    annotatedIdentifierAnnotations :: [Annotation],-    annotatedIdentifierIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_AnnotatedIdentifier = (Core.Name "hydra/ext/java/syntax.AnnotatedIdentifier")--_AnnotatedIdentifier_annotations = (Core.Name "annotations")--_AnnotatedIdentifier_identifier = (Core.Name "identifier")--data TypeArgumentsOrDiamond = -  TypeArgumentsOrDiamondArguments [TypeArgument] |-  TypeArgumentsOrDiamondDiamond -  deriving (Eq, Ord, Read, Show)--_TypeArgumentsOrDiamond = (Core.Name "hydra/ext/java/syntax.TypeArgumentsOrDiamond")--_TypeArgumentsOrDiamond_arguments = (Core.Name "arguments")--_TypeArgumentsOrDiamond_diamond = (Core.Name "diamond")--data FieldAccess = -  FieldAccess {-    fieldAccessQualifier :: FieldAccess_Qualifier,-    fieldAccessIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_FieldAccess = (Core.Name "hydra/ext/java/syntax.FieldAccess")--_FieldAccess_qualifier = (Core.Name "qualifier")--_FieldAccess_identifier = (Core.Name "identifier")--data FieldAccess_Qualifier = -  FieldAccess_QualifierPrimary Primary |-  FieldAccess_QualifierSuper  |-  FieldAccess_QualifierTyped TypeName-  deriving (Eq, Ord, Read, Show)--_FieldAccess_Qualifier = (Core.Name "hydra/ext/java/syntax.FieldAccess.Qualifier")--_FieldAccess_Qualifier_primary = (Core.Name "primary")--_FieldAccess_Qualifier_super = (Core.Name "super")--_FieldAccess_Qualifier_typed = (Core.Name "typed")--data ArrayAccess = -  ArrayAccess {-    arrayAccessExpression :: (Maybe Expression),-    arrayAccessVariant :: ArrayAccess_Variant}-  deriving (Eq, Ord, Read, Show)--_ArrayAccess = (Core.Name "hydra/ext/java/syntax.ArrayAccess")--_ArrayAccess_expression = (Core.Name "expression")--_ArrayAccess_variant = (Core.Name "variant")--data ArrayAccess_Variant = -  ArrayAccess_VariantName ExpressionName |-  ArrayAccess_VariantPrimary PrimaryNoNewArray-  deriving (Eq, Ord, Read, Show)--_ArrayAccess_Variant = (Core.Name "hydra/ext/java/syntax.ArrayAccess.Variant")--_ArrayAccess_Variant_name = (Core.Name "name")--_ArrayAccess_Variant_primary = (Core.Name "primary")--data MethodInvocation = -  MethodInvocation {-    methodInvocationHeader :: MethodInvocation_Header,-    methodInvocationArguments :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_MethodInvocation = (Core.Name "hydra/ext/java/syntax.MethodInvocation")--_MethodInvocation_header = (Core.Name "header")--_MethodInvocation_arguments = (Core.Name "arguments")--data MethodInvocation_Header = -  MethodInvocation_HeaderSimple MethodName |-  MethodInvocation_HeaderComplex MethodInvocation_Complex-  deriving (Eq, Ord, Read, Show)--_MethodInvocation_Header = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Header")--_MethodInvocation_Header_simple = (Core.Name "simple")--_MethodInvocation_Header_complex = (Core.Name "complex")--data MethodInvocation_Complex = -  MethodInvocation_Complex {-    methodInvocation_ComplexVariant :: MethodInvocation_Variant,-    methodInvocation_ComplexTypeArguments :: [TypeArgument],-    methodInvocation_ComplexIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MethodInvocation_Complex = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Complex")--_MethodInvocation_Complex_variant = (Core.Name "variant")--_MethodInvocation_Complex_typeArguments = (Core.Name "typeArguments")--_MethodInvocation_Complex_identifier = (Core.Name "identifier")--data MethodInvocation_Variant = -  MethodInvocation_VariantType TypeName |-  MethodInvocation_VariantExpression ExpressionName |-  MethodInvocation_VariantPrimary Primary |-  MethodInvocation_VariantSuper  |-  MethodInvocation_VariantTypeSuper TypeName-  deriving (Eq, Ord, Read, Show)--_MethodInvocation_Variant = (Core.Name "hydra/ext/java/syntax.MethodInvocation.Variant")--_MethodInvocation_Variant_type = (Core.Name "type")--_MethodInvocation_Variant_expression = (Core.Name "expression")--_MethodInvocation_Variant_primary = (Core.Name "primary")--_MethodInvocation_Variant_super = (Core.Name "super")--_MethodInvocation_Variant_typeSuper = (Core.Name "typeSuper")--data MethodReference = -  MethodReferenceExpression MethodReference_Expression |-  MethodReferencePrimary MethodReference_Primary |-  MethodReferenceReferenceType MethodReference_ReferenceType |-  MethodReferenceSuper MethodReference_Super |-  MethodReferenceNew MethodReference_New |-  MethodReferenceArray MethodReference_Array-  deriving (Eq, Ord, Read, Show)--_MethodReference = (Core.Name "hydra/ext/java/syntax.MethodReference")--_MethodReference_expression = (Core.Name "expression")--_MethodReference_primary = (Core.Name "primary")--_MethodReference_referenceType = (Core.Name "referenceType")--_MethodReference_super = (Core.Name "super")--_MethodReference_new = (Core.Name "new")--_MethodReference_array = (Core.Name "array")--data MethodReference_Expression = -  MethodReference_Expression {-    methodReference_ExpressionName :: ExpressionName,-    methodReference_ExpressionTypeArguments :: [TypeArgument],-    methodReference_ExpressionIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MethodReference_Expression = (Core.Name "hydra/ext/java/syntax.MethodReference.Expression")--_MethodReference_Expression_name = (Core.Name "name")--_MethodReference_Expression_typeArguments = (Core.Name "typeArguments")--_MethodReference_Expression_identifier = (Core.Name "identifier")--data MethodReference_Primary = -  MethodReference_Primary {-    methodReference_PrimaryPrimary :: Primary,-    methodReference_PrimaryTypeArguments :: [TypeArgument],-    methodReference_PrimaryIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MethodReference_Primary = (Core.Name "hydra/ext/java/syntax.MethodReference.Primary")--_MethodReference_Primary_primary = (Core.Name "primary")--_MethodReference_Primary_typeArguments = (Core.Name "typeArguments")--_MethodReference_Primary_identifier = (Core.Name "identifier")--data MethodReference_ReferenceType = -  MethodReference_ReferenceType {-    methodReference_ReferenceTypeReferenceType :: ReferenceType,-    methodReference_ReferenceTypeTypeArguments :: [TypeArgument],-    methodReference_ReferenceTypeIdentifier :: Identifier}-  deriving (Eq, Ord, Read, Show)--_MethodReference_ReferenceType = (Core.Name "hydra/ext/java/syntax.MethodReference.ReferenceType")--_MethodReference_ReferenceType_referenceType = (Core.Name "referenceType")--_MethodReference_ReferenceType_typeArguments = (Core.Name "typeArguments")--_MethodReference_ReferenceType_identifier = (Core.Name "identifier")--data MethodReference_Super = -  MethodReference_Super {-    methodReference_SuperTypeArguments :: [TypeArgument],-    methodReference_SuperIdentifier :: Identifier,-    methodReference_SuperSuper :: Bool}-  deriving (Eq, Ord, Read, Show)--_MethodReference_Super = (Core.Name "hydra/ext/java/syntax.MethodReference.Super")--_MethodReference_Super_typeArguments = (Core.Name "typeArguments")--_MethodReference_Super_identifier = (Core.Name "identifier")--_MethodReference_Super_super = (Core.Name "super")--data MethodReference_New = -  MethodReference_New {-    methodReference_NewClassType :: ClassType,-    methodReference_NewTypeArguments :: [TypeArgument]}-  deriving (Eq, Ord, Read, Show)--_MethodReference_New = (Core.Name "hydra/ext/java/syntax.MethodReference.New")--_MethodReference_New_classType = (Core.Name "classType")--_MethodReference_New_typeArguments = (Core.Name "typeArguments")--newtype MethodReference_Array = -  MethodReference_Array {-    unMethodReference_Array :: ArrayType}-  deriving (Eq, Ord, Read, Show)--_MethodReference_Array = (Core.Name "hydra/ext/java/syntax.MethodReference.Array")--data ArrayCreationExpression = -  ArrayCreationExpressionPrimitive ArrayCreationExpression_Primitive |-  ArrayCreationExpressionClassOrInterface ArrayCreationExpression_ClassOrInterface |-  ArrayCreationExpressionPrimitiveArray ArrayCreationExpression_PrimitiveArray |-  ArrayCreationExpressionClassOrInterfaceArray ArrayCreationExpression_ClassOrInterfaceArray-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression")--_ArrayCreationExpression_primitive = (Core.Name "primitive")--_ArrayCreationExpression_classOrInterface = (Core.Name "classOrInterface")--_ArrayCreationExpression_primitiveArray = (Core.Name "primitiveArray")--_ArrayCreationExpression_classOrInterfaceArray = (Core.Name "classOrInterfaceArray")--data ArrayCreationExpression_Primitive = -  ArrayCreationExpression_Primitive {-    arrayCreationExpression_PrimitiveType :: PrimitiveTypeWithAnnotations,-    arrayCreationExpression_PrimitiveDimExprs :: [DimExpr],-    arrayCreationExpression_PrimitiveDims :: (Maybe Dims)}-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression_Primitive = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.Primitive")--_ArrayCreationExpression_Primitive_type = (Core.Name "type")--_ArrayCreationExpression_Primitive_dimExprs = (Core.Name "dimExprs")--_ArrayCreationExpression_Primitive_dims = (Core.Name "dims")--data ArrayCreationExpression_ClassOrInterface = -  ArrayCreationExpression_ClassOrInterface {-    arrayCreationExpression_ClassOrInterfaceType :: ClassOrInterfaceType,-    arrayCreationExpression_ClassOrInterfaceDimExprs :: [DimExpr],-    arrayCreationExpression_ClassOrInterfaceDims :: (Maybe Dims)}-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression_ClassOrInterface = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.ClassOrInterface")--_ArrayCreationExpression_ClassOrInterface_type = (Core.Name "type")--_ArrayCreationExpression_ClassOrInterface_dimExprs = (Core.Name "dimExprs")--_ArrayCreationExpression_ClassOrInterface_dims = (Core.Name "dims")--data ArrayCreationExpression_PrimitiveArray = -  ArrayCreationExpression_PrimitiveArray {-    arrayCreationExpression_PrimitiveArrayType :: PrimitiveTypeWithAnnotations,-    arrayCreationExpression_PrimitiveArrayDims :: [Dims],-    arrayCreationExpression_PrimitiveArrayArray :: ArrayInitializer}-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression_PrimitiveArray = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.PrimitiveArray")--_ArrayCreationExpression_PrimitiveArray_type = (Core.Name "type")--_ArrayCreationExpression_PrimitiveArray_dims = (Core.Name "dims")--_ArrayCreationExpression_PrimitiveArray_array = (Core.Name "array")--data ArrayCreationExpression_ClassOrInterfaceArray = -  ArrayCreationExpression_ClassOrInterfaceArray {-    arrayCreationExpression_ClassOrInterfaceArrayType :: ClassOrInterfaceType,-    arrayCreationExpression_ClassOrInterfaceArrayDims :: [Dims],-    arrayCreationExpression_ClassOrInterfaceArrayArray :: ArrayInitializer}-  deriving (Eq, Ord, Read, Show)--_ArrayCreationExpression_ClassOrInterfaceArray = (Core.Name "hydra/ext/java/syntax.ArrayCreationExpression.ClassOrInterfaceArray")--_ArrayCreationExpression_ClassOrInterfaceArray_type = (Core.Name "type")--_ArrayCreationExpression_ClassOrInterfaceArray_dims = (Core.Name "dims")--_ArrayCreationExpression_ClassOrInterfaceArray_array = (Core.Name "array")--data DimExpr = -  DimExpr {-    dimExprAnnotations :: [Annotation],-    dimExprExpression :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_DimExpr = (Core.Name "hydra/ext/java/syntax.DimExpr")--_DimExpr_annotations = (Core.Name "annotations")--_DimExpr_expression = (Core.Name "expression")--data Expression = -  ExpressionLambda LambdaExpression |-  ExpressionAssignment AssignmentExpression-  deriving (Eq, Ord, Read, Show)--_Expression = (Core.Name "hydra/ext/java/syntax.Expression")--_Expression_lambda = (Core.Name "lambda")--_Expression_assignment = (Core.Name "assignment")--data LambdaExpression = -  LambdaExpression {-    lambdaExpressionParameters :: LambdaParameters,-    lambdaExpressionBody :: LambdaBody}-  deriving (Eq, Ord, Read, Show)--_LambdaExpression = (Core.Name "hydra/ext/java/syntax.LambdaExpression")--_LambdaExpression_parameters = (Core.Name "parameters")--_LambdaExpression_body = (Core.Name "body")--data LambdaParameters = -  LambdaParametersTuple [LambdaParameters] |-  LambdaParametersSingle Identifier-  deriving (Eq, Ord, Read, Show)--_LambdaParameters = (Core.Name "hydra/ext/java/syntax.LambdaParameters")--_LambdaParameters_tuple = (Core.Name "tuple")--_LambdaParameters_single = (Core.Name "single")--data LambdaParameter = -  LambdaParameterNormal LambdaParameter_Normal |-  LambdaParameterVariableArity VariableArityParameter-  deriving (Eq, Ord, Read, Show)--_LambdaParameter = (Core.Name "hydra/ext/java/syntax.LambdaParameter")--_LambdaParameter_normal = (Core.Name "normal")--_LambdaParameter_variableArity = (Core.Name "variableArity")--data LambdaParameter_Normal = -  LambdaParameter_Normal {-    lambdaParameter_NormalModifiers :: [VariableModifier],-    lambdaParameter_NormalType :: LambdaParameterType,-    lambdaParameter_NormalId :: VariableDeclaratorId}-  deriving (Eq, Ord, Read, Show)--_LambdaParameter_Normal = (Core.Name "hydra/ext/java/syntax.LambdaParameter.Normal")--_LambdaParameter_Normal_modifiers = (Core.Name "modifiers")--_LambdaParameter_Normal_type = (Core.Name "type")--_LambdaParameter_Normal_id = (Core.Name "id")--data LambdaParameterType = -  LambdaParameterTypeType UnannType |-  LambdaParameterTypeVar -  deriving (Eq, Ord, Read, Show)--_LambdaParameterType = (Core.Name "hydra/ext/java/syntax.LambdaParameterType")--_LambdaParameterType_type = (Core.Name "type")--_LambdaParameterType_var = (Core.Name "var")--data LambdaBody = -  LambdaBodyExpression Expression |-  LambdaBodyBlock Block-  deriving (Eq, Ord, Read, Show)--_LambdaBody = (Core.Name "hydra/ext/java/syntax.LambdaBody")--_LambdaBody_expression = (Core.Name "expression")--_LambdaBody_block = (Core.Name "block")--data AssignmentExpression = -  AssignmentExpressionConditional ConditionalExpression |-  AssignmentExpressionAssignment Assignment-  deriving (Eq, Ord, Read, Show)--_AssignmentExpression = (Core.Name "hydra/ext/java/syntax.AssignmentExpression")--_AssignmentExpression_conditional = (Core.Name "conditional")--_AssignmentExpression_assignment = (Core.Name "assignment")--data Assignment = -  Assignment {-    assignmentLhs :: LeftHandSide,-    assignmentOp :: AssignmentOperator,-    assignmentExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_Assignment = (Core.Name "hydra/ext/java/syntax.Assignment")--_Assignment_lhs = (Core.Name "lhs")--_Assignment_op = (Core.Name "op")--_Assignment_expression = (Core.Name "expression")--data LeftHandSide = -  LeftHandSideExpressionName ExpressionName |-  LeftHandSideFieldAccess FieldAccess |-  LeftHandSideArrayAccess ArrayAccess-  deriving (Eq, Ord, Read, Show)--_LeftHandSide = (Core.Name "hydra/ext/java/syntax.LeftHandSide")--_LeftHandSide_expressionName = (Core.Name "expressionName")--_LeftHandSide_fieldAccess = (Core.Name "fieldAccess")--_LeftHandSide_arrayAccess = (Core.Name "arrayAccess")--data AssignmentOperator = -  AssignmentOperatorSimple  |-  AssignmentOperatorTimes  |-  AssignmentOperatorDiv  |-  AssignmentOperatorMod  |-  AssignmentOperatorPlus  |-  AssignmentOperatorMinus  |-  AssignmentOperatorShiftLeft  |-  AssignmentOperatorShiftRight  |-  AssignmentOperatorShiftRightZeroFill  |-  AssignmentOperatorAnd  |-  AssignmentOperatorXor  |-  AssignmentOperatorOr -  deriving (Eq, Ord, Read, Show)--_AssignmentOperator = (Core.Name "hydra/ext/java/syntax.AssignmentOperator")--_AssignmentOperator_simple = (Core.Name "simple")--_AssignmentOperator_times = (Core.Name "times")--_AssignmentOperator_div = (Core.Name "div")--_AssignmentOperator_mod = (Core.Name "mod")--_AssignmentOperator_plus = (Core.Name "plus")--_AssignmentOperator_minus = (Core.Name "minus")--_AssignmentOperator_shiftLeft = (Core.Name "shiftLeft")--_AssignmentOperator_shiftRight = (Core.Name "shiftRight")--_AssignmentOperator_shiftRightZeroFill = (Core.Name "shiftRightZeroFill")--_AssignmentOperator_and = (Core.Name "and")--_AssignmentOperator_xor = (Core.Name "xor")--_AssignmentOperator_or = (Core.Name "or")--data ConditionalExpression = -  ConditionalExpressionSimple ConditionalOrExpression |-  ConditionalExpressionTernaryCond ConditionalExpression_TernaryCond |-  ConditionalExpressionTernaryLambda ConditionalExpression_TernaryLambda-  deriving (Eq, Ord, Read, Show)--_ConditionalExpression = (Core.Name "hydra/ext/java/syntax.ConditionalExpression")--_ConditionalExpression_simple = (Core.Name "simple")--_ConditionalExpression_ternaryCond = (Core.Name "ternaryCond")--_ConditionalExpression_ternaryLambda = (Core.Name "ternaryLambda")--data ConditionalExpression_TernaryCond = -  ConditionalExpression_TernaryCond {-    conditionalExpression_TernaryCondCond :: ConditionalOrExpression,-    conditionalExpression_TernaryCondIfTrue :: Expression,-    conditionalExpression_TernaryCondIfFalse :: ConditionalExpression}-  deriving (Eq, Ord, Read, Show)--_ConditionalExpression_TernaryCond = (Core.Name "hydra/ext/java/syntax.ConditionalExpression.TernaryCond")--_ConditionalExpression_TernaryCond_cond = (Core.Name "cond")--_ConditionalExpression_TernaryCond_ifTrue = (Core.Name "ifTrue")--_ConditionalExpression_TernaryCond_ifFalse = (Core.Name "ifFalse")--data ConditionalExpression_TernaryLambda = -  ConditionalExpression_TernaryLambda {-    conditionalExpression_TernaryLambdaCond :: ConditionalOrExpression,-    conditionalExpression_TernaryLambdaIfTrue :: Expression,-    conditionalExpression_TernaryLambdaIfFalse :: LambdaExpression}-  deriving (Eq, Ord, Read, Show)--_ConditionalExpression_TernaryLambda = (Core.Name "hydra/ext/java/syntax.ConditionalExpression.TernaryLambda")--_ConditionalExpression_TernaryLambda_cond = (Core.Name "cond")--_ConditionalExpression_TernaryLambda_ifTrue = (Core.Name "ifTrue")--_ConditionalExpression_TernaryLambda_ifFalse = (Core.Name "ifFalse")--newtype ConditionalOrExpression = -  ConditionalOrExpression {-    unConditionalOrExpression :: [ConditionalAndExpression]}-  deriving (Eq, Ord, Read, Show)--_ConditionalOrExpression = (Core.Name "hydra/ext/java/syntax.ConditionalOrExpression")--newtype ConditionalAndExpression = -  ConditionalAndExpression {-    unConditionalAndExpression :: [InclusiveOrExpression]}-  deriving (Eq, Ord, Read, Show)--_ConditionalAndExpression = (Core.Name "hydra/ext/java/syntax.ConditionalAndExpression")--newtype InclusiveOrExpression = -  InclusiveOrExpression {-    unInclusiveOrExpression :: [ExclusiveOrExpression]}-  deriving (Eq, Ord, Read, Show)--_InclusiveOrExpression = (Core.Name "hydra/ext/java/syntax.InclusiveOrExpression")--newtype ExclusiveOrExpression = -  ExclusiveOrExpression {-    unExclusiveOrExpression :: [AndExpression]}-  deriving (Eq, Ord, Read, Show)--_ExclusiveOrExpression = (Core.Name "hydra/ext/java/syntax.ExclusiveOrExpression")--newtype AndExpression = -  AndExpression {-    unAndExpression :: [EqualityExpression]}-  deriving (Eq, Ord, Read, Show)--_AndExpression = (Core.Name "hydra/ext/java/syntax.AndExpression")--data EqualityExpression = -  EqualityExpressionUnary RelationalExpression |-  EqualityExpressionEqual EqualityExpression_Binary |-  EqualityExpressionNotEqual EqualityExpression_Binary-  deriving (Eq, Ord, Read, Show)--_EqualityExpression = (Core.Name "hydra/ext/java/syntax.EqualityExpression")--_EqualityExpression_unary = (Core.Name "unary")--_EqualityExpression_equal = (Core.Name "equal")--_EqualityExpression_notEqual = (Core.Name "notEqual")--data EqualityExpression_Binary = -  EqualityExpression_Binary {-    equalityExpression_BinaryLhs :: EqualityExpression,-    equalityExpression_BinaryRhs :: RelationalExpression}-  deriving (Eq, Ord, Read, Show)--_EqualityExpression_Binary = (Core.Name "hydra/ext/java/syntax.EqualityExpression.Binary")--_EqualityExpression_Binary_lhs = (Core.Name "lhs")--_EqualityExpression_Binary_rhs = (Core.Name "rhs")--data RelationalExpression = -  RelationalExpressionSimple ShiftExpression |-  RelationalExpressionLessThan RelationalExpression_LessThan |-  RelationalExpressionGreaterThan RelationalExpression_GreaterThan |-  RelationalExpressionLessThanEqual RelationalExpression_LessThanEqual |-  RelationalExpressionGreaterThanEqual RelationalExpression_GreaterThanEqual |-  RelationalExpressionInstanceof RelationalExpression_InstanceOf-  deriving (Eq, Ord, Read, Show)--_RelationalExpression = (Core.Name "hydra/ext/java/syntax.RelationalExpression")--_RelationalExpression_simple = (Core.Name "simple")--_RelationalExpression_lessThan = (Core.Name "lessThan")--_RelationalExpression_greaterThan = (Core.Name "greaterThan")--_RelationalExpression_lessThanEqual = (Core.Name "lessThanEqual")--_RelationalExpression_greaterThanEqual = (Core.Name "greaterThanEqual")--_RelationalExpression_instanceof = (Core.Name "instanceof")--data RelationalExpression_LessThan = -  RelationalExpression_LessThan {-    relationalExpression_LessThanLhs :: RelationalExpression,-    relationalExpression_LessThanRhs :: ShiftExpression}-  deriving (Eq, Ord, Read, Show)--_RelationalExpression_LessThan = (Core.Name "hydra/ext/java/syntax.RelationalExpression.LessThan")--_RelationalExpression_LessThan_lhs = (Core.Name "lhs")--_RelationalExpression_LessThan_rhs = (Core.Name "rhs")--data RelationalExpression_GreaterThan = -  RelationalExpression_GreaterThan {-    relationalExpression_GreaterThanLhs :: RelationalExpression,-    relationalExpression_GreaterThanRhs :: ShiftExpression}-  deriving (Eq, Ord, Read, Show)--_RelationalExpression_GreaterThan = (Core.Name "hydra/ext/java/syntax.RelationalExpression.GreaterThan")--_RelationalExpression_GreaterThan_lhs = (Core.Name "lhs")--_RelationalExpression_GreaterThan_rhs = (Core.Name "rhs")--data RelationalExpression_LessThanEqual = -  RelationalExpression_LessThanEqual {-    relationalExpression_LessThanEqualLhs :: RelationalExpression,-    relationalExpression_LessThanEqualRhs :: ShiftExpression}-  deriving (Eq, Ord, Read, Show)--_RelationalExpression_LessThanEqual = (Core.Name "hydra/ext/java/syntax.RelationalExpression.LessThanEqual")--_RelationalExpression_LessThanEqual_lhs = (Core.Name "lhs")--_RelationalExpression_LessThanEqual_rhs = (Core.Name "rhs")--data RelationalExpression_GreaterThanEqual = -  RelationalExpression_GreaterThanEqual {-    relationalExpression_GreaterThanEqualLhs :: RelationalExpression,-    relationalExpression_GreaterThanEqualRhs :: ShiftExpression}-  deriving (Eq, Ord, Read, Show)--_RelationalExpression_GreaterThanEqual = (Core.Name "hydra/ext/java/syntax.RelationalExpression.GreaterThanEqual")--_RelationalExpression_GreaterThanEqual_lhs = (Core.Name "lhs")--_RelationalExpression_GreaterThanEqual_rhs = (Core.Name "rhs")--data RelationalExpression_InstanceOf = -  RelationalExpression_InstanceOf {-    relationalExpression_InstanceOfLhs :: RelationalExpression,-    relationalExpression_InstanceOfRhs :: ReferenceType}-  deriving (Eq, Ord, Read, Show)--_RelationalExpression_InstanceOf = (Core.Name "hydra/ext/java/syntax.RelationalExpression.InstanceOf")--_RelationalExpression_InstanceOf_lhs = (Core.Name "lhs")--_RelationalExpression_InstanceOf_rhs = (Core.Name "rhs")--data ShiftExpression = -  ShiftExpressionUnary AdditiveExpression |-  ShiftExpressionShiftLeft ShiftExpression_Binary |-  ShiftExpressionShiftRight ShiftExpression_Binary |-  ShiftExpressionShiftRightZeroFill ShiftExpression_Binary-  deriving (Eq, Ord, Read, Show)--_ShiftExpression = (Core.Name "hydra/ext/java/syntax.ShiftExpression")--_ShiftExpression_unary = (Core.Name "unary")--_ShiftExpression_shiftLeft = (Core.Name "shiftLeft")--_ShiftExpression_shiftRight = (Core.Name "shiftRight")--_ShiftExpression_shiftRightZeroFill = (Core.Name "shiftRightZeroFill")--data ShiftExpression_Binary = -  ShiftExpression_Binary {-    shiftExpression_BinaryLhs :: ShiftExpression,-    shiftExpression_BinaryRhs :: AdditiveExpression}-  deriving (Eq, Ord, Read, Show)--_ShiftExpression_Binary = (Core.Name "hydra/ext/java/syntax.ShiftExpression.Binary")--_ShiftExpression_Binary_lhs = (Core.Name "lhs")--_ShiftExpression_Binary_rhs = (Core.Name "rhs")--data AdditiveExpression = -  AdditiveExpressionUnary MultiplicativeExpression |-  AdditiveExpressionPlus AdditiveExpression_Binary |-  AdditiveExpressionMinus AdditiveExpression_Binary-  deriving (Eq, Ord, Read, Show)--_AdditiveExpression = (Core.Name "hydra/ext/java/syntax.AdditiveExpression")--_AdditiveExpression_unary = (Core.Name "unary")--_AdditiveExpression_plus = (Core.Name "plus")--_AdditiveExpression_minus = (Core.Name "minus")--data AdditiveExpression_Binary = -  AdditiveExpression_Binary {-    additiveExpression_BinaryLhs :: AdditiveExpression,-    additiveExpression_BinaryRhs :: MultiplicativeExpression}-  deriving (Eq, Ord, Read, Show)--_AdditiveExpression_Binary = (Core.Name "hydra/ext/java/syntax.AdditiveExpression.Binary")--_AdditiveExpression_Binary_lhs = (Core.Name "lhs")--_AdditiveExpression_Binary_rhs = (Core.Name "rhs")--data MultiplicativeExpression = -  MultiplicativeExpressionUnary UnaryExpression |-  MultiplicativeExpressionTimes MultiplicativeExpression_Binary |-  MultiplicativeExpressionDivide MultiplicativeExpression_Binary |-  MultiplicativeExpressionMod MultiplicativeExpression_Binary-  deriving (Eq, Ord, Read, Show)--_MultiplicativeExpression = (Core.Name "hydra/ext/java/syntax.MultiplicativeExpression")--_MultiplicativeExpression_unary = (Core.Name "unary")--_MultiplicativeExpression_times = (Core.Name "times")--_MultiplicativeExpression_divide = (Core.Name "divide")--_MultiplicativeExpression_mod = (Core.Name "mod")--data MultiplicativeExpression_Binary = -  MultiplicativeExpression_Binary {-    multiplicativeExpression_BinaryLhs :: MultiplicativeExpression,-    multiplicativeExpression_BinaryRhs :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_MultiplicativeExpression_Binary = (Core.Name "hydra/ext/java/syntax.MultiplicativeExpression.Binary")--_MultiplicativeExpression_Binary_lhs = (Core.Name "lhs")--_MultiplicativeExpression_Binary_rhs = (Core.Name "rhs")--data UnaryExpression = -  UnaryExpressionPreIncrement PreIncrementExpression |-  UnaryExpressionPreDecrement PreDecrementExpression |-  UnaryExpressionPlus UnaryExpression |-  UnaryExpressionMinus UnaryExpression |-  UnaryExpressionOther UnaryExpressionNotPlusMinus-  deriving (Eq, Ord, Read, Show)--_UnaryExpression = (Core.Name "hydra/ext/java/syntax.UnaryExpression")--_UnaryExpression_preIncrement = (Core.Name "preIncrement")--_UnaryExpression_preDecrement = (Core.Name "preDecrement")--_UnaryExpression_plus = (Core.Name "plus")--_UnaryExpression_minus = (Core.Name "minus")--_UnaryExpression_other = (Core.Name "other")--newtype PreIncrementExpression = -  PreIncrementExpression {-    unPreIncrementExpression :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_PreIncrementExpression = (Core.Name "hydra/ext/java/syntax.PreIncrementExpression")--newtype PreDecrementExpression = -  PreDecrementExpression {-    unPreDecrementExpression :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_PreDecrementExpression = (Core.Name "hydra/ext/java/syntax.PreDecrementExpression")--data UnaryExpressionNotPlusMinus = -  UnaryExpressionNotPlusMinusPostfix PostfixExpression |-  UnaryExpressionNotPlusMinusTilde UnaryExpression |-  UnaryExpressionNotPlusMinusNot UnaryExpression |-  UnaryExpressionNotPlusMinusCast CastExpression-  deriving (Eq, Ord, Read, Show)--_UnaryExpressionNotPlusMinus = (Core.Name "hydra/ext/java/syntax.UnaryExpressionNotPlusMinus")--_UnaryExpressionNotPlusMinus_postfix = (Core.Name "postfix")--_UnaryExpressionNotPlusMinus_tilde = (Core.Name "tilde")--_UnaryExpressionNotPlusMinus_not = (Core.Name "not")--_UnaryExpressionNotPlusMinus_cast = (Core.Name "cast")--data PostfixExpression = -  PostfixExpressionPrimary Primary |-  PostfixExpressionName ExpressionName |-  PostfixExpressionPostIncrement PostIncrementExpression |-  PostfixExpressionPostDecrement PostDecrementExpression-  deriving (Eq, Ord, Read, Show)--_PostfixExpression = (Core.Name "hydra/ext/java/syntax.PostfixExpression")--_PostfixExpression_primary = (Core.Name "primary")--_PostfixExpression_name = (Core.Name "name")--_PostfixExpression_postIncrement = (Core.Name "postIncrement")--_PostfixExpression_postDecrement = (Core.Name "postDecrement")--newtype PostIncrementExpression = -  PostIncrementExpression {-    unPostIncrementExpression :: PostfixExpression}-  deriving (Eq, Ord, Read, Show)--_PostIncrementExpression = (Core.Name "hydra/ext/java/syntax.PostIncrementExpression")--newtype PostDecrementExpression = -  PostDecrementExpression {-    unPostDecrementExpression :: PostfixExpression}-  deriving (Eq, Ord, Read, Show)--_PostDecrementExpression = (Core.Name "hydra/ext/java/syntax.PostDecrementExpression")--data CastExpression = -  CastExpressionPrimitive CastExpression_Primitive |-  CastExpressionNotPlusMinus CastExpression_NotPlusMinus |-  CastExpressionLambda CastExpression_Lambda-  deriving (Eq, Ord, Read, Show)--_CastExpression = (Core.Name "hydra/ext/java/syntax.CastExpression")--_CastExpression_primitive = (Core.Name "primitive")--_CastExpression_notPlusMinus = (Core.Name "notPlusMinus")--_CastExpression_lambda = (Core.Name "lambda")--data CastExpression_Primitive = -  CastExpression_Primitive {-    castExpression_PrimitiveType :: PrimitiveTypeWithAnnotations,-    castExpression_PrimitiveExpression :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_CastExpression_Primitive = (Core.Name "hydra/ext/java/syntax.CastExpression.Primitive")--_CastExpression_Primitive_type = (Core.Name "type")--_CastExpression_Primitive_expression = (Core.Name "expression")--data CastExpression_NotPlusMinus = -  CastExpression_NotPlusMinus {-    castExpression_NotPlusMinusRefAndBounds :: CastExpression_RefAndBounds,-    castExpression_NotPlusMinusExpression :: UnaryExpression}-  deriving (Eq, Ord, Read, Show)--_CastExpression_NotPlusMinus = (Core.Name "hydra/ext/java/syntax.CastExpression.NotPlusMinus")--_CastExpression_NotPlusMinus_refAndBounds = (Core.Name "refAndBounds")--_CastExpression_NotPlusMinus_expression = (Core.Name "expression")--data CastExpression_Lambda = -  CastExpression_Lambda {-    castExpression_LambdaRefAndBounds :: CastExpression_RefAndBounds,-    castExpression_LambdaExpression :: LambdaExpression}-  deriving (Eq, Ord, Read, Show)--_CastExpression_Lambda = (Core.Name "hydra/ext/java/syntax.CastExpression.Lambda")--_CastExpression_Lambda_refAndBounds = (Core.Name "refAndBounds")--_CastExpression_Lambda_expression = (Core.Name "expression")--data CastExpression_RefAndBounds = -  CastExpression_RefAndBounds {-    castExpression_RefAndBoundsType :: ReferenceType,-    castExpression_RefAndBoundsBounds :: [AdditionalBound]}-  deriving (Eq, Ord, Read, Show)--_CastExpression_RefAndBounds = (Core.Name "hydra/ext/java/syntax.CastExpression.RefAndBounds")--_CastExpression_RefAndBounds_type = (Core.Name "type")--_CastExpression_RefAndBounds_bounds = (Core.Name "bounds")--newtype ConstantExpression = -  ConstantExpression {-    unConstantExpression :: Expression}-  deriving (Eq, Ord, Read, Show)--_ConstantExpression = (Core.Name "hydra/ext/java/syntax.ConstantExpression")
− src/gen-main/haskell/Hydra/Ext/Org/Apache/Avro/Schema.hs 
@@ -1,222 +0,0 @@--- | A model for Avro schemas. Based on the Avro 1.11.1 specification:--- |   https://avro.apache.org/docs/1.11.1/specification--module Hydra.Ext.Org.Apache.Avro.Schema where--import qualified Hydra.Core as Core-import qualified Hydra.Json as Json-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--data Array = -  Array {-    arrayItems :: Schema}-  deriving (Eq, Ord, Read, Show)--_Array = (Core.Name "hydra/ext/org/apache/avro/schema.Array")--_Array_items = (Core.Name "items")--data Enum_ = -  Enum_ {-    -- | a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* (the same requirement as for names)-    enumSymbols :: [String],-    -- | A default value for this enumeration, used during resolution when the reader encounters a symbol from the writer that isn't defined in the reader's schema. The value provided here must be a JSON string that's a member of the symbols array-    enumDefault :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_Enum = (Core.Name "hydra/ext/org/apache/avro/schema.Enum")--_Enum_symbols = (Core.Name "symbols")--_Enum_default = (Core.Name "default")--data Field = -  Field {-    -- | a JSON string providing the name of the field-    fieldName :: String,-    -- | a JSON string describing this field for users-    fieldDoc :: (Maybe String),-    -- | a schema-    fieldType :: Schema,-    -- | default value for this field, only used when reading instances that lack the field for schema evolution purposes-    fieldDefault :: (Maybe Json.Value),-    -- | specifies how this field impacts sort ordering of this record-    fieldOrder :: (Maybe Order),-    -- | a JSON array of strings, providing alternate names for this field-    fieldAliases :: (Maybe [String]),-    -- | Any additional key/value pairs attached to the field-    fieldAnnotations :: (Map String Json.Value)}-  deriving (Eq, Ord, Read, Show)--_Field = (Core.Name "hydra/ext/org/apache/avro/schema.Field")--_Field_name = (Core.Name "name")--_Field_doc = (Core.Name "doc")--_Field_type = (Core.Name "type")--_Field_default = (Core.Name "default")--_Field_order = (Core.Name "order")--_Field_aliases = (Core.Name "aliases")--_Field_annotations = (Core.Name "annotations")--data Fixed = -  Fixed {-    -- | an integer, specifying the number of bytes per value-    fixedSize :: Int}-  deriving (Eq, Ord, Read, Show)--_Fixed = (Core.Name "hydra/ext/org/apache/avro/schema.Fixed")--_Fixed_size = (Core.Name "size")--data Map_ = -  Map_ {-    mapValues :: Schema}-  deriving (Eq, Ord, Read, Show)--_Map = (Core.Name "hydra/ext/org/apache/avro/schema.Map")--_Map_values = (Core.Name "values")--data Named = -  Named {-    -- | a string naming this schema-    namedName :: String,-    -- | a string that qualifies the name-    namedNamespace :: (Maybe String),-    -- | a JSON array of strings, providing alternate names for this schema-    namedAliases :: (Maybe [String]),-    -- | a JSON string providing documentation to the user of this schema-    namedDoc :: (Maybe String),-    namedType :: NamedType,-    -- | Any additional key/value pairs attached to the type-    namedAnnotations :: (Map String Json.Value)}-  deriving (Eq, Ord, Read, Show)--_Named = (Core.Name "hydra/ext/org/apache/avro/schema.Named")--_Named_name = (Core.Name "name")--_Named_namespace = (Core.Name "namespace")--_Named_aliases = (Core.Name "aliases")--_Named_doc = (Core.Name "doc")--_Named_type = (Core.Name "type")--_Named_annotations = (Core.Name "annotations")--data NamedType = -  NamedTypeEnum Enum_ |-  NamedTypeFixed Fixed |-  NamedTypeRecord Record-  deriving (Eq, Ord, Read, Show)--_NamedType = (Core.Name "hydra/ext/org/apache/avro/schema.NamedType")--_NamedType_enum = (Core.Name "enum")--_NamedType_fixed = (Core.Name "fixed")--_NamedType_record = (Core.Name "record")--data Order = -  OrderAscending  |-  OrderDescending  |-  OrderIgnore -  deriving (Eq, Ord, Read, Show)--_Order = (Core.Name "hydra/ext/org/apache/avro/schema.Order")--_Order_ascending = (Core.Name "ascending")--_Order_descending = (Core.Name "descending")--_Order_ignore = (Core.Name "ignore")--data Primitive = -  -- | no value-  PrimitiveNull  |-  -- | A binary value-  PrimitiveBoolean  |-  -- | 32-bit signed integer-  PrimitiveInt  |-  -- | 64-bit signed integer-  PrimitiveLong  |-  -- | single precision (32-bit) IEEE 754 floating-point number-  PrimitiveFloat  |-  -- | double precision (64-bit) IEEE 754 floating-point number-  PrimitiveDouble  |-  -- | sequence of 8-bit unsigned bytes-  PrimitiveBytes  |-  -- | unicode character sequence-  PrimitiveString -  deriving (Eq, Ord, Read, Show)--_Primitive = (Core.Name "hydra/ext/org/apache/avro/schema.Primitive")--_Primitive_null = (Core.Name "null")--_Primitive_boolean = (Core.Name "boolean")--_Primitive_int = (Core.Name "int")--_Primitive_long = (Core.Name "long")--_Primitive_float = (Core.Name "float")--_Primitive_double = (Core.Name "double")--_Primitive_bytes = (Core.Name "bytes")--_Primitive_string = (Core.Name "string")--data Record = -  Record {-    -- | a JSON array, listing fields-    recordFields :: [Field]}-  deriving (Eq, Ord, Read, Show)--_Record = (Core.Name "hydra/ext/org/apache/avro/schema.Record")--_Record_fields = (Core.Name "fields")--data Schema = -  SchemaArray Array |-  SchemaMap Map_ |-  SchemaNamed Named |-  SchemaPrimitive Primitive |-  -- | A reference by name to a previously defined type-  SchemaReference String |-  SchemaUnion Union-  deriving (Eq, Ord, Read, Show)--_Schema = (Core.Name "hydra/ext/org/apache/avro/schema.Schema")--_Schema_array = (Core.Name "array")--_Schema_map = (Core.Name "map")--_Schema_named = (Core.Name "named")--_Schema_primitive = (Core.Name "primitive")--_Schema_reference = (Core.Name "reference")--_Schema_union = (Core.Name "union")--newtype Union = -  Union {-    unUnion :: [Schema]}-  deriving (Eq, Ord, Read, Show)--_Union = (Core.Name "hydra/ext/org/apache/avro/schema.Union")
− src/gen-main/haskell/Hydra/Ext/Org/Graphql/Syntax.hs 
@@ -1,1299 +0,0 @@--- | A GraphQL model. Based on the (extended) BNF at:--- |   https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary--module Hydra.Ext.Org.Graphql.Syntax where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--newtype Name = -  Name {-    unName :: String}-  deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/org/graphql/syntax.Name")--newtype IntValue = -  IntValue {-    unIntValue :: String}-  deriving (Eq, Ord, Read, Show)--_IntValue = (Core.Name "hydra/ext/org/graphql/syntax.IntValue")--newtype FloatValue = -  FloatValue {-    unFloatValue :: String}-  deriving (Eq, Ord, Read, Show)--_FloatValue = (Core.Name "hydra/ext/org/graphql/syntax.FloatValue")--newtype StringValue = -  StringValue {-    unStringValue :: String}-  deriving (Eq, Ord, Read, Show)--_StringValue = (Core.Name "hydra/ext/org/graphql/syntax.StringValue")--newtype Document = -  Document {-    unDocument :: [Definition]}-  deriving (Eq, Ord, Read, Show)--_Document = (Core.Name "hydra/ext/org/graphql/syntax.Document")--data Definition = -  DefinitionExecutable ExecutableDefinition |-  DefinitionTypeSystem TypeSystemDefinitionOrExtension-  deriving (Eq, Ord, Read, Show)--_Definition = (Core.Name "hydra/ext/org/graphql/syntax.Definition")--_Definition_executable = (Core.Name "executable")--_Definition_typeSystem = (Core.Name "typeSystem")--newtype ExecutableDocument = -  ExecutableDocument {-    unExecutableDocument :: [ExecutableDefinition]}-  deriving (Eq, Ord, Read, Show)--_ExecutableDocument = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDocument")--data ExecutableDefinition = -  ExecutableDefinitionOperation OperationDefinition |-  ExecutableDefinitionFragment FragmentDefinition-  deriving (Eq, Ord, Read, Show)--_ExecutableDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDefinition")--_ExecutableDefinition_operation = (Core.Name "operation")--_ExecutableDefinition_fragment = (Core.Name "fragment")--data OperationDefinition = -  OperationDefinitionSequence OperationDefinition_Sequence |-  OperationDefinitionSelectionSet SelectionSet-  deriving (Eq, Ord, Read, Show)--_OperationDefinition = (Core.Name "hydra/ext/org/graphql/syntax.OperationDefinition")--_OperationDefinition_sequence = (Core.Name "sequence")--_OperationDefinition_selectionSet = (Core.Name "selectionSet")--data OperationDefinition_Sequence = -  OperationDefinition_Sequence {-    operationDefinition_SequenceOperationType :: OperationType,-    operationDefinition_SequenceName :: (Maybe Name),-    operationDefinition_SequenceVariablesDefinition :: (Maybe VariablesDefinition),-    operationDefinition_SequenceDirectives :: (Maybe Directives),-    operationDefinition_SequenceSelectionSet :: SelectionSet}-  deriving (Eq, Ord, Read, Show)--_OperationDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.OperationDefinition.Sequence")--_OperationDefinition_Sequence_operationType = (Core.Name "operationType")--_OperationDefinition_Sequence_name = (Core.Name "name")--_OperationDefinition_Sequence_variablesDefinition = (Core.Name "variablesDefinition")--_OperationDefinition_Sequence_directives = (Core.Name "directives")--_OperationDefinition_Sequence_selectionSet = (Core.Name "selectionSet")--data OperationType = -  OperationTypeQuery  |-  OperationTypeMutation  |-  OperationTypeSubscription -  deriving (Eq, Ord, Read, Show)--_OperationType = (Core.Name "hydra/ext/org/graphql/syntax.OperationType")--_OperationType_query = (Core.Name "query")--_OperationType_mutation = (Core.Name "mutation")--_OperationType_subscription = (Core.Name "subscription")--newtype SelectionSet = -  SelectionSet {-    unSelectionSet :: [Selection]}-  deriving (Eq, Ord, Read, Show)--_SelectionSet = (Core.Name "hydra/ext/org/graphql/syntax.SelectionSet")--data Selection = -  SelectionField Field |-  SelectionFragmentSpread FragmentSpread |-  SelectionInlineFragment InlineFragment-  deriving (Eq, Ord, Read, Show)--_Selection = (Core.Name "hydra/ext/org/graphql/syntax.Selection")--_Selection_field = (Core.Name "field")--_Selection_fragmentSpread = (Core.Name "fragmentSpread")--_Selection_inlineFragment = (Core.Name "inlineFragment")--data Field = -  Field {-    fieldAlias :: (Maybe Alias),-    fieldName :: Name,-    fieldArguments :: (Maybe Arguments),-    fieldDirectives :: (Maybe Directives),-    fieldSelectionSet :: (Maybe SelectionSet)}-  deriving (Eq, Ord, Read, Show)--_Field = (Core.Name "hydra/ext/org/graphql/syntax.Field")--_Field_alias = (Core.Name "alias")--_Field_name = (Core.Name "name")--_Field_arguments = (Core.Name "arguments")--_Field_directives = (Core.Name "directives")--_Field_selectionSet = (Core.Name "selectionSet")--data Alias = -  AliasName Name |-  AliasColon -  deriving (Eq, Ord, Read, Show)--_Alias = (Core.Name "hydra/ext/org/graphql/syntax.Alias")--_Alias_name = (Core.Name "name")--_Alias_colon = (Core.Name "colon")--newtype Arguments = -  Arguments {-    unArguments :: [Argument]}-  deriving (Eq, Ord, Read, Show)--_Arguments = (Core.Name "hydra/ext/org/graphql/syntax.Arguments")--data Argument = -  Argument {-    argumentName :: Name,-    argumentValue :: Value}-  deriving (Eq, Ord, Read, Show)--_Argument = (Core.Name "hydra/ext/org/graphql/syntax.Argument")--_Argument_name = (Core.Name "name")--_Argument_value = (Core.Name "value")--data FragmentSpread = -  FragmentSpread {-    fragmentSpreadFragmentName :: FragmentName,-    fragmentSpreadDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_FragmentSpread = (Core.Name "hydra/ext/org/graphql/syntax.FragmentSpread")--_FragmentSpread_fragmentName = (Core.Name "fragmentName")--_FragmentSpread_directives = (Core.Name "directives")--data InlineFragment = -  InlineFragment {-    inlineFragmentTypeCondition :: (Maybe TypeCondition),-    inlineFragmentDirectives :: (Maybe Directives),-    inlineFragmentSelectionSet :: SelectionSet}-  deriving (Eq, Ord, Read, Show)--_InlineFragment = (Core.Name "hydra/ext/org/graphql/syntax.InlineFragment")--_InlineFragment_typeCondition = (Core.Name "typeCondition")--_InlineFragment_directives = (Core.Name "directives")--_InlineFragment_selectionSet = (Core.Name "selectionSet")--data FragmentDefinition = -  FragmentDefinition {-    fragmentDefinitionFragmentName :: FragmentName,-    fragmentDefinitionTypeCondition :: TypeCondition,-    fragmentDefinitionDirectives :: (Maybe Directives),-    fragmentDefinitionSelectionSet :: SelectionSet}-  deriving (Eq, Ord, Read, Show)--_FragmentDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FragmentDefinition")--_FragmentDefinition_fragmentName = (Core.Name "fragmentName")--_FragmentDefinition_typeCondition = (Core.Name "typeCondition")--_FragmentDefinition_directives = (Core.Name "directives")--_FragmentDefinition_selectionSet = (Core.Name "selectionSet")--newtype FragmentName = -  FragmentName {-    unFragmentName :: Name}-  deriving (Eq, Ord, Read, Show)--_FragmentName = (Core.Name "hydra/ext/org/graphql/syntax.FragmentName")--data TypeCondition = -  TypeConditionOn  |-  TypeConditionNamedType NamedType-  deriving (Eq, Ord, Read, Show)--_TypeCondition = (Core.Name "hydra/ext/org/graphql/syntax.TypeCondition")--_TypeCondition_on = (Core.Name "on")--_TypeCondition_namedType = (Core.Name "namedType")--data Value = -  ValueVariable Variable |-  ValueInt IntValue |-  ValueFloat FloatValue |-  ValueString StringValue |-  ValueBoolean BooleanValue |-  ValueNull NullValue |-  ValueEnum EnumValue |-  ValueList ListValue |-  ValueObject ObjectValue-  deriving (Eq, Ord, Read, Show)--_Value = (Core.Name "hydra/ext/org/graphql/syntax.Value")--_Value_variable = (Core.Name "variable")--_Value_int = (Core.Name "int")--_Value_float = (Core.Name "float")--_Value_string = (Core.Name "string")--_Value_boolean = (Core.Name "boolean")--_Value_null = (Core.Name "null")--_Value_enum = (Core.Name "enum")--_Value_list = (Core.Name "list")--_Value_object = (Core.Name "object")--data BooleanValue = -  BooleanValueTrue  |-  BooleanValueFalse -  deriving (Eq, Ord, Read, Show)--_BooleanValue = (Core.Name "hydra/ext/org/graphql/syntax.BooleanValue")--_BooleanValue_true = (Core.Name "true")--_BooleanValue_false = (Core.Name "false")--data NullValue = -  NullValue {}-  deriving (Eq, Ord, Read, Show)--_NullValue = (Core.Name "hydra/ext/org/graphql/syntax.NullValue")--newtype EnumValue = -  EnumValue {-    unEnumValue :: Name}-  deriving (Eq, Ord, Read, Show)--_EnumValue = (Core.Name "hydra/ext/org/graphql/syntax.EnumValue")--data ListValue = -  ListValueSequence ListValue_Sequence |-  ListValueSequence2 [Value]-  deriving (Eq, Ord, Read, Show)--_ListValue = (Core.Name "hydra/ext/org/graphql/syntax.ListValue")--_ListValue_sequence = (Core.Name "sequence")--_ListValue_sequence2 = (Core.Name "sequence2")--data ListValue_Sequence = -  ListValue_Sequence {}-  deriving (Eq, Ord, Read, Show)--_ListValue_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ListValue.Sequence")--data ObjectValue = -  ObjectValueSequence ObjectValue_Sequence |-  ObjectValueSequence2 [ObjectField]-  deriving (Eq, Ord, Read, Show)--_ObjectValue = (Core.Name "hydra/ext/org/graphql/syntax.ObjectValue")--_ObjectValue_sequence = (Core.Name "sequence")--_ObjectValue_sequence2 = (Core.Name "sequence2")--data ObjectValue_Sequence = -  ObjectValue_Sequence {}-  deriving (Eq, Ord, Read, Show)--_ObjectValue_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ObjectValue.Sequence")--data ObjectField = -  ObjectField {-    objectFieldName :: Name,-    objectFieldValue :: Value}-  deriving (Eq, Ord, Read, Show)--_ObjectField = (Core.Name "hydra/ext/org/graphql/syntax.ObjectField")--_ObjectField_name = (Core.Name "name")--_ObjectField_value = (Core.Name "value")--data VariablesDefinition = -  VariablesDefinition {-    variablesDefinitionVariable :: Variable,-    variablesDefinitionType :: Type,-    variablesDefinitionDefaultValue :: (Maybe DefaultValue),-    variablesDefinitionDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_VariablesDefinition = (Core.Name "hydra/ext/org/graphql/syntax.VariablesDefinition")--_VariablesDefinition_variable = (Core.Name "variable")--_VariablesDefinition_type = (Core.Name "type")--_VariablesDefinition_defaultValue = (Core.Name "defaultValue")--_VariablesDefinition_directives = (Core.Name "directives")--newtype Variable = -  Variable {-    unVariable :: Name}-  deriving (Eq, Ord, Read, Show)--_Variable = (Core.Name "hydra/ext/org/graphql/syntax.Variable")--newtype DefaultValue = -  DefaultValue {-    unDefaultValue :: Value}-  deriving (Eq, Ord, Read, Show)--_DefaultValue = (Core.Name "hydra/ext/org/graphql/syntax.DefaultValue")--data Type = -  TypeNamed NamedType |-  TypeList ListType |-  TypeNonNull NonNullType-  deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/org/graphql/syntax.Type")--_Type_named = (Core.Name "named")--_Type_list = (Core.Name "list")--_Type_nonNull = (Core.Name "nonNull")--newtype NamedType = -  NamedType {-    unNamedType :: Name}-  deriving (Eq, Ord, Read, Show)--_NamedType = (Core.Name "hydra/ext/org/graphql/syntax.NamedType")--newtype ListType = -  ListType {-    unListType :: Type}-  deriving (Eq, Ord, Read, Show)--_ListType = (Core.Name "hydra/ext/org/graphql/syntax.ListType")--data NonNullType = -  NonNullTypeNamed NamedType |-  NonNullTypeList ListType-  deriving (Eq, Ord, Read, Show)--_NonNullType = (Core.Name "hydra/ext/org/graphql/syntax.NonNullType")--_NonNullType_named = (Core.Name "named")--_NonNullType_list = (Core.Name "list")--newtype Directives = -  Directives {-    unDirectives :: [Directive]}-  deriving (Eq, Ord, Read, Show)--_Directives = (Core.Name "hydra/ext/org/graphql/syntax.Directives")--data Directive = -  Directive {-    directiveName :: Name,-    directiveArguments :: (Maybe Arguments)}-  deriving (Eq, Ord, Read, Show)--_Directive = (Core.Name "hydra/ext/org/graphql/syntax.Directive")--_Directive_name = (Core.Name "name")--_Directive_arguments = (Core.Name "arguments")--newtype TypeSystemDocment = -  TypeSystemDocment {-    unTypeSystemDocment :: [TypeSystemDefinition]}-  deriving (Eq, Ord, Read, Show)--_TypeSystemDocment = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDocment")--data TypeSystemDefinition = -  TypeSystemDefinitionSchema SchemaDefinition |-  TypeSystemDefinitionType TypeDefinition |-  TypeSystemDefinitionDirective DirectiveDefinition-  deriving (Eq, Ord, Read, Show)--_TypeSystemDefinition = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDefinition")--_TypeSystemDefinition_schema = (Core.Name "schema")--_TypeSystemDefinition_type = (Core.Name "type")--_TypeSystemDefinition_directive = (Core.Name "directive")--newtype TypeSystemExtensionDocument = -  TypeSystemExtensionDocument {-    unTypeSystemExtensionDocument :: [TypeSystemDefinitionOrExtension]}-  deriving (Eq, Ord, Read, Show)--_TypeSystemExtensionDocument = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemExtensionDocument")--data TypeSystemDefinitionOrExtension = -  TypeSystemDefinitionOrExtensionDefinition TypeSystemDefinition |-  TypeSystemDefinitionOrExtensionExtension TypeSystemExtension-  deriving (Eq, Ord, Read, Show)--_TypeSystemDefinitionOrExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDefinitionOrExtension")--_TypeSystemDefinitionOrExtension_definition = (Core.Name "definition")--_TypeSystemDefinitionOrExtension_extension = (Core.Name "extension")--data TypeSystemExtension = -  TypeSystemExtensionSchema SchemaExtension |-  TypeSystemExtensionType TypeExtension-  deriving (Eq, Ord, Read, Show)--_TypeSystemExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemExtension")--_TypeSystemExtension_schema = (Core.Name "schema")--_TypeSystemExtension_type = (Core.Name "type")--data SchemaDefinition = -  SchemaDefinition {-    schemaDefinitionDescription :: (Maybe Description),-    schemaDefinitionDirectives :: (Maybe Directives),-    schemaDefinitionRootOperationTypeDefinition :: RootOperationTypeDefinition}-  deriving (Eq, Ord, Read, Show)--_SchemaDefinition = (Core.Name "hydra/ext/org/graphql/syntax.SchemaDefinition")--_SchemaDefinition_description = (Core.Name "description")--_SchemaDefinition_directives = (Core.Name "directives")--_SchemaDefinition_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition")--data SchemaExtension = -  SchemaExtensionSequence SchemaExtension_Sequence |-  SchemaExtensionSequence2 Directives-  deriving (Eq, Ord, Read, Show)--_SchemaExtension = (Core.Name "hydra/ext/org/graphql/syntax.SchemaExtension")--_SchemaExtension_sequence = (Core.Name "sequence")--_SchemaExtension_sequence2 = (Core.Name "sequence2")--data SchemaExtension_Sequence = -  SchemaExtension_Sequence {-    schemaExtension_SequenceDirectives :: (Maybe Directives),-    schemaExtension_SequenceRootOperationTypeDefinition :: RootOperationTypeDefinition}-  deriving (Eq, Ord, Read, Show)--_SchemaExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.SchemaExtension.Sequence")--_SchemaExtension_Sequence_directives = (Core.Name "directives")--_SchemaExtension_Sequence_rootOperationTypeDefinition = (Core.Name "rootOperationTypeDefinition")--data RootOperationTypeDefinition = -  RootOperationTypeDefinition {-    rootOperationTypeDefinitionOperationType :: OperationType,-    rootOperationTypeDefinitionNamedType :: NamedType}-  deriving (Eq, Ord, Read, Show)--_RootOperationTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.RootOperationTypeDefinition")--_RootOperationTypeDefinition_operationType = (Core.Name "operationType")--_RootOperationTypeDefinition_namedType = (Core.Name "namedType")--newtype Description = -  Description {-    unDescription :: StringValue}-  deriving (Eq, Ord, Read, Show)--_Description = (Core.Name "hydra/ext/org/graphql/syntax.Description")--data TypeDefinition = -  TypeDefinitionScalar ScalarTypeDefinition |-  TypeDefinitionObject ObjectTypeDefinition |-  TypeDefinitionInterface InterfaceTypeDefinition |-  TypeDefinitionUnion UnionTypeDefinition |-  TypeDefinitionEnum EnumTypeDefinition |-  TypeDefinitionInputObject InputObjectTypeDefinition-  deriving (Eq, Ord, Read, Show)--_TypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.TypeDefinition")--_TypeDefinition_scalar = (Core.Name "scalar")--_TypeDefinition_object = (Core.Name "object")--_TypeDefinition_interface = (Core.Name "interface")--_TypeDefinition_union = (Core.Name "union")--_TypeDefinition_enum = (Core.Name "enum")--_TypeDefinition_inputObject = (Core.Name "inputObject")--data TypeExtension = -  TypeExtensionScalar ScalarTypeExtension |-  TypeExtensionObject ObjectTypeExtension |-  TypeExtensionInterface InterfaceTypeExtension |-  TypeExtensionUnion UnionTypeExtension |-  TypeExtensionEnum EnumTypeExtension |-  TypeExtensionInputObject InputObjectTypeExtension-  deriving (Eq, Ord, Read, Show)--_TypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.TypeExtension")--_TypeExtension_scalar = (Core.Name "scalar")--_TypeExtension_object = (Core.Name "object")--_TypeExtension_interface = (Core.Name "interface")--_TypeExtension_union = (Core.Name "union")--_TypeExtension_enum = (Core.Name "enum")--_TypeExtension_inputObject = (Core.Name "inputObject")--data ScalarTypeDefinition = -  ScalarTypeDefinition {-    scalarTypeDefinitionDescription :: (Maybe Description),-    scalarTypeDefinitionName :: Name,-    scalarTypeDefinitionDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_ScalarTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ScalarTypeDefinition")--_ScalarTypeDefinition_description = (Core.Name "description")--_ScalarTypeDefinition_name = (Core.Name "name")--_ScalarTypeDefinition_directives = (Core.Name "directives")--data ScalarTypeExtension = -  ScalarTypeExtension {-    scalarTypeExtensionName :: Name,-    scalarTypeExtensionDirectives :: Directives}-  deriving (Eq, Ord, Read, Show)--_ScalarTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.ScalarTypeExtension")--_ScalarTypeExtension_name = (Core.Name "name")--_ScalarTypeExtension_directives = (Core.Name "directives")--data ObjectTypeDefinition = -  ObjectTypeDefinition {-    objectTypeDefinitionDescription :: (Maybe Description),-    objectTypeDefinitionName :: Name,-    objectTypeDefinitionImplementsInterfaces :: (Maybe ImplementsInterfaces),-    objectTypeDefinitionDirectives :: (Maybe Directives),-    objectTypeDefinitionFieldsDefinition :: (Maybe FieldsDefinition)}-  deriving (Eq, Ord, Read, Show)--_ObjectTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeDefinition")--_ObjectTypeDefinition_description = (Core.Name "description")--_ObjectTypeDefinition_name = (Core.Name "name")--_ObjectTypeDefinition_implementsInterfaces = (Core.Name "implementsInterfaces")--_ObjectTypeDefinition_directives = (Core.Name "directives")--_ObjectTypeDefinition_fieldsDefinition = (Core.Name "fieldsDefinition")--data ObjectTypeExtension = -  ObjectTypeExtensionSequence ObjectTypeExtension_Sequence |-  ObjectTypeExtensionSequence2 ObjectTypeExtension_Sequence2 |-  ObjectTypeExtensionSequence3 ObjectTypeExtension_Sequence3-  deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension")--_ObjectTypeExtension_sequence = (Core.Name "sequence")--_ObjectTypeExtension_sequence2 = (Core.Name "sequence2")--_ObjectTypeExtension_sequence3 = (Core.Name "sequence3")--data ObjectTypeExtension_Sequence = -  ObjectTypeExtension_Sequence {-    objectTypeExtension_SequenceName :: Name,-    objectTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces),-    objectTypeExtension_SequenceDirectives :: (Maybe Directives),-    objectTypeExtension_SequenceFieldsDefinition :: FieldsDefinition}-  deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence")--_ObjectTypeExtension_Sequence_name = (Core.Name "name")--_ObjectTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces")--_ObjectTypeExtension_Sequence_directives = (Core.Name "directives")--_ObjectTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition")--data ObjectTypeExtension_Sequence2 = -  ObjectTypeExtension_Sequence2 {-    objectTypeExtension_Sequence2Name :: Name,-    objectTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces),-    objectTypeExtension_Sequence2Directives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence2")--_ObjectTypeExtension_Sequence2_name = (Core.Name "name")--_ObjectTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces")--_ObjectTypeExtension_Sequence2_directives = (Core.Name "directives")--data ObjectTypeExtension_Sequence3 = -  ObjectTypeExtension_Sequence3 {-    objectTypeExtension_Sequence3Name :: Name,-    objectTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces}-  deriving (Eq, Ord, Read, Show)--_ObjectTypeExtension_Sequence3 = (Core.Name "hydra/ext/org/graphql/syntax.ObjectTypeExtension.Sequence3")--_ObjectTypeExtension_Sequence3_name = (Core.Name "name")--_ObjectTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces")--data ImplementsInterfaces = -  ImplementsInterfacesSequence ImplementsInterfaces_Sequence |-  ImplementsInterfacesSequence2 ImplementsInterfaces_Sequence2-  deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces")--_ImplementsInterfaces_sequence = (Core.Name "sequence")--_ImplementsInterfaces_sequence2 = (Core.Name "sequence2")--data ImplementsInterfaces_Sequence = -  ImplementsInterfaces_Sequence {-    implementsInterfaces_SequenceImplementsInterfaces :: ImplementsInterfaces,-    implementsInterfaces_SequenceNamedType :: NamedType}-  deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces.Sequence")--_ImplementsInterfaces_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces")--_ImplementsInterfaces_Sequence_namedType = (Core.Name "namedType")--data ImplementsInterfaces_Sequence2 = -  ImplementsInterfaces_Sequence2 {-    implementsInterfaces_Sequence2Amp :: (Maybe ()),-    implementsInterfaces_Sequence2NamedType :: NamedType}-  deriving (Eq, Ord, Read, Show)--_ImplementsInterfaces_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.ImplementsInterfaces.Sequence2")--_ImplementsInterfaces_Sequence2_amp = (Core.Name "amp")--_ImplementsInterfaces_Sequence2_namedType = (Core.Name "namedType")--newtype FieldsDefinition = -  FieldsDefinition {-    unFieldsDefinition :: [FieldDefinition]}-  deriving (Eq, Ord, Read, Show)--_FieldsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FieldsDefinition")--data FieldDefinition = -  FieldDefinition {-    fieldDefinitionDescription :: (Maybe Description),-    fieldDefinitionName :: Name,-    fieldDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition),-    fieldDefinitionType :: Type,-    fieldDefinitionDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_FieldDefinition = (Core.Name "hydra/ext/org/graphql/syntax.FieldDefinition")--_FieldDefinition_description = (Core.Name "description")--_FieldDefinition_name = (Core.Name "name")--_FieldDefinition_argumentsDefinition = (Core.Name "argumentsDefinition")--_FieldDefinition_type = (Core.Name "type")--_FieldDefinition_directives = (Core.Name "directives")--newtype ArgumentsDefinition = -  ArgumentsDefinition {-    unArgumentsDefinition :: [InputValueDefinition]}-  deriving (Eq, Ord, Read, Show)--_ArgumentsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.ArgumentsDefinition")--data InputValueDefinition = -  InputValueDefinition {-    inputValueDefinitionDescription :: (Maybe Description),-    inputValueDefinitionName :: Name,-    inputValueDefinitionType :: Type,-    inputValueDefinitionDefaultValue :: (Maybe DefaultValue),-    inputValueDefinitionDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_InputValueDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputValueDefinition")--_InputValueDefinition_description = (Core.Name "description")--_InputValueDefinition_name = (Core.Name "name")--_InputValueDefinition_type = (Core.Name "type")--_InputValueDefinition_defaultValue = (Core.Name "defaultValue")--_InputValueDefinition_directives = (Core.Name "directives")--data InterfaceTypeDefinition = -  InterfaceTypeDefinitionSequence InterfaceTypeDefinition_Sequence |-  InterfaceTypeDefinitionSequence2 InterfaceTypeDefinition_Sequence2-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition")--_InterfaceTypeDefinition_sequence = (Core.Name "sequence")--_InterfaceTypeDefinition_sequence2 = (Core.Name "sequence2")--data InterfaceTypeDefinition_Sequence = -  InterfaceTypeDefinition_Sequence {-    interfaceTypeDefinition_SequenceDescription :: (Maybe Description),-    interfaceTypeDefinition_SequenceName :: Name,-    interfaceTypeDefinition_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces),-    interfaceTypeDefinition_SequenceDirectives :: (Maybe Directives),-    interfaceTypeDefinition_SequenceFieldsDefinition :: FieldsDefinition}-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition.Sequence")--_InterfaceTypeDefinition_Sequence_description = (Core.Name "description")--_InterfaceTypeDefinition_Sequence_name = (Core.Name "name")--_InterfaceTypeDefinition_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces")--_InterfaceTypeDefinition_Sequence_directives = (Core.Name "directives")--_InterfaceTypeDefinition_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition")--data InterfaceTypeDefinition_Sequence2 = -  InterfaceTypeDefinition_Sequence2 {-    interfaceTypeDefinition_Sequence2Description :: (Maybe Description),-    interfaceTypeDefinition_Sequence2Name :: Name,-    interfaceTypeDefinition_Sequence2ImplementsInterfaces :: ImplementsInterfaces,-    interfaceTypeDefinition_Sequence2Directives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeDefinition_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeDefinition.Sequence2")--_InterfaceTypeDefinition_Sequence2_description = (Core.Name "description")--_InterfaceTypeDefinition_Sequence2_name = (Core.Name "name")--_InterfaceTypeDefinition_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces")--_InterfaceTypeDefinition_Sequence2_directives = (Core.Name "directives")--data InterfaceTypeExtension = -  InterfaceTypeExtensionSequence InterfaceTypeExtension_Sequence |-  InterfaceTypeExtensionSequence2 InterfaceTypeExtension_Sequence2 |-  InterfaceTypeExtensionSequence3 InterfaceTypeExtension_Sequence3-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension")--_InterfaceTypeExtension_sequence = (Core.Name "sequence")--_InterfaceTypeExtension_sequence2 = (Core.Name "sequence2")--_InterfaceTypeExtension_sequence3 = (Core.Name "sequence3")--data InterfaceTypeExtension_Sequence = -  InterfaceTypeExtension_Sequence {-    interfaceTypeExtension_SequenceName :: Name,-    interfaceTypeExtension_SequenceImplementsInterfaces :: (Maybe ImplementsInterfaces),-    interfaceTypeExtension_SequenceDirectives :: (Maybe Directives),-    interfaceTypeExtension_SequenceFieldsDefinition :: FieldsDefinition}-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence")--_InterfaceTypeExtension_Sequence_name = (Core.Name "name")--_InterfaceTypeExtension_Sequence_implementsInterfaces = (Core.Name "implementsInterfaces")--_InterfaceTypeExtension_Sequence_directives = (Core.Name "directives")--_InterfaceTypeExtension_Sequence_fieldsDefinition = (Core.Name "fieldsDefinition")--data InterfaceTypeExtension_Sequence2 = -  InterfaceTypeExtension_Sequence2 {-    interfaceTypeExtension_Sequence2Name :: Name,-    interfaceTypeExtension_Sequence2ImplementsInterfaces :: (Maybe ImplementsInterfaces),-    interfaceTypeExtension_Sequence2Directives :: Directives}-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence2")--_InterfaceTypeExtension_Sequence2_name = (Core.Name "name")--_InterfaceTypeExtension_Sequence2_implementsInterfaces = (Core.Name "implementsInterfaces")--_InterfaceTypeExtension_Sequence2_directives = (Core.Name "directives")--data InterfaceTypeExtension_Sequence3 = -  InterfaceTypeExtension_Sequence3 {-    interfaceTypeExtension_Sequence3Name :: Name,-    interfaceTypeExtension_Sequence3ImplementsInterfaces :: ImplementsInterfaces}-  deriving (Eq, Ord, Read, Show)--_InterfaceTypeExtension_Sequence3 = (Core.Name "hydra/ext/org/graphql/syntax.InterfaceTypeExtension.Sequence3")--_InterfaceTypeExtension_Sequence3_name = (Core.Name "name")--_InterfaceTypeExtension_Sequence3_implementsInterfaces = (Core.Name "implementsInterfaces")--data UnionTypeDefinition = -  UnionTypeDefinition {-    unionTypeDefinitionDescription :: (Maybe Description),-    unionTypeDefinitionName :: Name,-    unionTypeDefinitionDirectives :: (Maybe Directives),-    unionTypeDefinitionUnionMemberTypes :: (Maybe UnionMemberTypes)}-  deriving (Eq, Ord, Read, Show)--_UnionTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeDefinition")--_UnionTypeDefinition_description = (Core.Name "description")--_UnionTypeDefinition_name = (Core.Name "name")--_UnionTypeDefinition_directives = (Core.Name "directives")--_UnionTypeDefinition_unionMemberTypes = (Core.Name "unionMemberTypes")--data UnionMemberTypes = -  UnionMemberTypesSequence UnionMemberTypes_Sequence |-  UnionMemberTypesSequence2 UnionMemberTypes_Sequence2-  deriving (Eq, Ord, Read, Show)--_UnionMemberTypes = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes")--_UnionMemberTypes_sequence = (Core.Name "sequence")--_UnionMemberTypes_sequence2 = (Core.Name "sequence2")--data UnionMemberTypes_Sequence = -  UnionMemberTypes_Sequence {-    unionMemberTypes_SequenceUnionMemberTypes :: UnionMemberTypes,-    unionMemberTypes_SequenceNamedType :: NamedType}-  deriving (Eq, Ord, Read, Show)--_UnionMemberTypes_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes.Sequence")--_UnionMemberTypes_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes")--_UnionMemberTypes_Sequence_namedType = (Core.Name "namedType")--data UnionMemberTypes_Sequence2 = -  UnionMemberTypes_Sequence2 {-    unionMemberTypes_Sequence2Or :: (Maybe ()),-    unionMemberTypes_Sequence2NamedType :: NamedType}-  deriving (Eq, Ord, Read, Show)--_UnionMemberTypes_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.UnionMemberTypes.Sequence2")--_UnionMemberTypes_Sequence2_or = (Core.Name "or")--_UnionMemberTypes_Sequence2_namedType = (Core.Name "namedType")--data UnionTypeExtension = -  UnionTypeExtensionSequence UnionTypeExtension_Sequence |-  UnionTypeExtensionSequence2 UnionTypeExtension_Sequence2-  deriving (Eq, Ord, Read, Show)--_UnionTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension")--_UnionTypeExtension_sequence = (Core.Name "sequence")--_UnionTypeExtension_sequence2 = (Core.Name "sequence2")--data UnionTypeExtension_Sequence = -  UnionTypeExtension_Sequence {-    unionTypeExtension_SequenceName :: Name,-    unionTypeExtension_SequenceDirectives :: (Maybe Directives),-    unionTypeExtension_SequenceUnionMemberTypes :: UnionMemberTypes}-  deriving (Eq, Ord, Read, Show)--_UnionTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension.Sequence")--_UnionTypeExtension_Sequence_name = (Core.Name "name")--_UnionTypeExtension_Sequence_directives = (Core.Name "directives")--_UnionTypeExtension_Sequence_unionMemberTypes = (Core.Name "unionMemberTypes")--data UnionTypeExtension_Sequence2 = -  UnionTypeExtension_Sequence2 {-    unionTypeExtension_Sequence2Name :: Name,-    unionTypeExtension_Sequence2Directives :: Directives}-  deriving (Eq, Ord, Read, Show)--_UnionTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.UnionTypeExtension.Sequence2")--_UnionTypeExtension_Sequence2_name = (Core.Name "name")--_UnionTypeExtension_Sequence2_directives = (Core.Name "directives")--data EnumTypeDefinition = -  EnumTypeDefinition {-    enumTypeDefinitionDescription :: (Maybe Description),-    enumTypeDefinitionName :: Name,-    enumTypeDefinitionDirectives :: (Maybe Directives),-    enumTypeDefinitionEnumValuesDefinition :: (Maybe EnumValuesDefinition)}-  deriving (Eq, Ord, Read, Show)--_EnumTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeDefinition")--_EnumTypeDefinition_description = (Core.Name "description")--_EnumTypeDefinition_name = (Core.Name "name")--_EnumTypeDefinition_directives = (Core.Name "directives")--_EnumTypeDefinition_enumValuesDefinition = (Core.Name "enumValuesDefinition")--newtype EnumValuesDefinition = -  EnumValuesDefinition {-    unEnumValuesDefinition :: [EnumValueDefinition]}-  deriving (Eq, Ord, Read, Show)--_EnumValuesDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumValuesDefinition")--data EnumValueDefinition = -  EnumValueDefinition {-    enumValueDefinitionDescription :: (Maybe Description),-    enumValueDefinitionEnumValue :: EnumValue,-    enumValueDefinitionDirectives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_EnumValueDefinition = (Core.Name "hydra/ext/org/graphql/syntax.EnumValueDefinition")--_EnumValueDefinition_description = (Core.Name "description")--_EnumValueDefinition_enumValue = (Core.Name "enumValue")--_EnumValueDefinition_directives = (Core.Name "directives")--data EnumTypeExtension = -  EnumTypeExtensionSequence EnumTypeExtension_Sequence |-  EnumTypeExtensionSequence2 EnumTypeExtension_Sequence2-  deriving (Eq, Ord, Read, Show)--_EnumTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension")--_EnumTypeExtension_sequence = (Core.Name "sequence")--_EnumTypeExtension_sequence2 = (Core.Name "sequence2")--data EnumTypeExtension_Sequence = -  EnumTypeExtension_Sequence {-    enumTypeExtension_SequenceName :: Name,-    enumTypeExtension_SequenceDirectives :: (Maybe Directives),-    enumTypeExtension_SequenceEnumValuesDefinition :: EnumValuesDefinition}-  deriving (Eq, Ord, Read, Show)--_EnumTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension.Sequence")--_EnumTypeExtension_Sequence_name = (Core.Name "name")--_EnumTypeExtension_Sequence_directives = (Core.Name "directives")--_EnumTypeExtension_Sequence_enumValuesDefinition = (Core.Name "enumValuesDefinition")--data EnumTypeExtension_Sequence2 = -  EnumTypeExtension_Sequence2 {-    enumTypeExtension_Sequence2Name :: Name,-    enumTypeExtension_Sequence2Directives :: Directives}-  deriving (Eq, Ord, Read, Show)--_EnumTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.EnumTypeExtension.Sequence2")--_EnumTypeExtension_Sequence2_name = (Core.Name "name")--_EnumTypeExtension_Sequence2_directives = (Core.Name "directives")--data InputObjectTypeDefinition = -  InputObjectTypeDefinitionSequence InputObjectTypeDefinition_Sequence |-  InputObjectTypeDefinitionSequence2 InputObjectTypeDefinition_Sequence2-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition")--_InputObjectTypeDefinition_sequence = (Core.Name "sequence")--_InputObjectTypeDefinition_sequence2 = (Core.Name "sequence2")--data InputObjectTypeDefinition_Sequence = -  InputObjectTypeDefinition_Sequence {-    inputObjectTypeDefinition_SequenceDescription :: (Maybe Description),-    inputObjectTypeDefinition_SequenceName :: Name,-    inputObjectTypeDefinition_SequenceDirectives :: (Maybe Directives),-    inputObjectTypeDefinition_SequenceInputFieldsDefinition :: InputFieldsDefinition}-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeDefinition_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition.Sequence")--_InputObjectTypeDefinition_Sequence_description = (Core.Name "description")--_InputObjectTypeDefinition_Sequence_name = (Core.Name "name")--_InputObjectTypeDefinition_Sequence_directives = (Core.Name "directives")--_InputObjectTypeDefinition_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition")--data InputObjectTypeDefinition_Sequence2 = -  InputObjectTypeDefinition_Sequence2 {-    inputObjectTypeDefinition_Sequence2Description :: (Maybe Description),-    inputObjectTypeDefinition_Sequence2Name :: Name,-    inputObjectTypeDefinition_Sequence2Directives :: (Maybe Directives)}-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeDefinition_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeDefinition.Sequence2")--_InputObjectTypeDefinition_Sequence2_description = (Core.Name "description")--_InputObjectTypeDefinition_Sequence2_name = (Core.Name "name")--_InputObjectTypeDefinition_Sequence2_directives = (Core.Name "directives")--newtype InputFieldsDefinition = -  InputFieldsDefinition {-    unInputFieldsDefinition :: [InputValueDefinition]}-  deriving (Eq, Ord, Read, Show)--_InputFieldsDefinition = (Core.Name "hydra/ext/org/graphql/syntax.InputFieldsDefinition")--data InputObjectTypeExtension = -  InputObjectTypeExtensionSequence InputObjectTypeExtension_Sequence |-  InputObjectTypeExtensionSequence2 InputObjectTypeExtension_Sequence2-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeExtension = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension")--_InputObjectTypeExtension_sequence = (Core.Name "sequence")--_InputObjectTypeExtension_sequence2 = (Core.Name "sequence2")--data InputObjectTypeExtension_Sequence = -  InputObjectTypeExtension_Sequence {-    inputObjectTypeExtension_SequenceName :: Name,-    inputObjectTypeExtension_SequenceDirectives :: (Maybe Directives),-    inputObjectTypeExtension_SequenceInputFieldsDefinition :: InputFieldsDefinition}-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeExtension_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension.Sequence")--_InputObjectTypeExtension_Sequence_name = (Core.Name "name")--_InputObjectTypeExtension_Sequence_directives = (Core.Name "directives")--_InputObjectTypeExtension_Sequence_inputFieldsDefinition = (Core.Name "inputFieldsDefinition")--data InputObjectTypeExtension_Sequence2 = -  InputObjectTypeExtension_Sequence2 {-    inputObjectTypeExtension_Sequence2Name :: Name,-    inputObjectTypeExtension_Sequence2Directives :: Directives}-  deriving (Eq, Ord, Read, Show)--_InputObjectTypeExtension_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.InputObjectTypeExtension.Sequence2")--_InputObjectTypeExtension_Sequence2_name = (Core.Name "name")--_InputObjectTypeExtension_Sequence2_directives = (Core.Name "directives")--data DirectiveDefinition = -  DirectiveDefinition {-    directiveDefinitionDescription :: (Maybe Description),-    directiveDefinitionName :: Name,-    directiveDefinitionArgumentsDefinition :: (Maybe ArgumentsDefinition),-    directiveDefinitionRepeatable :: (Maybe ()),-    directiveDefinitionDirectiveLocations :: DirectiveLocations}-  deriving (Eq, Ord, Read, Show)--_DirectiveDefinition = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveDefinition")--_DirectiveDefinition_description = (Core.Name "description")--_DirectiveDefinition_name = (Core.Name "name")--_DirectiveDefinition_argumentsDefinition = (Core.Name "argumentsDefinition")--_DirectiveDefinition_repeatable = (Core.Name "repeatable")--_DirectiveDefinition_directiveLocations = (Core.Name "directiveLocations")--data DirectiveLocations = -  DirectiveLocationsSequence DirectiveLocations_Sequence |-  DirectiveLocationsSequence2 DirectiveLocations_Sequence2-  deriving (Eq, Ord, Read, Show)--_DirectiveLocations = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations")--_DirectiveLocations_sequence = (Core.Name "sequence")--_DirectiveLocations_sequence2 = (Core.Name "sequence2")--data DirectiveLocations_Sequence = -  DirectiveLocations_Sequence {-    directiveLocations_SequenceDirectiveLocations :: DirectiveLocations,-    directiveLocations_SequenceDirectiveLocation :: DirectiveLocation}-  deriving (Eq, Ord, Read, Show)--_DirectiveLocations_Sequence = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations.Sequence")--_DirectiveLocations_Sequence_directiveLocations = (Core.Name "directiveLocations")--_DirectiveLocations_Sequence_directiveLocation = (Core.Name "directiveLocation")--data DirectiveLocations_Sequence2 = -  DirectiveLocations_Sequence2 {-    directiveLocations_Sequence2Or :: (Maybe ()),-    directiveLocations_Sequence2DirectiveLocation :: DirectiveLocation}-  deriving (Eq, Ord, Read, Show)--_DirectiveLocations_Sequence2 = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocations.Sequence2")--_DirectiveLocations_Sequence2_or = (Core.Name "or")--_DirectiveLocations_Sequence2_directiveLocation = (Core.Name "directiveLocation")--data DirectiveLocation = -  DirectiveLocationExecutable ExecutableDirectiveLocation |-  DirectiveLocationTypeSystem TypeSystemDirectiveLocation-  deriving (Eq, Ord, Read, Show)--_DirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.DirectiveLocation")--_DirectiveLocation_executable = (Core.Name "executable")--_DirectiveLocation_typeSystem = (Core.Name "typeSystem")--data ExecutableDirectiveLocation = -  ExecutableDirectiveLocationQUERY  |-  ExecutableDirectiveLocationMUTATION  |-  ExecutableDirectiveLocationSUBSCRIPTION  |-  ExecutableDirectiveLocationFIELD  |-  ExecutableDirectiveLocationFRAGMENTLowbarDEFINITION  |-  ExecutableDirectiveLocationFRAGMENTLowbarSPREAD  |-  ExecutableDirectiveLocationINLINELowbarFRAGMENT  |-  ExecutableDirectiveLocationVARIABLELowbarDEFINITION -  deriving (Eq, Ord, Read, Show)--_ExecutableDirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.ExecutableDirectiveLocation")--_ExecutableDirectiveLocation_qUERY = (Core.Name "qUERY")--_ExecutableDirectiveLocation_mUTATION = (Core.Name "mUTATION")--_ExecutableDirectiveLocation_sUBSCRIPTION = (Core.Name "sUBSCRIPTION")--_ExecutableDirectiveLocation_fIELD = (Core.Name "fIELD")--_ExecutableDirectiveLocation_fRAGMENTLowbarDEFINITION = (Core.Name "fRAGMENTLowbarDEFINITION")--_ExecutableDirectiveLocation_fRAGMENTLowbarSPREAD = (Core.Name "fRAGMENTLowbarSPREAD")--_ExecutableDirectiveLocation_iNLINELowbarFRAGMENT = (Core.Name "iNLINELowbarFRAGMENT")--_ExecutableDirectiveLocation_vARIABLELowbarDEFINITION = (Core.Name "vARIABLELowbarDEFINITION")--data TypeSystemDirectiveLocation = -  TypeSystemDirectiveLocationSCHEMA  |-  TypeSystemDirectiveLocationSCALAR  |-  TypeSystemDirectiveLocationOBJECT  |-  TypeSystemDirectiveLocationFIELDLowbarDEFINITION  |-  TypeSystemDirectiveLocationARGUMENTLowbarDEFINITION  |-  TypeSystemDirectiveLocationINTERFACE  |-  TypeSystemDirectiveLocationUNION  |-  TypeSystemDirectiveLocationENUM  |-  TypeSystemDirectiveLocationENUMLowbarVALUE  |-  TypeSystemDirectiveLocationINPUTLowbarOBJECT  |-  TypeSystemDirectiveLocationINPUTLowbarFIELDLowbarDEFINITION -  deriving (Eq, Ord, Read, Show)--_TypeSystemDirectiveLocation = (Core.Name "hydra/ext/org/graphql/syntax.TypeSystemDirectiveLocation")--_TypeSystemDirectiveLocation_sCHEMA = (Core.Name "sCHEMA")--_TypeSystemDirectiveLocation_sCALAR = (Core.Name "sCALAR")--_TypeSystemDirectiveLocation_oBJECT = (Core.Name "oBJECT")--_TypeSystemDirectiveLocation_fIELDLowbarDEFINITION = (Core.Name "fIELDLowbarDEFINITION")--_TypeSystemDirectiveLocation_aRGUMENTLowbarDEFINITION = (Core.Name "aRGUMENTLowbarDEFINITION")--_TypeSystemDirectiveLocation_iNTERFACE = (Core.Name "iNTERFACE")--_TypeSystemDirectiveLocation_uNION = (Core.Name "uNION")--_TypeSystemDirectiveLocation_eNUM = (Core.Name "eNUM")--_TypeSystemDirectiveLocation_eNUMLowbarVALUE = (Core.Name "eNUMLowbarVALUE")--_TypeSystemDirectiveLocation_iNPUTLowbarOBJECT = (Core.Name "iNPUTLowbarOBJECT")--_TypeSystemDirectiveLocation_iNPUTLowbarFIELDLowbarDEFINITION = (Core.Name "iNPUTLowbarFIELDLowbarDEFINITION")
+ src/gen-main/haskell/Hydra/Ext/Org/Json/Coder.hs view
@@ -0,0 +1,302 @@+-- | JSON encoding and decoding for Hydra terms++module Hydra.Ext.Org.Json.Coder where++import qualified Hydra.Adapt.Modules as Modules+import qualified Hydra.Adapt.Utils as Utils+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Encode.Core as Core_+import qualified Hydra.Ext.Org.Json.Language as Language+import qualified Hydra.Extract.Core as Core__+import qualified Hydra.Graph as Graph+import qualified Hydra.Json as Json+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Literals as Literals_+import qualified Hydra.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core___+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++jsonCoder :: (Core.Type -> Compute.Flow Graph.Graph (Compute.Coder Graph.Graph t0 Core.Term Json.Value))+jsonCoder typ = (Flows.bind (Modules.languageAdapter Language.jsonLanguage typ) (\adapter -> Flows.bind (termCoder (Compute.adapterTarget adapter)) (\coder -> Flows.pure (Utils.composeCoders (Compute.adapterCoder adapter) coder))))++literalJsonCoder :: (Core.LiteralType -> Compute.Flow t0 (Compute.Coder t1 t2 Core.Literal Json.Value))+literalJsonCoder lt = (Flows.pure ((\x -> case x of+  Core.LiteralTypeBoolean -> Compute.Coder {+    Compute.coderEncode = (\lit -> Flows.bind (Core__.booleanLiteral lit) (\b -> Flows.pure (Json.ValueBoolean b))),+    Compute.coderDecode = (\s -> (\x -> case x of+      Json.ValueBoolean v2 -> (Flows.pure (Core.LiteralBoolean v2))+      _ -> (Monads.unexpected "boolean" (showValue s))) s)}+  Core.LiteralTypeFloat _ -> Compute.Coder {+    Compute.coderEncode = (\lit -> Flows.bind (Core__.floatLiteral lit) (\f -> Flows.bind (Core__.bigfloatValue f) (\bf -> Flows.pure (Json.ValueNumber bf)))),+    Compute.coderDecode = (\s -> (\x -> case x of+      Json.ValueNumber v2 -> (Flows.pure (Core.LiteralFloat (Core.FloatValueBigfloat v2)))+      _ -> (Monads.unexpected "number" (showValue s))) s)}+  Core.LiteralTypeInteger _ -> Compute.Coder {+    Compute.coderEncode = (\lit -> Flows.bind (Core__.integerLiteral lit) (\i -> Flows.bind (Core__.bigintValue i) (\bi -> Flows.pure (Json.ValueNumber (Literals.bigintToBigfloat bi))))),+    Compute.coderDecode = (\s -> (\x -> case x of+      Json.ValueNumber v2 ->  +        let bi = (Literals.bigfloatToBigint v2)+        in (Flows.pure (Core.LiteralInteger (Core.IntegerValueBigint bi)))+      _ -> (Monads.unexpected "number" (showValue s))) s)}+  Core.LiteralTypeString -> Compute.Coder {+    Compute.coderEncode = (\lit -> Flows.bind (Core__.stringLiteral lit) (\s -> Flows.pure (Json.ValueString s))),+    Compute.coderDecode = (\s -> (\x -> case x of+      Json.ValueString v2 -> (Flows.pure (Core.LiteralString v2))+      _ -> (Monads.unexpected "string" (showValue s))) s)}) lt))++recordCoder :: (Core.RowType -> Compute.Flow t0 (Compute.Coder Graph.Graph t1 Core.Term Json.Value))+recordCoder rt =  +  let fields = (Core.rowTypeFields rt) +      getCoder = (\f -> Flows.bind (termCoder (Core.fieldTypeType f)) (\coder -> Flows.pure (f, coder)))+  in (Flows.bind (Flows.mapList getCoder fields) (\coders -> Flows.pure (Compute.Coder {+    Compute.coderEncode = (encodeRecord coders),+    Compute.coderDecode = (decodeRecord rt coders)})))++encodeRecord :: ([(Core.FieldType, (Compute.Coder Graph.Graph t0 Core.Term Json.Value))] -> Core.Term -> Compute.Flow Graph.Graph Json.Value)+encodeRecord coders term =  +  let stripped = (Rewriting.deannotateTerm term)+  in (Flows.bind (Core__.termRecord stripped) (\record ->  +    let fields = (Core.recordFields record) +        encodeField = (\coderAndField ->  +                let coder = (fst coderAndField) +                    field = (snd coderAndField)+                    ft = (fst coder)+                    coder_ = (snd coder)+                    fname = (Core.fieldName field)+                    fvalue = (Core.fieldTerm field)+                in ((\x -> case x of+                  Core.TypeOptional _ -> ((\x -> case x of+                    Core.TermOptional v2 -> (Optionals.maybe (Flows.pure Nothing) (\v -> Flows.bind (Compute.coderEncode coder_ v) (\encoded -> Flows.pure (Just (Core.unName fname, encoded)))) v2)+                    _ -> (Flows.bind (Compute.coderEncode coder_ fvalue) (\encoded -> Flows.pure (Just (Core.unName fname, encoded))))) fvalue)+                  _ -> (Flows.bind (Compute.coderEncode coder_ fvalue) (\encoded -> Flows.pure (Just (Core.unName fname, encoded))))) (Core.fieldTypeType ft)))+    in (Flows.bind (Flows.mapList encodeField (Lists.zip coders fields)) (\maybeFields -> Flows.pure (Json.ValueObject (Maps.fromList (Optionals.cat maybeFields)))))))++decodeRecord :: (Core.RowType -> [(Core.FieldType, (Compute.Coder t0 t1 Core.Term Json.Value))] -> Json.Value -> Compute.Flow t1 Core.Term)+decodeRecord rt coders n = ((\x -> case x of+  Json.ValueObject v1 ->  +    let decodeField = (\coder ->  +            let ft = (fst coder) +                coder_ = (snd coder)+                fname = (Core.fieldTypeName ft)+                defaultValue = Json.ValueNull+                jsonValue = (Optionals.fromMaybe defaultValue (Maps.lookup (Core.unName fname) v1))+            in (Flows.bind (Compute.coderDecode coder_ jsonValue) (\v -> Flows.pure (Core.Field {+              Core.fieldName = fname,+              Core.fieldTerm = v}))))+    in (Flows.bind (Flows.mapList decodeField coders) (\fields -> Flows.pure (Core.TermRecord (Core.Record {+      Core.recordTypeName = (Core.rowTypeTypeName rt),+      Core.recordFields = fields}))))+  _ -> (Monads.unexpected "object" (showValue n))) n)++termCoder :: (Core.Type -> Compute.Flow t0 (Compute.Coder Graph.Graph t1 Core.Term Json.Value))+termCoder typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeLiteral v1 -> (Flows.bind (literalJsonCoder v1) (\ac -> Flows.pure (Compute.Coder {+      Compute.coderEncode = (\term -> (\x -> case x of+        Core.TermLiteral v2 -> (Compute.coderEncode ac v2)+        _ -> (Monads.unexpected "literal term" (Core___.term term))) term),+      Compute.coderDecode = (\n -> Flows.bind (Compute.coderDecode ac n) (\lit -> Flows.pure (Core.TermLiteral lit)))})))+    Core.TypeList v1 -> (Flows.bind (termCoder v1) (\lc -> Flows.pure (Compute.Coder {+      Compute.coderEncode = (\term -> (\x -> case x of+        Core.TermList v2 -> (Flows.bind (Flows.mapList (Compute.coderEncode lc) v2) (\encodedEls -> Flows.pure (Json.ValueArray encodedEls)))+        _ -> (Monads.unexpected "list term" (Core___.term term))) term),+      Compute.coderDecode = (\n -> (\x -> case x of+        Json.ValueArray v2 -> (Flows.bind (Flows.mapList (Compute.coderDecode lc) v2) (\decodedNodes -> Flows.pure (Core.TermList decodedNodes)))+        _ -> (Monads.unexpected "sequence" (showValue n))) n)})))+    Core.TypeMap v1 ->  +      let kt = (Core.mapTypeKeys v1) +          vt = (Core.mapTypeValues v1)+      in (Flows.bind (termCoder kt) (\kc -> Flows.bind (termCoder vt) (\vc -> Flows.bind Monads.getState (\cx ->  +        let isStringKey = (Equality.equal (Rewriting.deannotateType kt) (Core.TypeLiteral Core.LiteralTypeString)) +            toString = (\v -> Logic.ifElse isStringKey ((\x -> case x of+                    Core.TermLiteral v2 -> ((\x -> case x of+                      Core.LiteralString v3 -> v3+                      _ -> (Core___.term v)) v2)+                    _ -> (Core___.term v)) (Rewriting.deannotateTerm v)) (Core___.term v))+            fromString = (\s -> Logic.ifElse isStringKey (Core.TermLiteral (Core.LiteralString s)) (readStringStub s))+            encodeEntry = (\kv ->  +                    let k = (fst kv) +                        v = (snd kv)+                    in (Flows.bind (Compute.coderEncode vc v) (\encodedV -> Flows.pure (toString k, encodedV))))+            decodeEntry = (\kv ->  +                    let k = (fst kv) +                        v = (snd kv)+                    in (Flows.bind (Compute.coderDecode vc v) (\decodedV -> Flows.pure (fromString k, decodedV))))+        in (Flows.pure (Compute.Coder {+          Compute.coderEncode = (\term -> (\x -> case x of+            Core.TermMap v2 -> (Flows.bind (Flows.mapList encodeEntry (Maps.toList v2)) (\entries -> Flows.pure (Json.ValueObject (Maps.fromList entries))))+            _ -> (Monads.unexpected "map term" (Core___.term term))) term),+          Compute.coderDecode = (\n -> (\x -> case x of+            Json.ValueObject v2 -> (Flows.bind (Flows.mapList decodeEntry (Maps.toList v2)) (\entries -> Flows.pure (Core.TermMap (Maps.fromList entries))))+            _ -> (Monads.unexpected "mapping" (showValue n))) n)}))))))+    Core.TypeOptional v1 -> (Flows.bind (termCoder v1) (\oc -> Flows.pure (Compute.Coder {+      Compute.coderEncode = (\t ->  +        let stripped = (Rewriting.deannotateTerm t)+        in ((\x -> case x of+          Core.TermOptional v2 -> (Optionals.maybe (Flows.pure Json.ValueNull) (Compute.coderEncode oc) v2)+          _ -> (Monads.unexpected "optional term" (Core___.term t))) stripped)),+      Compute.coderDecode = (\n -> (\x -> case x of+        Json.ValueNull -> (Flows.pure (Core.TermOptional Nothing))+        _ -> (Flows.bind (Compute.coderDecode oc n) (\decoded -> Flows.pure (Core.TermOptional (Just decoded))))) n)})))+    Core.TypeRecord v1 -> (recordCoder v1)+    Core.TypeUnit -> (Flows.pure unitCoder)+    Core.TypeVariable v1 -> (Flows.pure (Compute.Coder {+      Compute.coderEncode = (\term -> Flows.pure (Json.ValueString (Strings.cat [+        "variable '",+        Core.unName v1,+        "' for: ",+        (Core___.term term)]))),+      Compute.coderDecode = (\term -> Flows.fail (Strings.cat [+        "type variable ",+        Core.unName v1,+        " does not support decoding"]))}))+    _ -> (Flows.fail (Strings.cat [+      "unsupported type in JSON: ",+      (Core___.type_ typ)]))) stripped)++unitCoder :: (Compute.Coder t0 t1 Core.Term Json.Value)+unitCoder = Compute.Coder {+  Compute.coderEncode = (\term -> (\x -> case x of+    Core.TermUnit -> (Flows.pure Json.ValueNull)+    _ -> (Monads.unexpected "unit" (Core___.term term))) (Rewriting.deannotateTerm term)),+  Compute.coderDecode = (\n -> (\x -> case x of+    Json.ValueNull -> (Flows.pure Core.TermUnit)+    _ -> (Monads.unexpected "null" (showValue n))) n)}++untypedTermToJson :: (Core.Term -> Compute.Flow t0 Json.Value)+untypedTermToJson term =  +  let unexp = (\msg -> Flows.pure (Json.ValueString (Strings.cat2 "FAIL: " msg))) +      asRecord = (\fields -> untypedTermToJson (Core.TermRecord (Core.Record {+              Core.recordTypeName = (Core.Name ""),+              Core.recordFields = fields})))+      asVariant = (\name -> \term -> untypedTermToJson (Core.TermUnion (Core.Injection {+              Core.injectionTypeName = (Core.Name ""),+              Core.injectionField = Core.Field {+                Core.fieldName = (Core.Name name),+                Core.fieldTerm = term}})))+      fieldToKeyval = (\f ->  +              let forTerm = (\t -> (\x -> case x of+                      Core.TermOptional v1 -> (Optionals.maybe (Flows.pure Nothing) forTerm v1)+                      _ -> (Flows.map Optionals.pure (untypedTermToJson t))) t)+              in (Flows.bind (forTerm (Core.fieldTerm f)) (\mjson -> Flows.pure (Optionals.map (\j -> (Core.unName (Core.fieldName f), j)) mjson))))+  in ((\x -> case x of+    Core.TermAnnotated v1 ->  +      let term1 = (Core.annotatedTermSubject v1) +          ann = (Core.annotatedTermAnnotation v1)+          encodePair = (\kv ->  +                  let k = (Core.unName (fst kv)) +                      v = (snd kv)+                  in (Flows.bind (untypedTermToJson v) (\json -> Flows.pure (k, json))))+      in (Flows.bind (untypedTermToJson term1) (\json -> Flows.bind (Flows.mapList encodePair (Maps.toList ann)) (\pairs -> Flows.pure (Json.ValueObject (Maps.fromList [+        ("term", json),+        ("annotations", (Json.ValueObject (Maps.fromList pairs)))])))))+    Core.TermApplication v1 -> (asRecord [+      Core.Field {+        Core.fieldName = (Core.Name "function"),+        Core.fieldTerm = (Core.applicationFunction v1)},+      Core.Field {+        Core.fieldName = (Core.Name "argument"),+        Core.fieldTerm = (Core.applicationArgument v1)}])+    Core.TermFunction v1 -> ((\x -> case x of+      Core.FunctionElimination v2 -> ((\x -> case x of+        Core.EliminationRecord v3 -> (asVariant "project" (Core.TermVariable (Core.projectionField v3)))+        _ -> (unexp (Strings.cat [+          "unexpected elimination variant: ",+          (Core___.elimination v2)]))) v2)+      Core.FunctionLambda v2 -> (asRecord [+        Core.Field {+          Core.fieldName = (Core.Name "parameter"),+          Core.fieldTerm = (Core.TermVariable (Core.lambdaParameter v2))},+        Core.Field {+          Core.fieldName = (Core.Name "domain"),+          Core.fieldTerm = (Core.TermOptional (Optionals.map Core_.type_ (Core.lambdaDomain v2)))},+        Core.Field {+          Core.fieldName = (Core.Name "body"),+          Core.fieldTerm = (Core.lambdaBody v2)}])+      Core.FunctionPrimitive v2 -> (Flows.pure (Json.ValueString (Core.unName v2)))) v1)+    Core.TermLet v1 ->  +      let bindings = (Core.letBindings v1) +          env = (Core.letEnvironment v1)+          fromBinding = (\b -> Core.Field {+                  Core.fieldName = (Core.bindingName b),+                  Core.fieldTerm = (Core.bindingTerm b)})+      in (asRecord [+        Core.Field {+          Core.fieldName = (Core.Name "bindings"),+          Core.fieldTerm = (Core.TermRecord (Core.Record {+            Core.recordTypeName = (Core.Name ""),+            Core.recordFields = (Lists.map fromBinding bindings)}))},+        Core.Field {+          Core.fieldName = (Core.Name "environment"),+          Core.fieldTerm = env}])+    Core.TermList v1 -> (Flows.bind (Flows.mapList untypedTermToJson v1) (\jsonTerms -> Flows.pure (Json.ValueArray jsonTerms)))+    Core.TermLiteral v1 -> (Flows.pure ((\x -> case x of+      Core.LiteralBinary v2 -> (Json.ValueString (Literals.binaryToString v2))+      Core.LiteralBoolean v2 -> (Json.ValueBoolean v2)+      Core.LiteralFloat v2 -> (Json.ValueNumber (Literals_.floatValueToBigfloat v2))+      Core.LiteralInteger v2 ->  +        let bf = (Literals_.integerValueToBigint v2) +            f = (Literals.bigintToBigfloat bf)+        in (Json.ValueNumber f)+      Core.LiteralString v2 -> (Json.ValueString v2)) v1))+    Core.TermOptional v1 -> (Optionals.maybe (Flows.pure Json.ValueNull) untypedTermToJson v1)+    Core.TermProduct v1 -> (untypedTermToJson (Core.TermList v1))+    Core.TermRecord v1 ->  +      let fields = (Core.recordFields v1)+      in (Flows.bind (Flows.mapList fieldToKeyval fields) (\keyvals -> Flows.pure (Json.ValueObject (Maps.fromList (Optionals.cat keyvals)))))+    Core.TermSet v1 -> (untypedTermToJson (Core.TermList (Sets.toList v1)))+    Core.TermSum v1 -> (asRecord [+      Core.Field {+        Core.fieldName = (Core.Name "index"),+        Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumIndex v1))))},+      Core.Field {+        Core.fieldName = (Core.Name "size"),+        Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (Core.sumSize v1))))},+      Core.Field {+        Core.fieldName = (Core.Name "term"),+        Core.fieldTerm = (Core.sumTerm v1)}])+    Core.TermTypeLambda v1 -> (asRecord [+      Core.Field {+        Core.fieldName = (Core.Name "parameter"),+        Core.fieldTerm = (Core.TermVariable (Core.typeLambdaParameter v1))},+      Core.Field {+        Core.fieldName = (Core.Name "body"),+        Core.fieldTerm = (Core.typeLambdaBody v1)}])+    Core.TermTypeApplication v1 -> (asRecord [+      Core.Field {+        Core.fieldName = (Core.Name "term"),+        Core.fieldTerm = (Core.typedTermTerm v1)},+      Core.Field {+        Core.fieldName = (Core.Name "type"),+        Core.fieldTerm = (Core_.type_ (Core.typedTermType v1))}])+    Core.TermUnion v1 ->  +      let field = (Core.injectionField v1)+      in (Logic.ifElse (Equality.equal (Core.fieldTerm field) Core.TermUnit) (Flows.pure (Json.ValueString (Core.unName (Core.fieldName field)))) (Flows.bind (fieldToKeyval field) (\mkeyval -> Flows.pure (Json.ValueObject (Maps.fromList (Optionals.maybe [] (\keyval -> [+        keyval]) mkeyval))))))+    Core.TermVariable v1 -> (Flows.pure (Json.ValueString (Core.unName v1)))+    Core.TermWrap v1 -> (untypedTermToJson (Core.wrappedTermObject v1))+    _ -> (unexp (Strings.cat [+      "unsupported term variant: ",+      (Core___.term term)]))) term)++-- | Placeholder for reading a string into a term (to be implemented)+readStringStub :: (String -> Core.Term)+readStringStub s = (Core.TermLiteral (Core.LiteralString (Strings.cat2 "TODO: read " s)))++showValue :: (t0 -> String)+showValue value = "TODO: implement showValue"
src/gen-main/haskell/Hydra/Ext/Org/Json/Decoding.hs view
@@ -6,45 +6,36 @@ import qualified Hydra.Json as Json import qualified Hydra.Lib.Flows as Flows import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Optionals as Optionals import qualified Hydra.Lib.Strings as Strings-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--decodeString :: (Json.Value -> Compute.Flow s String)-decodeString x = case x of-  Json.ValueString v320 -> (Flows.pure v320)-  _ -> (Flows.fail "expected a string")+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S -decodeNumber :: (Json.Value -> Compute.Flow s Double)-decodeNumber x = case x of-  Json.ValueNumber v321 -> (Flows.pure v321)-  _ -> (Flows.fail "expected a number")+decodeArray :: ((Json.Value -> Compute.Flow t0 t1) -> Json.Value -> Compute.Flow t0 [t1])+decodeArray decodeElem x = case x of+  Json.ValueArray v1 -> (Flows.mapList decodeElem v1)+  _ -> (Flows.fail "expected an array") -decodeBoolean :: (Json.Value -> Compute.Flow s Bool)+decodeBoolean :: (Json.Value -> Compute.Flow t0 Bool) decodeBoolean x = case x of-  Json.ValueBoolean v322 -> (Flows.pure v322)+  Json.ValueBoolean v1 -> (Flows.pure v1)   _ -> (Flows.fail "expected a boolean") -decodeArray :: ((Json.Value -> Compute.Flow s a) -> Json.Value -> Compute.Flow s [a])-decodeArray decodeElem x = case x of-  Json.ValueArray v323 -> (Flows.mapList decodeElem v323)-  _ -> (Flows.fail "expected an array")+decodeField :: ((t0 -> Compute.Flow t1 t2) -> String -> M.Map String t0 -> Compute.Flow t1 t2)+decodeField decodeValue name m = (Flows.bind (decodeOptionalField decodeValue name m) (Optionals.maybe (Flows.fail (Strings.cat2 "missing field: " name)) (\f -> Flows.pure f))) -decodeObject :: (Json.Value -> Compute.Flow s (Map String Json.Value))+decodeObject :: (Json.Value -> Compute.Flow t0 (M.Map String Json.Value)) decodeObject x = case x of-  Json.ValueObject v324 -> (Flows.pure v324)+  Json.ValueObject v1 -> (Flows.pure v1)   _ -> (Flows.fail "expected an object") -decodeField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s a)-decodeField decodeValue name m = (Flows.bind (decodeOptionalField decodeValue name m) (\x -> case x of-  Nothing -> (Flows.fail (Strings.cat [-    "missing field: ",-    name]))-  Just v325 -> (Flows.pure v325)))+decodeOptionalField :: (Ord t3) => ((t0 -> Compute.Flow t1 t2) -> t3 -> M.Map t3 t0 -> Compute.Flow t1 (Maybe t2))+decodeOptionalField decodeValue name m = (Optionals.maybe (Flows.pure Nothing) (\v -> Flows.map (\x -> Just x) (decodeValue v)) (Maps.lookup name m)) -decodeOptionalField :: ((Json.Value -> Compute.Flow s a) -> String -> Map String Json.Value -> Compute.Flow s (Maybe a))-decodeOptionalField decodeValue name m = ((\x -> case x of-  Nothing -> (Flows.pure Nothing)-  Just v326 -> (Flows.map (\x -> Just x) (decodeValue v326))) (Maps.lookup name m))+decodeString :: (Json.Value -> Compute.Flow t0 String)+decodeString x = case x of+  Json.ValueString v1 -> (Flows.pure v1)+  _ -> (Flows.fail "expected a string")
+ src/gen-main/haskell/Hydra/Ext/Org/Json/Language.hs view
@@ -0,0 +1,57 @@+-- | Language constraints for JSON++module Hydra.Ext.Org.Json.Language where++import qualified Hydra.Coders as Coders+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Rewriting as Rewriting+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Language constraints for JSON+jsonLanguage :: Coders.Language+jsonLanguage = Coders.Language {+  Coders.languageName = (Coders.LanguageName "hydra.ext.org.json"),+  Coders.languageConstraints = Coders.LanguageConstraints {+    Coders.languageConstraintsEliminationVariants = eliminationVariants,+    Coders.languageConstraintsLiteralVariants = literalVariants,+    Coders.languageConstraintsFloatTypes = floatTypes,+    Coders.languageConstraintsFunctionVariants = functionVariants,+    Coders.languageConstraintsIntegerTypes = integerTypes,+    Coders.languageConstraintsTermVariants = termVariants,+    Coders.languageConstraintsTypeVariants = typeVariants,+    Coders.languageConstraintsTypes = typePredicate}} +  where +    eliminationVariants = Sets.empty+    literalVariants = (Sets.fromList [+      Mantle.LiteralVariantBoolean,+      Mantle.LiteralVariantFloat,+      Mantle.LiteralVariantInteger,+      Mantle.LiteralVariantString])+    floatTypes = (Sets.fromList [+      Core.FloatTypeBigfloat])+    functionVariants = Sets.empty+    integerTypes = (Sets.fromList [+      Core.IntegerTypeBigint])+    termVariants = (Sets.fromList [+      Mantle.TermVariantList,+      Mantle.TermVariantLiteral,+      Mantle.TermVariantMap,+      Mantle.TermVariantOptional,+      Mantle.TermVariantRecord])+    typeVariants = (Sets.fromList [+      Mantle.TypeVariantList,+      Mantle.TypeVariantLiteral,+      Mantle.TypeVariantMap,+      Mantle.TypeVariantOptional,+      Mantle.TypeVariantRecord])+    typePredicate = (\typ -> (\x -> case x of+      Core.TypeOptional v1 -> ((\x -> case x of+        Core.TypeOptional _ -> False+        _ -> True) v1)+      _ -> True) (Rewriting.deannotateType typ))
− src/gen-main/haskell/Hydra/Ext/Org/W3/Rdf/Syntax.hs 
@@ -1,183 +0,0 @@--- | An RDF 1.1 syntax model--module Hydra.Ext.Org.W3.Rdf.Syntax where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--newtype BlankNode = -  BlankNode {-    unBlankNode :: String}-  deriving (Eq, Ord, Read, Show)--_BlankNode = (Core.Name "hydra/ext/org/w3/rdf/syntax.BlankNode")---- | Stand-in for rdfs:Class-data RdfsClass = -  RdfsClass {}-  deriving (Eq, Ord, Read, Show)--_RdfsClass = (Core.Name "hydra/ext/org/w3/rdf/syntax.RdfsClass")--newtype Dataset = -  Dataset {-    unDataset :: (Set Quad)}-  deriving (Eq, Ord, Read, Show)--_Dataset = (Core.Name "hydra/ext/org/w3/rdf/syntax.Dataset")---- | A graph of RDF statements together with a distinguished subject and/or object node-data Description = -  Description {-    descriptionSubject :: Node,-    descriptionGraph :: Graph}-  deriving (Eq, Ord, Read, Show)--_Description = (Core.Name "hydra/ext/org/w3/rdf/syntax.Description")--_Description_subject = (Core.Name "subject")--_Description_graph = (Core.Name "graph")--newtype Graph = -  Graph {-    unGraph :: (Set Triple)}-  deriving (Eq, Ord, Read, Show)--_Graph = (Core.Name "hydra/ext/org/w3/rdf/syntax.Graph")---- | An Internationalized Resource Identifier-newtype Iri = -  Iri {-    unIri :: String}-  deriving (Eq, Ord, Read, Show)--_Iri = (Core.Name "hydra/ext/org/w3/rdf/syntax.Iri")---- | An IRI or a literal; this type is a convenience for downstream models like SHACL which may exclude blank nodes-data IriOrLiteral = -  IriOrLiteralIri Iri |-  IriOrLiteralLiteral Literal-  deriving (Eq, Ord, Read, Show)--_IriOrLiteral = (Core.Name "hydra/ext/org/w3/rdf/syntax.IriOrLiteral")--_IriOrLiteral_iri = (Core.Name "iri")--_IriOrLiteral_literal = (Core.Name "literal")---- | A convenience type which provides at most one string value per language, and optionally a value without a language-newtype LangStrings = -  LangStrings {-    unLangStrings :: (Map (Maybe LanguageTag) String)}-  deriving (Eq, Ord, Read, Show)--_LangStrings = (Core.Name "hydra/ext/org/w3/rdf/syntax.LangStrings")---- | A BCP47 language tag-newtype LanguageTag = -  LanguageTag {-    unLanguageTag :: String}-  deriving (Eq, Ord, Read, Show)--_LanguageTag = (Core.Name "hydra/ext/org/w3/rdf/syntax.LanguageTag")---- | A value such as a string, number, or date-data Literal = -  Literal {-    -- | a Unicode string, which should be in Normal Form C-    literalLexicalForm :: String,-    -- | an IRI identifying a datatype that determines how the lexical form maps to a literal value-    literalDatatypeIri :: Iri,-    -- | An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString-    literalLanguageTag :: (Maybe LanguageTag)}-  deriving (Eq, Ord, Read, Show)--_Literal = (Core.Name "hydra/ext/org/w3/rdf/syntax.Literal")--_Literal_lexicalForm = (Core.Name "lexicalForm")--_Literal_datatypeIri = (Core.Name "datatypeIri")--_Literal_languageTag = (Core.Name "languageTag")--data Node = -  NodeIri Iri |-  NodeBnode BlankNode |-  NodeLiteral Literal-  deriving (Eq, Ord, Read, Show)--_Node = (Core.Name "hydra/ext/org/w3/rdf/syntax.Node")--_Node_iri = (Core.Name "iri")--_Node_bnode = (Core.Name "bnode")--_Node_literal = (Core.Name "literal")---- | A type representing an RDF property, and encapsulating its domain, range, and subclass relationships-data Property = -  Property {-    -- | State that any resource that has a given property is an instance of one or more classes-    propertyDomain :: (Set RdfsClass),-    -- | States that the values of a property are instances of one or more classes-    propertyRange :: (Set RdfsClass),-    propertySubPropertyOf :: (Set Property)}-  deriving (Eq, Ord, Read, Show)--_Property = (Core.Name "hydra/ext/org/w3/rdf/syntax.Property")--_Property_domain = (Core.Name "domain")--_Property_range = (Core.Name "range")--_Property_subPropertyOf = (Core.Name "subPropertyOf")---- | An RDF triple with an optional named graph component-data Quad = -  Quad {-    quadSubject :: Resource,-    quadPredicate :: Iri,-    quadObject :: Node,-    quadGraph :: (Maybe Iri)}-  deriving (Eq, Ord, Read, Show)--_Quad = (Core.Name "hydra/ext/org/w3/rdf/syntax.Quad")--_Quad_subject = (Core.Name "subject")--_Quad_predicate = (Core.Name "predicate")--_Quad_object = (Core.Name "object")--_Quad_graph = (Core.Name "graph")--data Resource = -  ResourceIri Iri |-  ResourceBnode BlankNode-  deriving (Eq, Ord, Read, Show)--_Resource = (Core.Name "hydra/ext/org/w3/rdf/syntax.Resource")--_Resource_iri = (Core.Name "iri")--_Resource_bnode = (Core.Name "bnode")---- | An RDF triple defined by a subject, predicate, and object-data Triple = -  Triple {-    tripleSubject :: Resource,-    triplePredicate :: Iri,-    tripleObject :: Node}-  deriving (Eq, Ord, Read, Show)--_Triple = (Core.Name "hydra/ext/org/w3/rdf/syntax.Triple")--_Triple_subject = (Core.Name "subject")--_Triple_predicate = (Core.Name "predicate")--_Triple_object = (Core.Name "object")
− src/gen-main/haskell/Hydra/Ext/Org/W3/Shacl/Model.hs 
@@ -1,357 +0,0 @@--- | A SHACL syntax model. See https://www.w3.org/TR/shacl--module Hydra.Ext.Org.W3.Shacl.Model where--import qualified Hydra.Core as Core-import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Syntax-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | See https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent-data Closed = -  Closed {-    closedIsClosed :: Bool,-    closedIgnoredProperties :: (Maybe (Set Syntax.Property))}-  deriving (Eq, Ord, Read, Show)--_Closed = (Core.Name "hydra/ext/org/w3/shacl/model.Closed")--_Closed_isClosed = (Core.Name "isClosed")--_Closed_ignoredProperties = (Core.Name "ignoredProperties")---- | Any of a number of constraint parameters which can be applied either to node or property shapes-data CommonConstraint = -  -- | See https://www.w3.org/TR/shacl/#AndConstraintComponent-  CommonConstraintAnd (Set (Reference Shape)) |-  -- | See https://www.w3.org/TR/shacl/#ClosedConstraintComponent-  CommonConstraintClosed Closed |-  -- | See https://www.w3.org/TR/shacl/#ClassConstraintComponent-  CommonConstraintClass (Set Syntax.RdfsClass) |-  -- | See https://www.w3.org/TR/shacl/#DatatypeConstraintComponent-  CommonConstraintDatatype Syntax.Iri |-  -- | See https://www.w3.org/TR/shacl/#DisjointConstraintComponent-  CommonConstraintDisjoint (Set Syntax.Property) |-  -- | See https://www.w3.org/TR/shacl/#EqualsConstraintComponent-  CommonConstraintEquals (Set Syntax.Property) |-  -- | Specifies the condition that at least one value node is equal to the given RDF term. See https://www.w3.org/TR/shacl/#HasValueConstraintComponent-  CommonConstraintHasValue (Set Syntax.Node) |-  -- | Specifies the condition that each value node is a member of a provided SHACL list. See https://www.w3.org/TR/shacl/#InConstraintComponent-  CommonConstraintIn [Syntax.Node] |-  -- | See https://www.w3.org/TR/shacl/#LanguageInConstraintComponent-  CommonConstraintLanguageIn (Set Syntax.LanguageTag) |-  -- | See https://www.w3.org/TR/shacl/#NodeKindConstraintComponent-  CommonConstraintNodeKind NodeKind |-  -- | See https://www.w3.org/TR/shacl/#NodeConstraintComponent-  CommonConstraintNode (Set (Reference NodeShape)) |-  -- | See https://www.w3.org/TR/shacl/#NotConstraintComponent-  CommonConstraintNot (Set (Reference Shape)) |-  -- | See https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent-  CommonConstraintMaxExclusive Syntax.Literal |-  -- | See https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent-  CommonConstraintMaxInclusive Syntax.Literal |-  -- | See https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent-  CommonConstraintMaxLength Integer |-  -- | See https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent-  CommonConstraintMinExclusive Syntax.Literal |-  -- | See https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent-  CommonConstraintMinInclusive Syntax.Literal |-  -- | See https://www.w3.org/TR/shacl/#MinLengthConstraintComponent-  CommonConstraintMinLength Integer |-  -- | See https://www.w3.org/TR/shacl/#PatternConstraintComponent-  CommonConstraintPattern Pattern |-  -- | See https://www.w3.org/TR/shacl/#PropertyConstraintComponent-  CommonConstraintProperty (Set (Reference PropertyShape)) |-  -- | See https://www.w3.org/TR/shacl/#OrConstraintComponent-  CommonConstraintOr (Set (Reference Shape)) |-  -- | See https://www.w3.org/TR/shacl/#XoneConstraintComponent-  CommonConstraintXone (Set (Reference Shape))-  deriving (Eq, Ord, Read, Show)--_CommonConstraint = (Core.Name "hydra/ext/org/w3/shacl/model.CommonConstraint")--_CommonConstraint_and = (Core.Name "and")--_CommonConstraint_closed = (Core.Name "closed")--_CommonConstraint_class = (Core.Name "class")--_CommonConstraint_datatype = (Core.Name "datatype")--_CommonConstraint_disjoint = (Core.Name "disjoint")--_CommonConstraint_equals = (Core.Name "equals")--_CommonConstraint_hasValue = (Core.Name "hasValue")--_CommonConstraint_in = (Core.Name "in")--_CommonConstraint_languageIn = (Core.Name "languageIn")--_CommonConstraint_nodeKind = (Core.Name "nodeKind")--_CommonConstraint_node = (Core.Name "node")--_CommonConstraint_not = (Core.Name "not")--_CommonConstraint_maxExclusive = (Core.Name "maxExclusive")--_CommonConstraint_maxInclusive = (Core.Name "maxInclusive")--_CommonConstraint_maxLength = (Core.Name "maxLength")--_CommonConstraint_minExclusive = (Core.Name "minExclusive")--_CommonConstraint_minInclusive = (Core.Name "minInclusive")--_CommonConstraint_minLength = (Core.Name "minLength")--_CommonConstraint_pattern = (Core.Name "pattern")--_CommonConstraint_property = (Core.Name "property")--_CommonConstraint_or = (Core.Name "or")--_CommonConstraint_xone = (Core.Name "xone")---- | Common constraint parameters and other properties for SHACL shapes-data CommonProperties = -  CommonProperties {-    -- | Common constraint parameters attached to this shape-    commonPropertiesConstraints :: (Set CommonConstraint),-    -- | See https://www.w3.org/TR/shacl/#deactivated-    commonPropertiesDeactivated :: (Maybe Bool),-    -- | See https://www.w3.org/TR/shacl/#message-    commonPropertiesMessage :: Syntax.LangStrings,-    -- | See https://www.w3.org/TR/shacl/#severity-    commonPropertiesSeverity :: Severity,-    -- | See https://www.w3.org/TR/shacl/#targetClass-    commonPropertiesTargetClass :: (Set Syntax.RdfsClass),-    -- | See https://www.w3.org/TR/shacl/#targetNode-    commonPropertiesTargetNode :: (Set Syntax.IriOrLiteral),-    -- | See https://www.w3.org/TR/shacl/#targetObjectsOf-    commonPropertiesTargetObjectsOf :: (Set Syntax.Property),-    -- | See https://www.w3.org/TR/shacl/#targetSubjectsOf-    commonPropertiesTargetSubjectsOf :: (Set Syntax.Property)}-  deriving (Eq, Ord, Read, Show)--_CommonProperties = (Core.Name "hydra/ext/org/w3/shacl/model.CommonProperties")--_CommonProperties_constraints = (Core.Name "constraints")--_CommonProperties_deactivated = (Core.Name "deactivated")--_CommonProperties_message = (Core.Name "message")--_CommonProperties_severity = (Core.Name "severity")--_CommonProperties_targetClass = (Core.Name "targetClass")--_CommonProperties_targetNode = (Core.Name "targetNode")--_CommonProperties_targetObjectsOf = (Core.Name "targetObjectsOf")--_CommonProperties_targetSubjectsOf = (Core.Name "targetSubjectsOf")---- | An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance-data Definition a = -  Definition {-    definitionIri :: Syntax.Iri,-    definitionTarget :: a}-  deriving (Eq, Ord, Read, Show)--_Definition = (Core.Name "hydra/ext/org/w3/shacl/model.Definition")--_Definition_iri = (Core.Name "iri")--_Definition_target = (Core.Name "target")--data NodeKind = -  -- | A blank node-  NodeKindBlankNode  |-  -- | An IRI-  NodeKindIri  |-  -- | A literal-  NodeKindLiteral  |-  -- | A blank node or an IRI-  NodeKindBlankNodeOrIri  |-  -- | A blank node or a literal-  NodeKindBlankNodeOrLiteral  |-  -- | An IRI or a literal-  NodeKindIriOrLiteral -  deriving (Eq, Ord, Read, Show)--_NodeKind = (Core.Name "hydra/ext/org/w3/shacl/model.NodeKind")--_NodeKind_blankNode = (Core.Name "blankNode")--_NodeKind_iri = (Core.Name "iri")--_NodeKind_literal = (Core.Name "literal")--_NodeKind_blankNodeOrIri = (Core.Name "blankNodeOrIri")--_NodeKind_blankNodeOrLiteral = (Core.Name "blankNodeOrLiteral")--_NodeKind_iriOrLiteral = (Core.Name "iriOrLiteral")---- | A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes-data NodeShape = -  NodeShape {-    nodeShapeCommon :: CommonProperties}-  deriving (Eq, Ord, Read, Show)--_NodeShape = (Core.Name "hydra/ext/org/w3/shacl/model.NodeShape")--_NodeShape_common = (Core.Name "common")---- | A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent-data Pattern = -  Pattern {-    patternRegex :: String,-    patternFlags :: (Maybe String)}-  deriving (Eq, Ord, Read, Show)--_Pattern = (Core.Name "hydra/ext/org/w3/shacl/model.Pattern")--_Pattern_regex = (Core.Name "regex")--_Pattern_flags = (Core.Name "flags")---- | A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes-data PropertyShape = -  PropertyShape {-    propertyShapeCommon :: CommonProperties,-    -- | Any property shape -specific constraint parameters-    propertyShapeConstraints :: (Set PropertyShapeConstraint),-    -- | See https://www.w3.org/TR/shacl/#defaultValue-    propertyShapeDefaultValue :: (Maybe Syntax.Node),-    -- | See https://www.w3.org/TR/shacl/#name-    propertyShapeDescription :: Syntax.LangStrings,-    -- | See https://www.w3.org/TR/shacl/#name-    propertyShapeName :: Syntax.LangStrings,-    -- | See https://www.w3.org/TR/shacl/#order-    propertyShapeOrder :: (Maybe Integer),-    propertyShapePath :: Syntax.Iri}-  deriving (Eq, Ord, Read, Show)--_PropertyShape = (Core.Name "hydra/ext/org/w3/shacl/model.PropertyShape")--_PropertyShape_common = (Core.Name "common")--_PropertyShape_constraints = (Core.Name "constraints")--_PropertyShape_defaultValue = (Core.Name "defaultValue")--_PropertyShape_description = (Core.Name "description")--_PropertyShape_name = (Core.Name "name")--_PropertyShape_order = (Core.Name "order")--_PropertyShape_path = (Core.Name "path")---- | A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes-data PropertyShapeConstraint = -  -- | See https://www.w3.org/TR/shacl/#LessThanConstraintComponent-  PropertyShapeConstraintLessThan (Set Syntax.Property) |-  -- | See https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent-  PropertyShapeConstraintLessThanOrEquals (Set Syntax.Property) |-  -- | The maximum cardinality. Node shapes cannot have any value for sh:maxCount. See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent-  PropertyShapeConstraintMaxCount Integer |-  -- | The minimum cardinality. Node shapes cannot have any value for sh:minCount. See https://www.w3.org/TR/shacl/#MinCountConstraintComponent-  PropertyShapeConstraintMinCount Integer |-  -- | See https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent-  PropertyShapeConstraintUniqueLang Bool |-  -- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent-  PropertyShapeConstraintQualifiedValueShape QualifiedValueShape-  deriving (Eq, Ord, Read, Show)--_PropertyShapeConstraint = (Core.Name "hydra/ext/org/w3/shacl/model.PropertyShapeConstraint")--_PropertyShapeConstraint_lessThan = (Core.Name "lessThan")--_PropertyShapeConstraint_lessThanOrEquals = (Core.Name "lessThanOrEquals")--_PropertyShapeConstraint_maxCount = (Core.Name "maxCount")--_PropertyShapeConstraint_minCount = (Core.Name "minCount")--_PropertyShapeConstraint_uniqueLang = (Core.Name "uniqueLang")--_PropertyShapeConstraint_qualifiedValueShape = (Core.Name "qualifiedValueShape")---- | See https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent-data QualifiedValueShape = -  QualifiedValueShape {-    qualifiedValueShapeQualifiedValueShape :: (Reference Shape),-    qualifiedValueShapeQualifiedMaxCount :: Integer,-    qualifiedValueShapeQualifiedMinCount :: Integer,-    qualifiedValueShapeQualifiedValueShapesDisjoint :: (Maybe Bool)}-  deriving (Eq, Ord, Read, Show)--_QualifiedValueShape = (Core.Name "hydra/ext/org/w3/shacl/model.QualifiedValueShape")--_QualifiedValueShape_qualifiedValueShape = (Core.Name "qualifiedValueShape")--_QualifiedValueShape_qualifiedMaxCount = (Core.Name "qualifiedMaxCount")--_QualifiedValueShape_qualifiedMinCount = (Core.Name "qualifiedMinCount")--_QualifiedValueShape_qualifiedValueShapesDisjoint = (Core.Name "qualifiedValueShapesDisjoint")---- | Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type-data Reference a = -  ReferenceNamed Syntax.Iri |-  -- | An anonymous instance-  ReferenceAnonymous a |-  -- | An inline definition-  ReferenceDefinition (Definition a)-  deriving (Eq, Ord, Read, Show)--_Reference = (Core.Name "hydra/ext/org/w3/shacl/model.Reference")--_Reference_named = (Core.Name "named")--_Reference_anonymous = (Core.Name "anonymous")--_Reference_definition = (Core.Name "definition")--data Severity = -  -- | A non-critical constraint violation indicating an informative message-  SeverityInfo  |-  -- | A non-critical constraint violation indicating a warning-  SeverityWarning  |-  -- | A constraint violation-  SeverityViolation -  deriving (Eq, Ord, Read, Show)--_Severity = (Core.Name "hydra/ext/org/w3/shacl/model.Severity")--_Severity_info = (Core.Name "info")--_Severity_warning = (Core.Name "warning")--_Severity_violation = (Core.Name "violation")---- | A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes-data Shape = -  ShapeNode NodeShape |-  ShapeProperty PropertyShape-  deriving (Eq, Ord, Read, Show)--_Shape = (Core.Name "hydra/ext/org/w3/shacl/model.Shape")--_Shape_node = (Core.Name "node")--_Shape_property = (Core.Name "property")---- | An RDF graph containing zero or more shapes that is passed into a SHACL validation process so that a data graph can be validated against the shapes-newtype ShapesGraph = -  ShapesGraph {-    unShapesGraph :: (Set (Definition Shape))}-  deriving (Eq, Ord, Read, Show)--_ShapesGraph = (Core.Name "hydra/ext/org/w3/shacl/model.ShapesGraph")
src/gen-main/haskell/Hydra/Ext/Org/Yaml/Model.hs view
@@ -7,19 +7,20 @@ module Hydra.Ext.Org.Yaml.Model where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A YAML node (value) data Node = -  NodeMapping (Map Node Node) |+  NodeMapping (M.Map Node Node) |   NodeScalar Scalar |   NodeSequence [Node]   deriving (Eq, Ord, Read, Show) -_Node = (Core.Name "hydra/ext/org/yaml/model.Node")+_Node = (Core.Name "hydra.ext.org.yaml.model.Node")  _Node_mapping = (Core.Name "mapping") @@ -41,7 +42,7 @@   ScalarStr String   deriving (Eq, Ord, Read, Show) -_Scalar = (Core.Name "hydra/ext/org/yaml/model.Scalar")+_Scalar = (Core.Name "hydra.ext.org.yaml.model.Scalar")  _Scalar_bool = (Core.Name "bool")
− src/gen-main/haskell/Hydra/Ext/Pegasus/Pdl.hs 
@@ -1,268 +0,0 @@--- | A model for PDL (Pegasus Data Language) schemas. Based on the specification at:--- |   https://linkedin.github.io/rest.li/pdl_schema--module Hydra.Ext.Pegasus.Pdl where--import qualified Hydra.Core as Core-import qualified Hydra.Json as Json-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas-data Annotations = -  Annotations {-    annotationsDoc :: (Maybe String),-    annotationsDeprecated :: Bool}-  deriving (Eq, Ord, Read, Show)--_Annotations = (Core.Name "hydra/ext/pegasus/pdl.Annotations")--_Annotations_doc = (Core.Name "doc")--_Annotations_deprecated = (Core.Name "deprecated")--data EnumField = -  EnumField {-    enumFieldName :: EnumFieldName,-    enumFieldAnnotations :: Annotations}-  deriving (Eq, Ord, Read, Show)--_EnumField = (Core.Name "hydra/ext/pegasus/pdl.EnumField")--_EnumField_name = (Core.Name "name")--_EnumField_annotations = (Core.Name "annotations")--newtype EnumFieldName = -  EnumFieldName {-    unEnumFieldName :: String}-  deriving (Eq, Ord, Read, Show)--_EnumFieldName = (Core.Name "hydra/ext/pegasus/pdl.EnumFieldName")--data EnumSchema = -  EnumSchema {-    enumSchemaFields :: [EnumField]}-  deriving (Eq, Ord, Read, Show)--_EnumSchema = (Core.Name "hydra/ext/pegasus/pdl.EnumSchema")--_EnumSchema_fields = (Core.Name "fields")--newtype FieldName = -  FieldName {-    unFieldName :: String}-  deriving (Eq, Ord, Read, Show)--_FieldName = (Core.Name "hydra/ext/pegasus/pdl.FieldName")--data NamedSchema = -  NamedSchema {-    namedSchemaQualifiedName :: QualifiedName,-    namedSchemaType :: NamedSchema_Type,-    namedSchemaAnnotations :: Annotations}-  deriving (Eq, Ord, Read, Show)--_NamedSchema = (Core.Name "hydra/ext/pegasus/pdl.NamedSchema")--_NamedSchema_qualifiedName = (Core.Name "qualifiedName")--_NamedSchema_type = (Core.Name "type")--_NamedSchema_annotations = (Core.Name "annotations")--data NamedSchema_Type = -  NamedSchema_TypeRecord RecordSchema |-  NamedSchema_TypeEnum EnumSchema |-  NamedSchema_TypeTyperef Schema-  deriving (Eq, Ord, Read, Show)--_NamedSchema_Type = (Core.Name "hydra/ext/pegasus/pdl.NamedSchema.Type")--_NamedSchema_Type_record = (Core.Name "record")--_NamedSchema_Type_enum = (Core.Name "enum")--_NamedSchema_Type_typeref = (Core.Name "typeref")--newtype Name = -  Name {-    unName :: String}-  deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/pegasus/pdl.Name")--newtype Namespace = -  Namespace {-    unNamespace :: String}-  deriving (Eq, Ord, Read, Show)--_Namespace = (Core.Name "hydra/ext/pegasus/pdl.Namespace")--newtype Package = -  Package {-    unPackage :: String}-  deriving (Eq, Ord, Read, Show)--_Package = (Core.Name "hydra/ext/pegasus/pdl.Package")--data PrimitiveType = -  PrimitiveTypeBoolean  |-  PrimitiveTypeBytes  |-  PrimitiveTypeDouble  |-  PrimitiveTypeFloat  |-  PrimitiveTypeInt  |-  PrimitiveTypeLong  |-  PrimitiveTypeString -  deriving (Eq, Ord, Read, Show)--_PrimitiveType = (Core.Name "hydra/ext/pegasus/pdl.PrimitiveType")--_PrimitiveType_boolean = (Core.Name "boolean")--_PrimitiveType_bytes = (Core.Name "bytes")--_PrimitiveType_double = (Core.Name "double")--_PrimitiveType_float = (Core.Name "float")--_PrimitiveType_int = (Core.Name "int")--_PrimitiveType_long = (Core.Name "long")--_PrimitiveType_string = (Core.Name "string")--newtype PropertyKey = -  PropertyKey {-    unPropertyKey :: String}-  deriving (Eq, Ord, Read, Show)--_PropertyKey = (Core.Name "hydra/ext/pegasus/pdl.PropertyKey")--data Property = -  Property {-    propertyKey :: PropertyKey,-    propertyValue :: (Maybe Json.Value)}-  deriving (Eq, Ord, Read, Show)--_Property = (Core.Name "hydra/ext/pegasus/pdl.Property")--_Property_key = (Core.Name "key")--_Property_value = (Core.Name "value")--data QualifiedName = -  QualifiedName {-    qualifiedNameName :: Name,-    qualifiedNameNamespace :: (Maybe Namespace)}-  deriving (Eq, Ord, Read, Show)--_QualifiedName = (Core.Name "hydra/ext/pegasus/pdl.QualifiedName")--_QualifiedName_name = (Core.Name "name")--_QualifiedName_namespace = (Core.Name "namespace")--data RecordField = -  RecordField {-    recordFieldName :: FieldName,-    recordFieldValue :: Schema,-    recordFieldOptional :: Bool,-    recordFieldDefault :: (Maybe Json.Value),-    recordFieldAnnotations :: Annotations}-  deriving (Eq, Ord, Read, Show)--_RecordField = (Core.Name "hydra/ext/pegasus/pdl.RecordField")--_RecordField_name = (Core.Name "name")--_RecordField_value = (Core.Name "value")--_RecordField_optional = (Core.Name "optional")--_RecordField_default = (Core.Name "default")--_RecordField_annotations = (Core.Name "annotations")--data RecordSchema = -  RecordSchema {-    recordSchemaFields :: [RecordField],-    recordSchemaIncludes :: [NamedSchema]}-  deriving (Eq, Ord, Read, Show)--_RecordSchema = (Core.Name "hydra/ext/pegasus/pdl.RecordSchema")--_RecordSchema_fields = (Core.Name "fields")--_RecordSchema_includes = (Core.Name "includes")--data Schema = -  SchemaArray Schema |-  SchemaFixed Int |-  SchemaInline NamedSchema |-  SchemaMap Schema |-  SchemaNamed QualifiedName |-  SchemaNull  |-  SchemaPrimitive PrimitiveType |-  SchemaUnion UnionSchema-  deriving (Eq, Ord, Read, Show)--_Schema = (Core.Name "hydra/ext/pegasus/pdl.Schema")--_Schema_array = (Core.Name "array")--_Schema_fixed = (Core.Name "fixed")--_Schema_inline = (Core.Name "inline")--_Schema_map = (Core.Name "map")--_Schema_named = (Core.Name "named")--_Schema_null = (Core.Name "null")--_Schema_primitive = (Core.Name "primitive")--_Schema_union = (Core.Name "union")--data SchemaFile = -  SchemaFile {-    schemaFileNamespace :: Namespace,-    schemaFilePackage :: (Maybe Package),-    schemaFileImports :: [QualifiedName],-    schemaFileSchemas :: [NamedSchema]}-  deriving (Eq, Ord, Read, Show)--_SchemaFile = (Core.Name "hydra/ext/pegasus/pdl.SchemaFile")--_SchemaFile_namespace = (Core.Name "namespace")--_SchemaFile_package = (Core.Name "package")--_SchemaFile_imports = (Core.Name "imports")--_SchemaFile_schemas = (Core.Name "schemas")--data UnionMember = -  UnionMember {-    unionMemberAlias :: (Maybe FieldName),-    unionMemberValue :: Schema,-    unionMemberAnnotations :: Annotations}-  deriving (Eq, Ord, Read, Show)--_UnionMember = (Core.Name "hydra/ext/pegasus/pdl.UnionMember")--_UnionMember_alias = (Core.Name "alias")--_UnionMember_value = (Core.Name "value")--_UnionMember_annotations = (Core.Name "annotations")--newtype UnionSchema = -  UnionSchema {-    unUnionSchema :: [UnionMember]}-  deriving (Eq, Ord, Read, Show)--_UnionSchema = (Core.Name "hydra/ext/pegasus/pdl.UnionSchema")
− src/gen-main/haskell/Hydra/Ext/Protobuf/Any.hs 
@@ -1,24 +0,0 @@--- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto--module Hydra.Ext.Protobuf.Any where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | `Any` contains an arbitrary serialized protocol buffer message along with a URL that describes the type of the serialized message.-data Any = -  Any {-    -- | A URL/resource name that uniquely identifies the type of the serialized protocol buffer message.-    anyTypeUrl :: String,-    -- | Must be a valid serialized protocol buffer of the above specified type.-    anyValue :: String}-  deriving (Eq, Ord, Read, Show)--_Any = (Core.Name "hydra/ext/protobuf/any.Any")--_Any_typeUrl = (Core.Name "typeUrl")--_Any_value = (Core.Name "value")
− src/gen-main/haskell/Hydra/Ext/Protobuf/Language.hs 
@@ -1,90 +0,0 @@--- | Language constraints for Protobuf v3--module Hydra.Ext.Protobuf.Language where--import qualified Hydra.Coders as Coders-import qualified Hydra.Core as Core-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Sets as Sets-import qualified Hydra.Mantle as Mantle-import qualified Hydra.Strip as Strip-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Language constraints for Protocol Buffers v3-protobufLanguage :: Coders.Language-protobufLanguage = Coders.Language {-  Coders.languageName = (Coders.LanguageName "hydra/ext/protobuf"),-  Coders.languageConstraints = Coders.LanguageConstraints {-    Coders.languageConstraintsEliminationVariants = Sets.empty,-    Coders.languageConstraintsLiteralVariants = (Sets.fromList [-      Mantle.LiteralVariantBinary,-      Mantle.LiteralVariantBoolean,-      Mantle.LiteralVariantFloat,-      Mantle.LiteralVariantInteger,-      Mantle.LiteralVariantString]),-    Coders.languageConstraintsFloatTypes = (Sets.fromList [-      Core.FloatTypeFloat32,-      Core.FloatTypeFloat64]),-    Coders.languageConstraintsFunctionVariants = Sets.empty,-    Coders.languageConstraintsIntegerTypes = (Sets.fromList [-      Core.IntegerTypeInt32,-      Core.IntegerTypeInt64,-      Core.IntegerTypeUint32,-      Core.IntegerTypeUint64]),-    Coders.languageConstraintsTermVariants = (Sets.fromList [-      Mantle.TermVariantList,-      Mantle.TermVariantLiteral,-      Mantle.TermVariantMap,-      Mantle.TermVariantOptional,-      Mantle.TermVariantRecord,-      Mantle.TermVariantUnion]),-    Coders.languageConstraintsTypeVariants = (Sets.fromList [-      Mantle.TypeVariantAnnotated,-      Mantle.TypeVariantList,-      Mantle.TypeVariantLiteral,-      Mantle.TypeVariantMap,-      Mantle.TypeVariantOptional,-      Mantle.TypeVariantRecord,-      Mantle.TypeVariantUnion,-      Mantle.TypeVariantVariable]),-    Coders.languageConstraintsTypes = (\x -> case x of-      Core.TypeMap v327 -> ((\x -> case x of-        Core.TypeOptional _ -> False-        _ -> True) (Strip.stripType (Core.mapTypeValues v327)))-      _ -> True)}}---- | A set of reserved words in Protobuf-protobufReservedWords :: (Set String)-protobufReservedWords = (Sets.fromList (Lists.concat [-  fieldNames])) -  where -    fieldNames = [-      "case",-      "class",-      "data",-      "default",-      "deriving",-      "do",-      "else",-      "foreign",-      "if",-      "import",-      "in",-      "infix",-      "infixl",-      "infixr",-      "instance",-      "let",-      "mdo",-      "module",-      "newtype",-      "of",-      "pattern",-      "proc",-      "rec",-      "then",-      "type",-      "where"]
− src/gen-main/haskell/Hydra/Ext/Protobuf/Proto3.hs 
@@ -1,275 +0,0 @@--- | A model for Protocol Buffers v3 enum and message types, designed as a target for transformations.This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto, as well as the proto3 reference documentation--module Hydra.Ext.Protobuf.Proto3 where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--data Definition = -  DefinitionEnum EnumDefinition |-  DefinitionMessage MessageDefinition-  deriving (Eq, Ord, Read, Show)--_Definition = (Core.Name "hydra/ext/protobuf/proto3.Definition")--_Definition_enum = (Core.Name "enum")--_Definition_message = (Core.Name "message")---- | Enum type definition-data EnumDefinition = -  EnumDefinition {-    -- | Enum type name-    enumDefinitionName :: TypeName,-    -- | Enum value definitions-    enumDefinitionValues :: [EnumValue],-    -- | Protocol buffer options-    enumDefinitionOptions :: [Option]}-  deriving (Eq, Ord, Read, Show)--_EnumDefinition = (Core.Name "hydra/ext/protobuf/proto3.EnumDefinition")--_EnumDefinition_name = (Core.Name "name")--_EnumDefinition_values = (Core.Name "values")--_EnumDefinition_options = (Core.Name "options")---- | Enum value definition-data EnumValue = -  EnumValue {-    -- | Enum value name-    enumValueName :: EnumValueName,-    -- | Enum value number-    enumValueNumber :: Int,-    -- | Protocol buffer options-    enumValueOptions :: [Option]}-  deriving (Eq, Ord, Read, Show)--_EnumValue = (Core.Name "hydra/ext/protobuf/proto3.EnumValue")--_EnumValue_name = (Core.Name "name")--_EnumValue_number = (Core.Name "number")--_EnumValue_options = (Core.Name "options")--newtype EnumValueName = -  EnumValueName {-    unEnumValueName :: String}-  deriving (Eq, Ord, Read, Show)--_EnumValueName = (Core.Name "hydra/ext/protobuf/proto3.EnumValueName")---- | A single field of a message type-data Field = -  Field {-    -- | The field name-    fieldName :: FieldName,-    -- | The field JSON name-    fieldJsonName :: (Maybe String),-    -- | The datatype of the field-    fieldType :: FieldType,-    -- | The field number-    fieldNumber :: Int,-    -- | The protocol buffer options-    fieldOptions :: [Option]}-  deriving (Eq, Ord, Read, Show)--_Field = (Core.Name "hydra/ext/protobuf/proto3.Field")--_Field_name = (Core.Name "name")--_Field_jsonName = (Core.Name "jsonName")--_Field_type = (Core.Name "type")--_Field_number = (Core.Name "number")--_Field_options = (Core.Name "options")---- | The name of a field-newtype FieldName = -  FieldName {-    unFieldName :: String}-  deriving (Eq, Ord, Read, Show)--_FieldName = (Core.Name "hydra/ext/protobuf/proto3.FieldName")--data FieldType = -  FieldTypeMap SimpleType |-  FieldTypeOneof [Field] |-  FieldTypeRepeated SimpleType |-  FieldTypeSimple SimpleType-  deriving (Eq, Ord, Read, Show)--_FieldType = (Core.Name "hydra/ext/protobuf/proto3.FieldType")--_FieldType_map = (Core.Name "map")--_FieldType_oneof = (Core.Name "oneof")--_FieldType_repeated = (Core.Name "repeated")--_FieldType_simple = (Core.Name "simple")--newtype FileReference = -  FileReference {-    unFileReference :: String}-  deriving (Eq, Ord, Read, Show)--_FileReference = (Core.Name "hydra/ext/protobuf/proto3.FileReference")---- | A protocol buffer message type-data MessageDefinition = -  MessageDefinition {-    -- | The fully qualified message name-    messageDefinitionName :: TypeName,-    -- | The list of fields-    messageDefinitionFields :: [Field],-    -- | The protocol buffer options-    messageDefinitionOptions :: [Option]}-  deriving (Eq, Ord, Read, Show)--_MessageDefinition = (Core.Name "hydra/ext/protobuf/proto3.MessageDefinition")--_MessageDefinition_name = (Core.Name "name")--_MessageDefinition_fields = (Core.Name "fields")--_MessageDefinition_options = (Core.Name "options")---- | A protocol buffer option, which can be attached to a message, field, enumeration, etc-data Option = -  Option {-    -- | The option's name. For protobuf built-in options (options defined in descriptor.proto), this is the short name. For example, `"map_entry"`. For custom options, it should be the fully-qualified name. For example, `"google.api.http"`.-    optionName :: String,-    -- | The option's value-    optionValue :: Value}-  deriving (Eq, Ord, Read, Show)--_Option = (Core.Name "hydra/ext/protobuf/proto3.Option")--_Option_name = (Core.Name "name")--_Option_value = (Core.Name "value")--newtype PackageName = -  PackageName {-    unPackageName :: String}-  deriving (Eq, Ord, Read, Show)--_PackageName = (Core.Name "hydra/ext/protobuf/proto3.PackageName")---- | A .proto file, usually containing one or more enum or message type definitions-data ProtoFile = -  ProtoFile {-    protoFilePackage :: PackageName,-    protoFileImports :: [FileReference],-    protoFileTypes :: [Definition],-    protoFileOptions :: [Option]}-  deriving (Eq, Ord, Read, Show)--_ProtoFile = (Core.Name "hydra/ext/protobuf/proto3.ProtoFile")--_ProtoFile_package = (Core.Name "package")--_ProtoFile_imports = (Core.Name "imports")--_ProtoFile_types = (Core.Name "types")--_ProtoFile_options = (Core.Name "options")---- | One of several Proto3 scalar types-data ScalarType = -  ScalarTypeBool  |-  ScalarTypeBytes  |-  ScalarTypeDouble  |-  ScalarTypeFixed32  |-  ScalarTypeFixed64  |-  ScalarTypeFloat  |-  ScalarTypeInt32  |-  ScalarTypeInt64  |-  ScalarTypeSfixed32  |-  ScalarTypeSfixed64  |-  ScalarTypeSint32  |-  ScalarTypeSint64  |-  ScalarTypeString  |-  ScalarTypeUint32  |-  ScalarTypeUint64 -  deriving (Eq, Ord, Read, Show)--_ScalarType = (Core.Name "hydra/ext/protobuf/proto3.ScalarType")--_ScalarType_bool = (Core.Name "bool")--_ScalarType_bytes = (Core.Name "bytes")--_ScalarType_double = (Core.Name "double")--_ScalarType_fixed32 = (Core.Name "fixed32")--_ScalarType_fixed64 = (Core.Name "fixed64")--_ScalarType_float = (Core.Name "float")--_ScalarType_int32 = (Core.Name "int32")--_ScalarType_int64 = (Core.Name "int64")--_ScalarType_sfixed32 = (Core.Name "sfixed32")--_ScalarType_sfixed64 = (Core.Name "sfixed64")--_ScalarType_sint32 = (Core.Name "sint32")--_ScalarType_sint64 = (Core.Name "sint64")--_ScalarType_string = (Core.Name "string")--_ScalarType_uint32 = (Core.Name "uint32")--_ScalarType_uint64 = (Core.Name "uint64")---- | A scalar type or a reference to an enum type or message type-data SimpleType = -  SimpleTypeReference TypeName |-  SimpleTypeScalar ScalarType-  deriving (Eq, Ord, Read, Show)--_SimpleType = (Core.Name "hydra/ext/protobuf/proto3.SimpleType")--_SimpleType_reference = (Core.Name "reference")--_SimpleType_scalar = (Core.Name "scalar")---- | The local name of an enum type or message type-newtype TypeName = -  TypeName {-    unTypeName :: String}-  deriving (Eq, Ord, Read, Show)--_TypeName = (Core.Name "hydra/ext/protobuf/proto3.TypeName")---- | A reference to an enum type or message type-newtype TypeReference = -  TypeReference {-    unTypeReference :: String}-  deriving (Eq, Ord, Read, Show)--_TypeReference = (Core.Name "hydra/ext/protobuf/proto3.TypeReference")---- | A scalar value-data Value = -  ValueBoolean Bool |-  ValueString String-  deriving (Eq, Ord, Read, Show)--_Value = (Core.Name "hydra/ext/protobuf/proto3.Value")--_Value_boolean = (Core.Name "boolean")--_Value_string = (Core.Name "string")
− src/gen-main/haskell/Hydra/Ext/Protobuf/SourceContext.hs 
@@ -1,20 +0,0 @@--- | Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto--module Hydra.Ext.Protobuf.SourceContext where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | `SourceContext` represents information about the source of a protobuf element, like the file in which it is defined.-data SourceContext = -  SourceContext {-    -- | The path-qualified name of the .proto file that contained the associated protobuf element.  For example: `"google/protobuf/source_context.proto"`.-    sourceContextFileName :: String}-  deriving (Eq, Ord, Read, Show)--_SourceContext = (Core.Name "hydra/ext/protobuf/sourceContext.SourceContext")--_SourceContext_fileName = (Core.Name "fileName")
− src/gen-main/haskell/Hydra/Ext/RelationalModel.hs 
@@ -1,113 +0,0 @@--- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.--module Hydra.Ext.RelationalModel where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd-newtype ColumnName = -  ColumnName {-    unColumnName :: String}-  deriving (Eq, Ord, Read, Show)--_ColumnName = (Core.Name "hydra/ext/relationalModel.ColumnName")---- | An abstract specification of the domain represented by a column in a relation; a role-data ColumnSchema t = -  ColumnSchema {-    -- | A unique name for the column-    columnSchemaName :: ColumnName,-    -- | The domain (type) of the column-    columnSchemaDomain :: t,-    -- | Whether this column represents the primary key of its relation-    columnSchemaIsPrimaryKey :: Bool}-  deriving (Eq, Ord, Read, Show)--_ColumnSchema = (Core.Name "hydra/ext/relationalModel.ColumnSchema")--_ColumnSchema_name = (Core.Name "name")--_ColumnSchema_domain = (Core.Name "domain")--_ColumnSchema_isPrimaryKey = (Core.Name "isPrimaryKey")---- | A mapping from certain columns of a source relation to primary key columns of a target relation-data ForeignKey = -  ForeignKey {-    -- | The name of the target relation-    foreignKeyForeignRelation :: RelationName,-    foreignKeyKeys :: (Map ColumnName ColumnName)}-  deriving (Eq, Ord, Read, Show)--_ForeignKey = (Core.Name "hydra/ext/relationalModel.ForeignKey")--_ForeignKey_foreignRelation = (Core.Name "foreignRelation")--_ForeignKey_keys = (Core.Name "keys")---- | A primary key of a relation, specified either as a single column, or as a list of columns-newtype PrimaryKey = -  PrimaryKey {-    unPrimaryKey :: [ColumnName]}-  deriving (Eq, Ord, Read, Show)--_PrimaryKey = (Core.Name "hydra/ext/relationalModel.PrimaryKey")---- | A set of distinct n-tuples; a table-newtype Relation v = -  Relation {-    unRelation :: (Set [v])}-  deriving (Eq, Ord, Read, Show)--_Relation = (Core.Name "hydra/ext/relationalModel.Relation")---- | A unique relation (table) name-newtype RelationName = -  RelationName {-    unRelationName :: String}-  deriving (Eq, Ord, Read, Show)--_RelationName = (Core.Name "hydra/ext/relationalModel.RelationName")---- | An abstract relation; the name and columns of a relation without its actual data-data RelationSchema t = -  RelationSchema {-    -- | A unique name for the relation-    relationSchemaName :: RelationName,-    -- | A list of column specifications-    relationSchemaColumns :: [ColumnSchema t],-    -- | Any number of primary keys for the relation, each of which must be valid for this relation-    relationSchemaPrimaryKeys :: [PrimaryKey],-    -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation-    relationSchemaForeignKeys :: [ForeignKey]}-  deriving (Eq, Ord, Read, Show)--_RelationSchema = (Core.Name "hydra/ext/relationalModel.RelationSchema")--_RelationSchema_name = (Core.Name "name")--_RelationSchema_columns = (Core.Name "columns")--_RelationSchema_primaryKeys = (Core.Name "primaryKeys")--_RelationSchema_foreignKeys = (Core.Name "foreignKeys")---- | A domain-unordered (string-indexed, rather than position-indexed) relation-newtype Relationship v = -  Relationship {-    unRelationship :: (Set (Map ColumnName v))}-  deriving (Eq, Ord, Read, Show)--_Relationship = (Core.Name "hydra/ext/relationalModel.Relationship")---- | An n-tuple which is an element of a given relation-newtype Row v = -  Row {-    unRow :: [v]}-  deriving (Eq, Ord, Read, Show)--_Row = (Core.Name "hydra/ext/relationalModel.Row")
− src/gen-main/haskell/Hydra/Ext/Scala/Meta.hs 
@@ -1,2265 +0,0 @@--- | A Scala syntax model based on Scalameta (https://scalameta.org)--module Hydra.Ext.Scala.Meta where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--newtype PredefString = -  PredefString {-    unPredefString :: String}-  deriving (Eq, Ord, Read, Show)--_PredefString = (Core.Name "hydra/ext/scala/meta.PredefString")--data ScalaSymbol = -  ScalaSymbol {-    scalaSymbolName :: String}-  deriving (Eq, Ord, Read, Show)--_ScalaSymbol = (Core.Name "hydra/ext/scala/meta.ScalaSymbol")--_ScalaSymbol_name = (Core.Name "name")--data Tree = -  TreeRef Ref |-  TreeStat Stat |-  TreeType Type |-  TreeBounds Type_Bounds |-  TreePat Pat |-  TreeMember Member |-  TreeCtor Ctor |-  TreeTemplate Template |-  TreeMod Mod |-  TreeEnumerator Enumerator |-  TreeImporter Importer |-  TreeImportee Importee |-  TreeCaseTree CaseTree |-  TreeSource Source |-  TreeQuasi Quasi-  deriving (Eq, Ord, Read, Show)--_Tree = (Core.Name "hydra/ext/scala/meta.Tree")--_Tree_ref = (Core.Name "ref")--_Tree_stat = (Core.Name "stat")--_Tree_type = (Core.Name "type")--_Tree_bounds = (Core.Name "bounds")--_Tree_pat = (Core.Name "pat")--_Tree_member = (Core.Name "member")--_Tree_ctor = (Core.Name "ctor")--_Tree_template = (Core.Name "template")--_Tree_mod = (Core.Name "mod")--_Tree_enumerator = (Core.Name "enumerator")--_Tree_importer = (Core.Name "importer")--_Tree_importee = (Core.Name "importee")--_Tree_caseTree = (Core.Name "caseTree")--_Tree_source = (Core.Name "source")--_Tree_quasi = (Core.Name "quasi")--data Ref = -  RefName Name |-  RefInit Init-  deriving (Eq, Ord, Read, Show)--_Ref = (Core.Name "hydra/ext/scala/meta.Ref")--_Ref_name = (Core.Name "name")--_Ref_init = (Core.Name "init")--data Stat = -  StatTerm Data |-  StatDecl Decl |-  StatDefn Defn |-  StatImportExport ImportExportStat-  deriving (Eq, Ord, Read, Show)--_Stat = (Core.Name "hydra/ext/scala/meta.Stat")--_Stat_term = (Core.Name "term")--_Stat_decl = (Core.Name "decl")--_Stat_defn = (Core.Name "defn")--_Stat_importExport = (Core.Name "importExport")--data Name = -  NameValue String |-  NameAnonymous  |-  NameIndeterminate PredefString-  deriving (Eq, Ord, Read, Show)--_Name = (Core.Name "hydra/ext/scala/meta.Name")--_Name_value = (Core.Name "value")--_Name_anonymous = (Core.Name "anonymous")--_Name_indeterminate = (Core.Name "indeterminate")--data Lit = -  LitNull  |-  LitInt Int |-  LitDouble Double |-  LitFloat Float |-  LitByte Int8 |-  LitShort Int16 |-  LitChar Int |-  LitLong Int64 |-  LitBoolean Bool |-  LitUnit  |-  LitString String |-  LitSymbol ScalaSymbol-  deriving (Eq, Ord, Read, Show)--_Lit = (Core.Name "hydra/ext/scala/meta.Lit")--_Lit_null = (Core.Name "null")--_Lit_int = (Core.Name "int")--_Lit_double = (Core.Name "double")--_Lit_float = (Core.Name "float")--_Lit_byte = (Core.Name "byte")--_Lit_short = (Core.Name "short")--_Lit_char = (Core.Name "char")--_Lit_long = (Core.Name "long")--_Lit_boolean = (Core.Name "boolean")--_Lit_unit = (Core.Name "unit")--_Lit_string = (Core.Name "string")--_Lit_symbol = (Core.Name "symbol")--data Data = -  DataLit Lit |-  DataRef Data_Ref |-  DataInterpolate Data_Interpolate |-  DataXml Data_Xml |-  DataApply Data_Apply |-  DataApplyUsing Data_ApplyUsing |-  DataApplyType Data_ApplyType |-  DataAssign Data_Assign |-  DataReturn Data_Return |-  DataThrow Data_Throw |-  DataAscribe Data_Ascribe |-  DataAnnotate Data_Annotate |-  DataTuple Data_Tuple |-  DataBlock Data_Block |-  DataEndMarker Data_EndMarker |-  DataIf Data_If |-  DataQuotedMacroExpr Data_QuotedMacroExpr |-  DataQuotedMacroType Data_QuotedMacroType |-  DataSplicedMacroExpr Data_SplicedMacroExpr |-  DataMatch Data_Match |-  DataTry Data_Try |-  DataTryWithHandler Data_TryWithHandler |-  DataFunctionData Data_FunctionData |-  DataPolyFunction Data_PolyFunction |-  DataPartialFunction Data_PartialFunction |-  DataWhile Data_While |-  DataDo Data_Do |-  DataFor Data_For |-  DataForYield Data_ForYield |-  DataNew Data_New |-  DataNewAnonymous Data_NewAnonymous |-  DataPlaceholder Data_Placeholder |-  DataEta Data_Eta |-  DataRepeated Data_Repeated |-  DataParam Data_Param-  deriving (Eq, Ord, Read, Show)--_Data = (Core.Name "hydra/ext/scala/meta.Data")--_Data_lit = (Core.Name "lit")--_Data_ref = (Core.Name "ref")--_Data_interpolate = (Core.Name "interpolate")--_Data_xml = (Core.Name "xml")--_Data_apply = (Core.Name "apply")--_Data_applyUsing = (Core.Name "applyUsing")--_Data_applyType = (Core.Name "applyType")--_Data_assign = (Core.Name "assign")--_Data_return = (Core.Name "return")--_Data_throw = (Core.Name "throw")--_Data_ascribe = (Core.Name "ascribe")--_Data_annotate = (Core.Name "annotate")--_Data_tuple = (Core.Name "tuple")--_Data_block = (Core.Name "block")--_Data_endMarker = (Core.Name "endMarker")--_Data_if = (Core.Name "if")--_Data_quotedMacroExpr = (Core.Name "quotedMacroExpr")--_Data_quotedMacroType = (Core.Name "quotedMacroType")--_Data_splicedMacroExpr = (Core.Name "splicedMacroExpr")--_Data_match = (Core.Name "match")--_Data_try = (Core.Name "try")--_Data_tryWithHandler = (Core.Name "tryWithHandler")--_Data_functionData = (Core.Name "functionData")--_Data_polyFunction = (Core.Name "polyFunction")--_Data_partialFunction = (Core.Name "partialFunction")--_Data_while = (Core.Name "while")--_Data_do = (Core.Name "do")--_Data_for = (Core.Name "for")--_Data_forYield = (Core.Name "forYield")--_Data_new = (Core.Name "new")--_Data_newAnonymous = (Core.Name "newAnonymous")--_Data_placeholder = (Core.Name "placeholder")--_Data_eta = (Core.Name "eta")--_Data_repeated = (Core.Name "repeated")--_Data_param = (Core.Name "param")--data Data_Ref = -  Data_RefThis Data_This |-  Data_RefSuper Data_Super |-  Data_RefName Data_Name |-  Data_RefAnonymous Data_Anonymous |-  Data_RefSelect Data_Select |-  Data_RefApplyUnary Data_ApplyUnary-  deriving (Eq, Ord, Read, Show)--_Data_Ref = (Core.Name "hydra/ext/scala/meta.Data.Ref")--_Data_Ref_this = (Core.Name "this")--_Data_Ref_super = (Core.Name "super")--_Data_Ref_name = (Core.Name "name")--_Data_Ref_anonymous = (Core.Name "anonymous")--_Data_Ref_select = (Core.Name "select")--_Data_Ref_applyUnary = (Core.Name "applyUnary")--data Data_This = -  Data_This {}-  deriving (Eq, Ord, Read, Show)--_Data_This = (Core.Name "hydra/ext/scala/meta.Data.This")--data Data_Super = -  Data_Super {-    data_SuperThisp :: Name,-    data_SuperSuperp :: Name}-  deriving (Eq, Ord, Read, Show)--_Data_Super = (Core.Name "hydra/ext/scala/meta.Data.Super")--_Data_Super_thisp = (Core.Name "thisp")--_Data_Super_superp = (Core.Name "superp")--data Data_Name = -  Data_Name {-    data_NameValue :: PredefString}-  deriving (Eq, Ord, Read, Show)--_Data_Name = (Core.Name "hydra/ext/scala/meta.Data.Name")--_Data_Name_value = (Core.Name "value")--data Data_Anonymous = -  Data_Anonymous {}-  deriving (Eq, Ord, Read, Show)--_Data_Anonymous = (Core.Name "hydra/ext/scala/meta.Data.Anonymous")--data Data_Select = -  Data_Select {-    data_SelectQual :: Data,-    data_SelectName :: Data_Name}-  deriving (Eq, Ord, Read, Show)--_Data_Select = (Core.Name "hydra/ext/scala/meta.Data.Select")--_Data_Select_qual = (Core.Name "qual")--_Data_Select_name = (Core.Name "name")--data Data_Interpolate = -  Data_Interpolate {-    data_InterpolatePrefix :: Data_Name,-    data_InterpolateParts :: [Lit],-    data_InterpolateArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_Interpolate = (Core.Name "hydra/ext/scala/meta.Data.Interpolate")--_Data_Interpolate_prefix = (Core.Name "prefix")--_Data_Interpolate_parts = (Core.Name "parts")--_Data_Interpolate_args = (Core.Name "args")--data Data_Xml = -  Data_Xml {-    data_XmlParts :: [Lit],-    data_XmlArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_Xml = (Core.Name "hydra/ext/scala/meta.Data.Xml")--_Data_Xml_parts = (Core.Name "parts")--_Data_Xml_args = (Core.Name "args")--data Data_Apply = -  Data_Apply {-    data_ApplyFun :: Data,-    data_ApplyArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_Apply = (Core.Name "hydra/ext/scala/meta.Data.Apply")--_Data_Apply_fun = (Core.Name "fun")--_Data_Apply_args = (Core.Name "args")--data Data_ApplyUsing = -  Data_ApplyUsing {-    data_ApplyUsingFun :: Data,-    data_ApplyUsingTargs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_ApplyUsing = (Core.Name "hydra/ext/scala/meta.Data.ApplyUsing")--_Data_ApplyUsing_fun = (Core.Name "fun")--_Data_ApplyUsing_targs = (Core.Name "targs")--data Data_ApplyType = -  Data_ApplyType {-    data_ApplyTypeLhs :: Data,-    data_ApplyTypeOp :: Data_Name,-    data_ApplyTypeTargs :: [Type],-    data_ApplyTypeArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_ApplyType = (Core.Name "hydra/ext/scala/meta.Data.ApplyType")--_Data_ApplyType_lhs = (Core.Name "lhs")--_Data_ApplyType_op = (Core.Name "op")--_Data_ApplyType_targs = (Core.Name "targs")--_Data_ApplyType_args = (Core.Name "args")--data Data_ApplyInfix = -  Data_ApplyInfix {-    data_ApplyInfixLhs :: Data,-    data_ApplyInfixOp :: Data_Name,-    data_ApplyInfixTargs :: [Type],-    data_ApplyInfixArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_ApplyInfix = (Core.Name "hydra/ext/scala/meta.Data.ApplyInfix")--_Data_ApplyInfix_lhs = (Core.Name "lhs")--_Data_ApplyInfix_op = (Core.Name "op")--_Data_ApplyInfix_targs = (Core.Name "targs")--_Data_ApplyInfix_args = (Core.Name "args")--data Data_ApplyUnary = -  Data_ApplyUnary {-    data_ApplyUnaryOp :: Data_Name,-    data_ApplyUnaryArg :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_ApplyUnary = (Core.Name "hydra/ext/scala/meta.Data.ApplyUnary")--_Data_ApplyUnary_op = (Core.Name "op")--_Data_ApplyUnary_arg = (Core.Name "arg")--data Data_Assign = -  Data_Assign {-    data_AssignLhs :: Data,-    data_AssignRhs :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Assign = (Core.Name "hydra/ext/scala/meta.Data.Assign")--_Data_Assign_lhs = (Core.Name "lhs")--_Data_Assign_rhs = (Core.Name "rhs")--data Data_Return = -  Data_Return {-    data_ReturnExpr :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Return = (Core.Name "hydra/ext/scala/meta.Data.Return")--_Data_Return_expr = (Core.Name "expr")--data Data_Throw = -  Data_Throw {-    data_ThrowExpr :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Throw = (Core.Name "hydra/ext/scala/meta.Data.Throw")--_Data_Throw_expr = (Core.Name "expr")--data Data_Ascribe = -  Data_Ascribe {-    data_AscribeExpr :: Data,-    data_AscribeTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Data_Ascribe = (Core.Name "hydra/ext/scala/meta.Data.Ascribe")--_Data_Ascribe_expr = (Core.Name "expr")--_Data_Ascribe_tpe = (Core.Name "tpe")--data Data_Annotate = -  Data_Annotate {-    data_AnnotateExpr :: Data,-    data_AnnotateAnnots :: [Mod_Annot]}-  deriving (Eq, Ord, Read, Show)--_Data_Annotate = (Core.Name "hydra/ext/scala/meta.Data.Annotate")--_Data_Annotate_expr = (Core.Name "expr")--_Data_Annotate_annots = (Core.Name "annots")--data Data_Tuple = -  Data_Tuple {-    data_TupleArgs :: [Data]}-  deriving (Eq, Ord, Read, Show)--_Data_Tuple = (Core.Name "hydra/ext/scala/meta.Data.Tuple")--_Data_Tuple_args = (Core.Name "args")--data Data_Block = -  Data_Block {-    data_BlockStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Data_Block = (Core.Name "hydra/ext/scala/meta.Data.Block")--_Data_Block_stats = (Core.Name "stats")--data Data_EndMarker = -  Data_EndMarker {-    data_EndMarkerName :: Data_Name}-  deriving (Eq, Ord, Read, Show)--_Data_EndMarker = (Core.Name "hydra/ext/scala/meta.Data.EndMarker")--_Data_EndMarker_name = (Core.Name "name")--data Data_If = -  Data_If {-    data_IfCond :: Data,-    data_IfThenp :: Data,-    data_IfElsep :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_If = (Core.Name "hydra/ext/scala/meta.Data.If")--_Data_If_cond = (Core.Name "cond")--_Data_If_thenp = (Core.Name "thenp")--_Data_If_elsep = (Core.Name "elsep")--data Data_QuotedMacroExpr = -  Data_QuotedMacroExpr {-    data_QuotedMacroExprBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_QuotedMacroExpr = (Core.Name "hydra/ext/scala/meta.Data.QuotedMacroExpr")--_Data_QuotedMacroExpr_body = (Core.Name "body")--data Data_QuotedMacroType = -  Data_QuotedMacroType {-    data_QuotedMacroTypeTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Data_QuotedMacroType = (Core.Name "hydra/ext/scala/meta.Data.QuotedMacroType")--_Data_QuotedMacroType_tpe = (Core.Name "tpe")--data Data_SplicedMacroExpr = -  Data_SplicedMacroExpr {-    data_SplicedMacroExprBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_SplicedMacroExpr = (Core.Name "hydra/ext/scala/meta.Data.SplicedMacroExpr")--_Data_SplicedMacroExpr_body = (Core.Name "body")--data Data_Match = -  Data_Match {-    data_MatchExpr :: Data,-    data_MatchCases :: [Case]}-  deriving (Eq, Ord, Read, Show)--_Data_Match = (Core.Name "hydra/ext/scala/meta.Data.Match")--_Data_Match_expr = (Core.Name "expr")--_Data_Match_cases = (Core.Name "cases")--data Data_Try = -  Data_Try {-    data_TryExpr :: Data,-    data_TryCatchp :: [Case],-    data_TryFinallyp :: (Maybe Data)}-  deriving (Eq, Ord, Read, Show)--_Data_Try = (Core.Name "hydra/ext/scala/meta.Data.Try")--_Data_Try_expr = (Core.Name "expr")--_Data_Try_catchp = (Core.Name "catchp")--_Data_Try_finallyp = (Core.Name "finallyp")--data Data_TryWithHandler = -  Data_TryWithHandler {-    data_TryWithHandlerExpr :: Data,-    data_TryWithHandlerCatchp :: Data,-    data_TryWithHandlerFinallyp :: (Maybe Data)}-  deriving (Eq, Ord, Read, Show)--_Data_TryWithHandler = (Core.Name "hydra/ext/scala/meta.Data.TryWithHandler")--_Data_TryWithHandler_expr = (Core.Name "expr")--_Data_TryWithHandler_catchp = (Core.Name "catchp")--_Data_TryWithHandler_finallyp = (Core.Name "finallyp")--data Data_FunctionData = -  Data_FunctionDataContextFunction Data_ContextFunction |-  Data_FunctionDataFunction Data_Function-  deriving (Eq, Ord, Read, Show)--_Data_FunctionData = (Core.Name "hydra/ext/scala/meta.Data.FunctionData")--_Data_FunctionData_contextFunction = (Core.Name "contextFunction")--_Data_FunctionData_function = (Core.Name "function")--data Data_ContextFunction = -  Data_ContextFunction {-    data_ContextFunctionParams :: [Data_Param],-    data_ContextFunctionBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_ContextFunction = (Core.Name "hydra/ext/scala/meta.Data.ContextFunction")--_Data_ContextFunction_params = (Core.Name "params")--_Data_ContextFunction_body = (Core.Name "body")--data Data_Function = -  Data_Function {-    data_FunctionParams :: [Data_Param],-    data_FunctionBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Function = (Core.Name "hydra/ext/scala/meta.Data.Function")--_Data_Function_params = (Core.Name "params")--_Data_Function_body = (Core.Name "body")--data Data_PolyFunction = -  Data_PolyFunction {-    data_PolyFunctionTparams :: [Type_Param],-    data_PolyFunctionBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_PolyFunction = (Core.Name "hydra/ext/scala/meta.Data.PolyFunction")--_Data_PolyFunction_tparams = (Core.Name "tparams")--_Data_PolyFunction_body = (Core.Name "body")--data Data_PartialFunction = -  Data_PartialFunction {-    data_PartialFunctionCases :: [Case]}-  deriving (Eq, Ord, Read, Show)--_Data_PartialFunction = (Core.Name "hydra/ext/scala/meta.Data.PartialFunction")--_Data_PartialFunction_cases = (Core.Name "cases")--data Data_While = -  Data_While {-    data_WhileExpr :: Data,-    data_WhileBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_While = (Core.Name "hydra/ext/scala/meta.Data.While")--_Data_While_expr = (Core.Name "expr")--_Data_While_body = (Core.Name "body")--data Data_Do = -  Data_Do {-    data_DoBody :: Data,-    data_DoExpr :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Do = (Core.Name "hydra/ext/scala/meta.Data.Do")--_Data_Do_body = (Core.Name "body")--_Data_Do_expr = (Core.Name "expr")--data Data_For = -  Data_For {-    data_ForEnums :: [Enumerator]}-  deriving (Eq, Ord, Read, Show)--_Data_For = (Core.Name "hydra/ext/scala/meta.Data.For")--_Data_For_enums = (Core.Name "enums")--data Data_ForYield = -  Data_ForYield {-    data_ForYieldEnums :: [Enumerator]}-  deriving (Eq, Ord, Read, Show)--_Data_ForYield = (Core.Name "hydra/ext/scala/meta.Data.ForYield")--_Data_ForYield_enums = (Core.Name "enums")--data Data_New = -  Data_New {-    data_NewInit :: Init}-  deriving (Eq, Ord, Read, Show)--_Data_New = (Core.Name "hydra/ext/scala/meta.Data.New")--_Data_New_init = (Core.Name "init")--data Data_NewAnonymous = -  Data_NewAnonymous {-    data_NewAnonymousTempl :: Template}-  deriving (Eq, Ord, Read, Show)--_Data_NewAnonymous = (Core.Name "hydra/ext/scala/meta.Data.NewAnonymous")--_Data_NewAnonymous_templ = (Core.Name "templ")--data Data_Placeholder = -  Data_Placeholder {}-  deriving (Eq, Ord, Read, Show)--_Data_Placeholder = (Core.Name "hydra/ext/scala/meta.Data.Placeholder")--data Data_Eta = -  Data_Eta {-    data_EtaExpr :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Eta = (Core.Name "hydra/ext/scala/meta.Data.Eta")--_Data_Eta_expr = (Core.Name "expr")--data Data_Repeated = -  Data_Repeated {-    data_RepeatedExpr :: Data}-  deriving (Eq, Ord, Read, Show)--_Data_Repeated = (Core.Name "hydra/ext/scala/meta.Data.Repeated")--_Data_Repeated_expr = (Core.Name "expr")--data Data_Param = -  Data_Param {-    data_ParamMods :: [Mod],-    data_ParamName :: Name,-    data_ParamDecltpe :: (Maybe Type),-    data_ParamDefault :: (Maybe Data)}-  deriving (Eq, Ord, Read, Show)--_Data_Param = (Core.Name "hydra/ext/scala/meta.Data.Param")--_Data_Param_mods = (Core.Name "mods")--_Data_Param_name = (Core.Name "name")--_Data_Param_decltpe = (Core.Name "decltpe")--_Data_Param_default = (Core.Name "default")--data Type = -  TypeRef Type_Ref |-  TypeAnonymousName Type_AnonymousName |-  TypeApply Type_Apply |-  TypeApplyInfix Type_ApplyInfix |-  TypeFunctionType Type_FunctionType |-  TypePolyFunction Type_PolyFunction |-  TypeImplicitFunction Type_ImplicitFunction |-  TypeTuple Type_Tuple |-  TypeWith Type_With |-  TypeAnd Type_And |-  TypeOr Type_Or |-  TypeRefine Type_Refine |-  TypeExistential Type_Existential |-  TypeAnnotate Type_Annotate |-  TypeLambda Type_Lambda |-  TypeMacro Type_Macro |-  TypeMethod Type_Method |-  TypePlaceholder Type_Placeholder |-  TypeByName Type_ByName |-  TypeRepeated Type_Repeated |-  TypeVar Type_Var |-  TypeTypedParam Type_TypedParam |-  TypeMatch Type_Match-  deriving (Eq, Ord, Read, Show)--_Type = (Core.Name "hydra/ext/scala/meta.Type")--_Type_ref = (Core.Name "ref")--_Type_anonymousName = (Core.Name "anonymousName")--_Type_apply = (Core.Name "apply")--_Type_applyInfix = (Core.Name "applyInfix")--_Type_functionType = (Core.Name "functionType")--_Type_polyFunction = (Core.Name "polyFunction")--_Type_implicitFunction = (Core.Name "implicitFunction")--_Type_tuple = (Core.Name "tuple")--_Type_with = (Core.Name "with")--_Type_and = (Core.Name "and")--_Type_or = (Core.Name "or")--_Type_refine = (Core.Name "refine")--_Type_existential = (Core.Name "existential")--_Type_annotate = (Core.Name "annotate")--_Type_lambda = (Core.Name "lambda")--_Type_macro = (Core.Name "macro")--_Type_method = (Core.Name "method")--_Type_placeholder = (Core.Name "placeholder")--_Type_byName = (Core.Name "byName")--_Type_repeated = (Core.Name "repeated")--_Type_var = (Core.Name "var")--_Type_typedParam = (Core.Name "typedParam")--_Type_match = (Core.Name "match")--data Type_Ref = -  Type_RefName Type_Name |-  Type_RefSelect Type_Select |-  Type_RefProject Type_Project |-  Type_RefSingleton Type_Singleton-  deriving (Eq, Ord, Read, Show)--_Type_Ref = (Core.Name "hydra/ext/scala/meta.Type.Ref")--_Type_Ref_name = (Core.Name "name")--_Type_Ref_select = (Core.Name "select")--_Type_Ref_project = (Core.Name "project")--_Type_Ref_singleton = (Core.Name "singleton")--data Type_Name = -  Type_Name {-    type_NameValue :: String}-  deriving (Eq, Ord, Read, Show)--_Type_Name = (Core.Name "hydra/ext/scala/meta.Type.Name")--_Type_Name_value = (Core.Name "value")--data Type_AnonymousName = -  Type_AnonymousName {}-  deriving (Eq, Ord, Read, Show)--_Type_AnonymousName = (Core.Name "hydra/ext/scala/meta.Type.AnonymousName")--data Type_Select = -  Type_Select {-    type_SelectQual :: Data_Ref,-    type_SelectName :: Type_Name}-  deriving (Eq, Ord, Read, Show)--_Type_Select = (Core.Name "hydra/ext/scala/meta.Type.Select")--_Type_Select_qual = (Core.Name "qual")--_Type_Select_name = (Core.Name "name")--data Type_Project = -  Type_Project {-    type_ProjectQual :: Type,-    type_ProjectName :: Type_Name}-  deriving (Eq, Ord, Read, Show)--_Type_Project = (Core.Name "hydra/ext/scala/meta.Type.Project")--_Type_Project_qual = (Core.Name "qual")--_Type_Project_name = (Core.Name "name")--data Type_Singleton = -  Type_Singleton {-    type_SingletonRef :: Data_Ref}-  deriving (Eq, Ord, Read, Show)--_Type_Singleton = (Core.Name "hydra/ext/scala/meta.Type.Singleton")--_Type_Singleton_ref = (Core.Name "ref")--data Type_Apply = -  Type_Apply {-    type_ApplyTpe :: Type,-    type_ApplyArgs :: [Type]}-  deriving (Eq, Ord, Read, Show)--_Type_Apply = (Core.Name "hydra/ext/scala/meta.Type.Apply")--_Type_Apply_tpe = (Core.Name "tpe")--_Type_Apply_args = (Core.Name "args")--data Type_ApplyInfix = -  Type_ApplyInfix {-    type_ApplyInfixLhs :: Type,-    type_ApplyInfixOp :: Type_Name,-    type_ApplyInfixRhs :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_ApplyInfix = (Core.Name "hydra/ext/scala/meta.Type.ApplyInfix")--_Type_ApplyInfix_lhs = (Core.Name "lhs")--_Type_ApplyInfix_op = (Core.Name "op")--_Type_ApplyInfix_rhs = (Core.Name "rhs")--data Type_FunctionType = -  Type_FunctionTypeFunction Type_Function |-  Type_FunctionTypeContextFunction Type_ContextFunction-  deriving (Eq, Ord, Read, Show)--_Type_FunctionType = (Core.Name "hydra/ext/scala/meta.Type.FunctionType")--_Type_FunctionType_function = (Core.Name "function")--_Type_FunctionType_contextFunction = (Core.Name "contextFunction")--data Type_Function = -  Type_Function {-    type_FunctionParams :: [Type],-    type_FunctionRes :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_Function = (Core.Name "hydra/ext/scala/meta.Type.Function")--_Type_Function_params = (Core.Name "params")--_Type_Function_res = (Core.Name "res")--data Type_PolyFunction = -  Type_PolyFunction {-    type_PolyFunctionTparams :: [Type_Param],-    type_PolyFunctionTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_PolyFunction = (Core.Name "hydra/ext/scala/meta.Type.PolyFunction")--_Type_PolyFunction_tparams = (Core.Name "tparams")--_Type_PolyFunction_tpe = (Core.Name "tpe")--data Type_ContextFunction = -  Type_ContextFunction {-    type_ContextFunctionParams :: [Type],-    type_ContextFunctionRes :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_ContextFunction = (Core.Name "hydra/ext/scala/meta.Type.ContextFunction")--_Type_ContextFunction_params = (Core.Name "params")--_Type_ContextFunction_res = (Core.Name "res")--data Type_ImplicitFunction = -  Type_ImplicitFunction {-    type_ImplicitFunctionParams :: [Type],-    type_ImplicitFunctionRes :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_ImplicitFunction = (Core.Name "hydra/ext/scala/meta.Type.ImplicitFunction")--_Type_ImplicitFunction_params = (Core.Name "params")--_Type_ImplicitFunction_res = (Core.Name "res")--data Type_Tuple = -  Type_Tuple {-    type_TupleArgs :: [Type]}-  deriving (Eq, Ord, Read, Show)--_Type_Tuple = (Core.Name "hydra/ext/scala/meta.Type.Tuple")--_Type_Tuple_args = (Core.Name "args")--data Type_With = -  Type_With {-    type_WithLhs :: Type,-    type_WithRhs :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_With = (Core.Name "hydra/ext/scala/meta.Type.With")--_Type_With_lhs = (Core.Name "lhs")--_Type_With_rhs = (Core.Name "rhs")--data Type_And = -  Type_And {-    type_AndLhs :: Type,-    type_AndRhs :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_And = (Core.Name "hydra/ext/scala/meta.Type.And")--_Type_And_lhs = (Core.Name "lhs")--_Type_And_rhs = (Core.Name "rhs")--data Type_Or = -  Type_Or {-    type_OrLhs :: Type,-    type_OrRhs :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_Or = (Core.Name "hydra/ext/scala/meta.Type.Or")--_Type_Or_lhs = (Core.Name "lhs")--_Type_Or_rhs = (Core.Name "rhs")--data Type_Refine = -  Type_Refine {-    type_RefineTpe :: (Maybe Type),-    type_RefineStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Type_Refine = (Core.Name "hydra/ext/scala/meta.Type.Refine")--_Type_Refine_tpe = (Core.Name "tpe")--_Type_Refine_stats = (Core.Name "stats")--data Type_Existential = -  Type_Existential {-    type_ExistentialTpe :: Type,-    type_ExistentialStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Type_Existential = (Core.Name "hydra/ext/scala/meta.Type.Existential")--_Type_Existential_tpe = (Core.Name "tpe")--_Type_Existential_stats = (Core.Name "stats")--data Type_Annotate = -  Type_Annotate {-    type_AnnotateTpe :: Type,-    type_AnnotateAnnots :: [Mod_Annot]}-  deriving (Eq, Ord, Read, Show)--_Type_Annotate = (Core.Name "hydra/ext/scala/meta.Type.Annotate")--_Type_Annotate_tpe = (Core.Name "tpe")--_Type_Annotate_annots = (Core.Name "annots")--data Type_Lambda = -  Type_Lambda {-    type_LambdaTparams :: [Type_Param],-    type_LambdaTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_Lambda = (Core.Name "hydra/ext/scala/meta.Type.Lambda")--_Type_Lambda_tparams = (Core.Name "tparams")--_Type_Lambda_tpe = (Core.Name "tpe")--data Type_Macro = -  Type_Macro {-    type_MacroBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Type_Macro = (Core.Name "hydra/ext/scala/meta.Type.Macro")--_Type_Macro_body = (Core.Name "body")--data Type_Method = -  Type_Method {-    type_MethodParamss :: [[Data_Param]],-    type_MethodTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_Method = (Core.Name "hydra/ext/scala/meta.Type.Method")--_Type_Method_paramss = (Core.Name "paramss")--_Type_Method_tpe = (Core.Name "tpe")--data Type_Placeholder = -  Type_Placeholder {-    type_PlaceholderBounds :: Type_Bounds}-  deriving (Eq, Ord, Read, Show)--_Type_Placeholder = (Core.Name "hydra/ext/scala/meta.Type.Placeholder")--_Type_Placeholder_bounds = (Core.Name "bounds")--data Type_Bounds = -  Type_Bounds {-    type_BoundsLo :: (Maybe Type),-    type_BoundsHi :: (Maybe Type)}-  deriving (Eq, Ord, Read, Show)--_Type_Bounds = (Core.Name "hydra/ext/scala/meta.Type.Bounds")--_Type_Bounds_lo = (Core.Name "lo")--_Type_Bounds_hi = (Core.Name "hi")--data Type_ByName = -  Type_ByName {-    type_ByNameTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_ByName = (Core.Name "hydra/ext/scala/meta.Type.ByName")--_Type_ByName_tpe = (Core.Name "tpe")--data Type_Repeated = -  Type_Repeated {-    type_RepeatedTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_Repeated = (Core.Name "hydra/ext/scala/meta.Type.Repeated")--_Type_Repeated_tpe = (Core.Name "tpe")--data Type_Var = -  Type_Var {-    type_VarName :: Type_Name}-  deriving (Eq, Ord, Read, Show)--_Type_Var = (Core.Name "hydra/ext/scala/meta.Type.Var")--_Type_Var_name = (Core.Name "name")--data Type_TypedParam = -  Type_TypedParam {-    type_TypedParamName :: Name,-    type_TypedParamTyp :: Type}-  deriving (Eq, Ord, Read, Show)--_Type_TypedParam = (Core.Name "hydra/ext/scala/meta.Type.TypedParam")--_Type_TypedParam_name = (Core.Name "name")--_Type_TypedParam_typ = (Core.Name "typ")--data Type_Param = -  Type_Param {-    type_ParamMods :: [Mod],-    type_ParamName :: Name,-    type_ParamTparams :: [Type_Param],-    type_ParamTbounds :: [Type_Bounds],-    type_ParamVbounds :: [Type],-    type_ParamCbounds :: [Type]}-  deriving (Eq, Ord, Read, Show)--_Type_Param = (Core.Name "hydra/ext/scala/meta.Type.Param")--_Type_Param_mods = (Core.Name "mods")--_Type_Param_name = (Core.Name "name")--_Type_Param_tparams = (Core.Name "tparams")--_Type_Param_tbounds = (Core.Name "tbounds")--_Type_Param_vbounds = (Core.Name "vbounds")--_Type_Param_cbounds = (Core.Name "cbounds")--data Type_Match = -  Type_Match {-    type_MatchTpe :: Type,-    type_MatchCases :: [TypeCase]}-  deriving (Eq, Ord, Read, Show)--_Type_Match = (Core.Name "hydra/ext/scala/meta.Type.Match")--_Type_Match_tpe = (Core.Name "tpe")--_Type_Match_cases = (Core.Name "cases")--data Pat = -  PatVar Pat_Var |-  PatWildcard  |-  PatSeqWildcard  |-  PatBind Pat_Bind |-  PatAlternative Pat_Alternative |-  PatTuple Pat_Tuple |-  PatRepeated Pat_Repeated |-  PatExtract Pat_Extract |-  PatExtractInfix Pat_ExtractInfix |-  PatInterpolate Pat_Interpolate |-  PatXml Pat_Xml |-  PatTyped Pat_Typed |-  PatMacro Pat_Macro |-  PatGiven Pat_Given-  deriving (Eq, Ord, Read, Show)--_Pat = (Core.Name "hydra/ext/scala/meta.Pat")--_Pat_var = (Core.Name "var")--_Pat_wildcard = (Core.Name "wildcard")--_Pat_seqWildcard = (Core.Name "seqWildcard")--_Pat_bind = (Core.Name "bind")--_Pat_alternative = (Core.Name "alternative")--_Pat_tuple = (Core.Name "tuple")--_Pat_repeated = (Core.Name "repeated")--_Pat_extract = (Core.Name "extract")--_Pat_extractInfix = (Core.Name "extractInfix")--_Pat_interpolate = (Core.Name "interpolate")--_Pat_xml = (Core.Name "xml")--_Pat_typed = (Core.Name "typed")--_Pat_macro = (Core.Name "macro")--_Pat_given = (Core.Name "given")--data Pat_Var = -  Pat_Var {-    pat_VarName :: Data_Name}-  deriving (Eq, Ord, Read, Show)--_Pat_Var = (Core.Name "hydra/ext/scala/meta.Pat.Var")--_Pat_Var_name = (Core.Name "name")--data Pat_Bind = -  Pat_Bind {-    pat_BindLhs :: Pat,-    pat_BindRhs :: Pat}-  deriving (Eq, Ord, Read, Show)--_Pat_Bind = (Core.Name "hydra/ext/scala/meta.Pat.Bind")--_Pat_Bind_lhs = (Core.Name "lhs")--_Pat_Bind_rhs = (Core.Name "rhs")--data Pat_Alternative = -  Pat_Alternative {-    pat_AlternativeLhs :: Pat,-    pat_AlternativeRhs :: Pat}-  deriving (Eq, Ord, Read, Show)--_Pat_Alternative = (Core.Name "hydra/ext/scala/meta.Pat.Alternative")--_Pat_Alternative_lhs = (Core.Name "lhs")--_Pat_Alternative_rhs = (Core.Name "rhs")--data Pat_Tuple = -  Pat_Tuple {-    pat_TupleArgs :: [Pat]}-  deriving (Eq, Ord, Read, Show)--_Pat_Tuple = (Core.Name "hydra/ext/scala/meta.Pat.Tuple")--_Pat_Tuple_args = (Core.Name "args")--data Pat_Repeated = -  Pat_Repeated {-    pat_RepeatedName :: Data_Name}-  deriving (Eq, Ord, Read, Show)--_Pat_Repeated = (Core.Name "hydra/ext/scala/meta.Pat.Repeated")--_Pat_Repeated_name = (Core.Name "name")--data Pat_Extract = -  Pat_Extract {-    pat_ExtractFun :: Data,-    pat_ExtractArgs :: [Pat]}-  deriving (Eq, Ord, Read, Show)--_Pat_Extract = (Core.Name "hydra/ext/scala/meta.Pat.Extract")--_Pat_Extract_fun = (Core.Name "fun")--_Pat_Extract_args = (Core.Name "args")--data Pat_ExtractInfix = -  Pat_ExtractInfix {-    pat_ExtractInfixLhs :: Pat,-    pat_ExtractInfixOp :: Data_Name,-    pat_ExtractInfixRhs :: [Pat]}-  deriving (Eq, Ord, Read, Show)--_Pat_ExtractInfix = (Core.Name "hydra/ext/scala/meta.Pat.ExtractInfix")--_Pat_ExtractInfix_lhs = (Core.Name "lhs")--_Pat_ExtractInfix_op = (Core.Name "op")--_Pat_ExtractInfix_rhs = (Core.Name "rhs")--data Pat_Interpolate = -  Pat_Interpolate {-    pat_InterpolatePrefix :: Data_Name,-    pat_InterpolateParts :: [Lit]}-  deriving (Eq, Ord, Read, Show)--_Pat_Interpolate = (Core.Name "hydra/ext/scala/meta.Pat.Interpolate")--_Pat_Interpolate_prefix = (Core.Name "prefix")--_Pat_Interpolate_parts = (Core.Name "parts")--data Pat_Xml = -  Pat_Xml {-    pat_XmlParts :: [Lit],-    pat_XmlArgs :: [Pat]}-  deriving (Eq, Ord, Read, Show)--_Pat_Xml = (Core.Name "hydra/ext/scala/meta.Pat.Xml")--_Pat_Xml_parts = (Core.Name "parts")--_Pat_Xml_args = (Core.Name "args")--data Pat_Typed = -  Pat_Typed {-    pat_TypedLhs :: Pat,-    pat_TypedRhs :: Type}-  deriving (Eq, Ord, Read, Show)--_Pat_Typed = (Core.Name "hydra/ext/scala/meta.Pat.Typed")--_Pat_Typed_lhs = (Core.Name "lhs")--_Pat_Typed_rhs = (Core.Name "rhs")--data Pat_Macro = -  Pat_Macro {-    pat_MacroBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Pat_Macro = (Core.Name "hydra/ext/scala/meta.Pat.Macro")--_Pat_Macro_body = (Core.Name "body")--data Pat_Given = -  Pat_Given {-    pat_GivenTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Pat_Given = (Core.Name "hydra/ext/scala/meta.Pat.Given")--_Pat_Given_tpe = (Core.Name "tpe")--data Member = -  MemberTerm Member_Data |-  MemberType Member_Type |-  MemberTermParam Data_Param |-  MemberTypeParam Type_Param |-  MemberSelf Self-  deriving (Eq, Ord, Read, Show)--_Member = (Core.Name "hydra/ext/scala/meta.Member")--_Member_term = (Core.Name "term")--_Member_type = (Core.Name "type")--_Member_termParam = (Core.Name "termParam")--_Member_typeParam = (Core.Name "typeParam")--_Member_self = (Core.Name "self")--data Member_Data = -  Member_DataPkg Pkg |-  Member_DataObject Pkg_Object-  deriving (Eq, Ord, Read, Show)--_Member_Data = (Core.Name "hydra/ext/scala/meta.Member.Data")--_Member_Data_pkg = (Core.Name "pkg")--_Member_Data_object = (Core.Name "object")--data Member_Type = -  Member_Type {-    member_TypeName :: Type_Name}-  deriving (Eq, Ord, Read, Show)--_Member_Type = (Core.Name "hydra/ext/scala/meta.Member.Type")--_Member_Type_name = (Core.Name "name")--data Decl = -  DeclVal Decl_Val |-  DeclVar Decl_Var |-  DeclDef Decl_Def |-  DeclType Decl_Type |-  DeclGiven Decl_Given-  deriving (Eq, Ord, Read, Show)--_Decl = (Core.Name "hydra/ext/scala/meta.Decl")--_Decl_val = (Core.Name "val")--_Decl_var = (Core.Name "var")--_Decl_def = (Core.Name "def")--_Decl_type = (Core.Name "type")--_Decl_given = (Core.Name "given")--data Decl_Val = -  Decl_Val {-    decl_ValMods :: [Mod],-    decl_ValPats :: [Pat],-    decl_ValDecltpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Decl_Val = (Core.Name "hydra/ext/scala/meta.Decl.Val")--_Decl_Val_mods = (Core.Name "mods")--_Decl_Val_pats = (Core.Name "pats")--_Decl_Val_decltpe = (Core.Name "decltpe")--data Decl_Var = -  Decl_Var {-    decl_VarMods :: [Mod],-    decl_VarPats :: [Pat],-    decl_VarDecltpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Decl_Var = (Core.Name "hydra/ext/scala/meta.Decl.Var")--_Decl_Var_mods = (Core.Name "mods")--_Decl_Var_pats = (Core.Name "pats")--_Decl_Var_decltpe = (Core.Name "decltpe")--data Decl_Def = -  Decl_Def {-    decl_DefMods :: [Mod],-    decl_DefName :: Data_Name,-    decl_DefTparams :: [Type_Param],-    decl_DefParamss :: [[Data_Param]],-    decl_DefDecltpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Decl_Def = (Core.Name "hydra/ext/scala/meta.Decl.Def")--_Decl_Def_mods = (Core.Name "mods")--_Decl_Def_name = (Core.Name "name")--_Decl_Def_tparams = (Core.Name "tparams")--_Decl_Def_paramss = (Core.Name "paramss")--_Decl_Def_decltpe = (Core.Name "decltpe")--data Decl_Type = -  Decl_Type {-    decl_TypeMods :: [Mod],-    decl_TypeName :: Type_Name,-    decl_TypeTparams :: [Type_Param],-    decl_TypeBounds :: Type_Bounds}-  deriving (Eq, Ord, Read, Show)--_Decl_Type = (Core.Name "hydra/ext/scala/meta.Decl.Type")--_Decl_Type_mods = (Core.Name "mods")--_Decl_Type_name = (Core.Name "name")--_Decl_Type_tparams = (Core.Name "tparams")--_Decl_Type_bounds = (Core.Name "bounds")--data Decl_Given = -  Decl_Given {-    decl_GivenMods :: [Mod],-    decl_GivenName :: Data_Name,-    decl_GivenTparams :: [Type_Param],-    decl_GivenSparams :: [[Data_Param]],-    decl_GivenDecltpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Decl_Given = (Core.Name "hydra/ext/scala/meta.Decl.Given")--_Decl_Given_mods = (Core.Name "mods")--_Decl_Given_name = (Core.Name "name")--_Decl_Given_tparams = (Core.Name "tparams")--_Decl_Given_sparams = (Core.Name "sparams")--_Decl_Given_decltpe = (Core.Name "decltpe")--data Defn = -  DefnVal Defn_Val |-  DefnVar Defn_Var |-  DefnGiven Defn_Given |-  DefnEnum Defn_Enum |-  DefnEnumCase Defn_EnumCase |-  DefnRepeatedEnumCase Defn_RepeatedEnumCase |-  DefnGivenAlias Defn_GivenAlias |-  DefnExtensionGroup Defn_ExtensionGroup |-  DefnDef Defn_Def |-  DefnMacro Defn_Macro |-  DefnType Defn_Type |-  DefnClass Defn_Class |-  DefnTrait Defn_Trait |-  DefnObject Defn_Object-  deriving (Eq, Ord, Read, Show)--_Defn = (Core.Name "hydra/ext/scala/meta.Defn")--_Defn_val = (Core.Name "val")--_Defn_var = (Core.Name "var")--_Defn_given = (Core.Name "given")--_Defn_enum = (Core.Name "enum")--_Defn_enumCase = (Core.Name "enumCase")--_Defn_repeatedEnumCase = (Core.Name "repeatedEnumCase")--_Defn_givenAlias = (Core.Name "givenAlias")--_Defn_extensionGroup = (Core.Name "extensionGroup")--_Defn_def = (Core.Name "def")--_Defn_macro = (Core.Name "macro")--_Defn_type = (Core.Name "type")--_Defn_class = (Core.Name "class")--_Defn_trait = (Core.Name "trait")--_Defn_object = (Core.Name "object")--data Defn_Val = -  Defn_Val {-    defn_ValMods :: [Mod],-    defn_ValPats :: [Pat],-    defn_ValDecltpe :: (Maybe Type),-    defn_ValRhs :: Data}-  deriving (Eq, Ord, Read, Show)--_Defn_Val = (Core.Name "hydra/ext/scala/meta.Defn.Val")--_Defn_Val_mods = (Core.Name "mods")--_Defn_Val_pats = (Core.Name "pats")--_Defn_Val_decltpe = (Core.Name "decltpe")--_Defn_Val_rhs = (Core.Name "rhs")--data Defn_Var = -  Defn_Var {-    defn_VarMods :: [Mod],-    defn_VarPats :: [Pat],-    defn_VarDecltpe :: Type,-    defn_VarRhs :: (Maybe Data)}-  deriving (Eq, Ord, Read, Show)--_Defn_Var = (Core.Name "hydra/ext/scala/meta.Defn.Var")--_Defn_Var_mods = (Core.Name "mods")--_Defn_Var_pats = (Core.Name "pats")--_Defn_Var_decltpe = (Core.Name "decltpe")--_Defn_Var_rhs = (Core.Name "rhs")--data Defn_Given = -  Defn_Given {-    defn_GivenMods :: [Mod],-    defn_GivenName :: Name,-    defn_GivenTparams :: [[Type_Param]],-    defn_GivenSparams :: [[Data_Param]],-    defn_GivenTempl :: Template}-  deriving (Eq, Ord, Read, Show)--_Defn_Given = (Core.Name "hydra/ext/scala/meta.Defn.Given")--_Defn_Given_mods = (Core.Name "mods")--_Defn_Given_name = (Core.Name "name")--_Defn_Given_tparams = (Core.Name "tparams")--_Defn_Given_sparams = (Core.Name "sparams")--_Defn_Given_templ = (Core.Name "templ")--data Defn_Enum = -  Defn_Enum {-    defn_EnumMods :: [Mod],-    defn_EnumName :: Type_Name,-    defn_EnumTparams :: [Type_Param],-    defn_EnumCtor :: Ctor_Primary,-    defn_EnumTemplate :: Template}-  deriving (Eq, Ord, Read, Show)--_Defn_Enum = (Core.Name "hydra/ext/scala/meta.Defn.Enum")--_Defn_Enum_mods = (Core.Name "mods")--_Defn_Enum_name = (Core.Name "name")--_Defn_Enum_tparams = (Core.Name "tparams")--_Defn_Enum_ctor = (Core.Name "ctor")--_Defn_Enum_template = (Core.Name "template")--data Defn_EnumCase = -  Defn_EnumCase {-    defn_EnumCaseMods :: [Mod],-    defn_EnumCaseName :: Data_Name,-    defn_EnumCaseTparams :: [Type_Param],-    defn_EnumCaseCtor :: Ctor_Primary,-    defn_EnumCaseInits :: [Init]}-  deriving (Eq, Ord, Read, Show)--_Defn_EnumCase = (Core.Name "hydra/ext/scala/meta.Defn.EnumCase")--_Defn_EnumCase_mods = (Core.Name "mods")--_Defn_EnumCase_name = (Core.Name "name")--_Defn_EnumCase_tparams = (Core.Name "tparams")--_Defn_EnumCase_ctor = (Core.Name "ctor")--_Defn_EnumCase_inits = (Core.Name "inits")--data Defn_RepeatedEnumCase = -  Defn_RepeatedEnumCase {-    defn_RepeatedEnumCaseMods :: [Mod],-    defn_RepeatedEnumCaseCases :: [Data_Name]}-  deriving (Eq, Ord, Read, Show)--_Defn_RepeatedEnumCase = (Core.Name "hydra/ext/scala/meta.Defn.RepeatedEnumCase")--_Defn_RepeatedEnumCase_mods = (Core.Name "mods")--_Defn_RepeatedEnumCase_cases = (Core.Name "cases")--data Defn_GivenAlias = -  Defn_GivenAlias {-    defn_GivenAliasMods :: [Mod],-    defn_GivenAliasName :: Name,-    defn_GivenAliasTparams :: [[Type_Param]],-    defn_GivenAliasSparams :: [[Data_Param]],-    defn_GivenAliasDecltpe :: Type,-    defn_GivenAliasBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Defn_GivenAlias = (Core.Name "hydra/ext/scala/meta.Defn.GivenAlias")--_Defn_GivenAlias_mods = (Core.Name "mods")--_Defn_GivenAlias_name = (Core.Name "name")--_Defn_GivenAlias_tparams = (Core.Name "tparams")--_Defn_GivenAlias_sparams = (Core.Name "sparams")--_Defn_GivenAlias_decltpe = (Core.Name "decltpe")--_Defn_GivenAlias_body = (Core.Name "body")--data Defn_ExtensionGroup = -  Defn_ExtensionGroup {-    defn_ExtensionGroupTparams :: [Type_Param],-    defn_ExtensionGroupParmss :: [[Data_Param]],-    defn_ExtensionGroupBody :: Stat}-  deriving (Eq, Ord, Read, Show)--_Defn_ExtensionGroup = (Core.Name "hydra/ext/scala/meta.Defn.ExtensionGroup")--_Defn_ExtensionGroup_tparams = (Core.Name "tparams")--_Defn_ExtensionGroup_parmss = (Core.Name "parmss")--_Defn_ExtensionGroup_body = (Core.Name "body")--data Defn_Def = -  Defn_Def {-    defn_DefMods :: [Mod],-    defn_DefName :: Data_Name,-    defn_DefTparams :: [Type_Param],-    defn_DefParamss :: [[Data_Param]],-    defn_DefDecltpe :: (Maybe Type),-    defn_DefBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Defn_Def = (Core.Name "hydra/ext/scala/meta.Defn.Def")--_Defn_Def_mods = (Core.Name "mods")--_Defn_Def_name = (Core.Name "name")--_Defn_Def_tparams = (Core.Name "tparams")--_Defn_Def_paramss = (Core.Name "paramss")--_Defn_Def_decltpe = (Core.Name "decltpe")--_Defn_Def_body = (Core.Name "body")--data Defn_Macro = -  Defn_Macro {-    defn_MacroMods :: [Mod],-    defn_MacroName :: Data_Name,-    defn_MacroTparams :: [Type_Param],-    defn_MacroParamss :: [[Data_Param]],-    defn_MacroDecltpe :: (Maybe Type),-    defn_MacroBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Defn_Macro = (Core.Name "hydra/ext/scala/meta.Defn.Macro")--_Defn_Macro_mods = (Core.Name "mods")--_Defn_Macro_name = (Core.Name "name")--_Defn_Macro_tparams = (Core.Name "tparams")--_Defn_Macro_paramss = (Core.Name "paramss")--_Defn_Macro_decltpe = (Core.Name "decltpe")--_Defn_Macro_body = (Core.Name "body")--data Defn_Type = -  Defn_Type {-    defn_TypeMods :: [Mod],-    defn_TypeName :: Type_Name,-    defn_TypeTparams :: [Type_Param],-    defn_TypeBody :: Type}-  deriving (Eq, Ord, Read, Show)--_Defn_Type = (Core.Name "hydra/ext/scala/meta.Defn.Type")--_Defn_Type_mods = (Core.Name "mods")--_Defn_Type_name = (Core.Name "name")--_Defn_Type_tparams = (Core.Name "tparams")--_Defn_Type_body = (Core.Name "body")--data Defn_Class = -  Defn_Class {-    defn_ClassMods :: [Mod],-    defn_ClassName :: Type_Name,-    defn_ClassTparams :: [Type_Param],-    defn_ClassCtor :: Ctor_Primary,-    defn_ClassTemplate :: Template}-  deriving (Eq, Ord, Read, Show)--_Defn_Class = (Core.Name "hydra/ext/scala/meta.Defn.Class")--_Defn_Class_mods = (Core.Name "mods")--_Defn_Class_name = (Core.Name "name")--_Defn_Class_tparams = (Core.Name "tparams")--_Defn_Class_ctor = (Core.Name "ctor")--_Defn_Class_template = (Core.Name "template")--data Defn_Trait = -  Defn_Trait {-    defn_TraitMods :: [Mod],-    defn_TraitName :: Type_Name,-    defn_TraitTparams :: [Type_Param],-    defn_TraitCtor :: Ctor_Primary,-    defn_TraitTemplate :: Template}-  deriving (Eq, Ord, Read, Show)--_Defn_Trait = (Core.Name "hydra/ext/scala/meta.Defn.Trait")--_Defn_Trait_mods = (Core.Name "mods")--_Defn_Trait_name = (Core.Name "name")--_Defn_Trait_tparams = (Core.Name "tparams")--_Defn_Trait_ctor = (Core.Name "ctor")--_Defn_Trait_template = (Core.Name "template")--data Defn_Object = -  Defn_Object {-    defn_ObjectName :: Data_Name}-  deriving (Eq, Ord, Read, Show)--_Defn_Object = (Core.Name "hydra/ext/scala/meta.Defn.Object")--_Defn_Object_name = (Core.Name "name")--data Pkg = -  Pkg {-    pkgName :: Data_Name,-    pkgRef :: Data_Ref,-    pkgStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Pkg = (Core.Name "hydra/ext/scala/meta.Pkg")--_Pkg_name = (Core.Name "name")--_Pkg_ref = (Core.Name "ref")--_Pkg_stats = (Core.Name "stats")--data Pkg_Object = -  Pkg_Object {-    pkg_ObjectMods :: [Mod],-    pkg_ObjectName :: Data_Name,-    pkg_ObjectTemplate :: Template}-  deriving (Eq, Ord, Read, Show)--_Pkg_Object = (Core.Name "hydra/ext/scala/meta.Pkg.Object")--_Pkg_Object_mods = (Core.Name "mods")--_Pkg_Object_name = (Core.Name "name")--_Pkg_Object_template = (Core.Name "template")--data Ctor = -  CtorPrimary Ctor_Primary |-  CtorSecondary Ctor_Secondary-  deriving (Eq, Ord, Read, Show)--_Ctor = (Core.Name "hydra/ext/scala/meta.Ctor")--_Ctor_primary = (Core.Name "primary")--_Ctor_secondary = (Core.Name "secondary")--data Ctor_Primary = -  Ctor_Primary {-    ctor_PrimaryMods :: [Mod],-    ctor_PrimaryName :: Name,-    ctor_PrimaryParamss :: [[Data_Param]]}-  deriving (Eq, Ord, Read, Show)--_Ctor_Primary = (Core.Name "hydra/ext/scala/meta.Ctor.Primary")--_Ctor_Primary_mods = (Core.Name "mods")--_Ctor_Primary_name = (Core.Name "name")--_Ctor_Primary_paramss = (Core.Name "paramss")--data Ctor_Secondary = -  Ctor_Secondary {-    ctor_SecondaryMods :: [Mod],-    ctor_SecondaryName :: Name,-    ctor_SecondaryParamss :: [[Data_Param]],-    ctor_SecondaryInit :: Init,-    ctor_SecondaryStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Ctor_Secondary = (Core.Name "hydra/ext/scala/meta.Ctor.Secondary")--_Ctor_Secondary_mods = (Core.Name "mods")--_Ctor_Secondary_name = (Core.Name "name")--_Ctor_Secondary_paramss = (Core.Name "paramss")--_Ctor_Secondary_init = (Core.Name "init")--_Ctor_Secondary_stats = (Core.Name "stats")--data Init = -  Init {-    initTpe :: Type,-    initName :: Name,-    initArgss :: [[Data]]}-  deriving (Eq, Ord, Read, Show)--_Init = (Core.Name "hydra/ext/scala/meta.Init")--_Init_tpe = (Core.Name "tpe")--_Init_name = (Core.Name "name")--_Init_argss = (Core.Name "argss")--data Self = -  Self {}-  deriving (Eq, Ord, Read, Show)--_Self = (Core.Name "hydra/ext/scala/meta.Self")--data Template = -  Template {-    templateEarly :: [Stat],-    templateInits :: [Init],-    templateSelf :: Self,-    templateStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Template = (Core.Name "hydra/ext/scala/meta.Template")--_Template_early = (Core.Name "early")--_Template_inits = (Core.Name "inits")--_Template_self = (Core.Name "self")--_Template_stats = (Core.Name "stats")--data Mod = -  ModAnnot Mod_Annot |-  ModPrivate Mod_Private |-  ModProtected Mod_Protected |-  ModImplicit  |-  ModFinal  |-  ModSealed  |-  ModOpen  |-  ModSuper  |-  ModOverride  |-  ModCase  |-  ModAbstract  |-  ModCovariant  |-  ModContravariant  |-  ModLazy  |-  ModValParam  |-  ModVarParam  |-  ModInfix  |-  ModInline  |-  ModUsing  |-  ModOpaque  |-  ModTransparent -  deriving (Eq, Ord, Read, Show)--_Mod = (Core.Name "hydra/ext/scala/meta.Mod")--_Mod_annot = (Core.Name "annot")--_Mod_private = (Core.Name "private")--_Mod_protected = (Core.Name "protected")--_Mod_implicit = (Core.Name "implicit")--_Mod_final = (Core.Name "final")--_Mod_sealed = (Core.Name "sealed")--_Mod_open = (Core.Name "open")--_Mod_super = (Core.Name "super")--_Mod_override = (Core.Name "override")--_Mod_case = (Core.Name "case")--_Mod_abstract = (Core.Name "abstract")--_Mod_covariant = (Core.Name "covariant")--_Mod_contravariant = (Core.Name "contravariant")--_Mod_lazy = (Core.Name "lazy")--_Mod_valParam = (Core.Name "valParam")--_Mod_varParam = (Core.Name "varParam")--_Mod_infix = (Core.Name "infix")--_Mod_inline = (Core.Name "inline")--_Mod_using = (Core.Name "using")--_Mod_opaque = (Core.Name "opaque")--_Mod_transparent = (Core.Name "transparent")--data Mod_Annot = -  Mod_Annot {-    mod_AnnotInit :: Init}-  deriving (Eq, Ord, Read, Show)--_Mod_Annot = (Core.Name "hydra/ext/scala/meta.Mod.Annot")--_Mod_Annot_init = (Core.Name "init")--data Mod_Private = -  Mod_Private {-    mod_PrivateWithin :: Ref}-  deriving (Eq, Ord, Read, Show)--_Mod_Private = (Core.Name "hydra/ext/scala/meta.Mod.Private")--_Mod_Private_within = (Core.Name "within")--data Mod_Protected = -  Mod_Protected {-    mod_ProtectedWithin :: Ref}-  deriving (Eq, Ord, Read, Show)--_Mod_Protected = (Core.Name "hydra/ext/scala/meta.Mod.Protected")--_Mod_Protected_within = (Core.Name "within")--data Enumerator = -  EnumeratorGenerator Enumerator_Generator |-  EnumeratorCaseGenerator Enumerator_CaseGenerator |-  EnumeratorVal Enumerator_Val |-  EnumeratorGuard Enumerator_Guard-  deriving (Eq, Ord, Read, Show)--_Enumerator = (Core.Name "hydra/ext/scala/meta.Enumerator")--_Enumerator_generator = (Core.Name "generator")--_Enumerator_caseGenerator = (Core.Name "caseGenerator")--_Enumerator_val = (Core.Name "val")--_Enumerator_guard = (Core.Name "guard")--data Enumerator_Generator = -  Enumerator_Generator {-    enumerator_GeneratorPat :: Pat,-    enumerator_GeneratorRhs :: Data}-  deriving (Eq, Ord, Read, Show)--_Enumerator_Generator = (Core.Name "hydra/ext/scala/meta.Enumerator.Generator")--_Enumerator_Generator_pat = (Core.Name "pat")--_Enumerator_Generator_rhs = (Core.Name "rhs")--data Enumerator_CaseGenerator = -  Enumerator_CaseGenerator {-    enumerator_CaseGeneratorPat :: Pat,-    enumerator_CaseGeneratorRhs :: Data}-  deriving (Eq, Ord, Read, Show)--_Enumerator_CaseGenerator = (Core.Name "hydra/ext/scala/meta.Enumerator.CaseGenerator")--_Enumerator_CaseGenerator_pat = (Core.Name "pat")--_Enumerator_CaseGenerator_rhs = (Core.Name "rhs")--data Enumerator_Val = -  Enumerator_Val {-    enumerator_ValPat :: Pat,-    enumerator_ValRhs :: Data}-  deriving (Eq, Ord, Read, Show)--_Enumerator_Val = (Core.Name "hydra/ext/scala/meta.Enumerator.Val")--_Enumerator_Val_pat = (Core.Name "pat")--_Enumerator_Val_rhs = (Core.Name "rhs")--data Enumerator_Guard = -  Enumerator_Guard {-    enumerator_GuardCond :: Data}-  deriving (Eq, Ord, Read, Show)--_Enumerator_Guard = (Core.Name "hydra/ext/scala/meta.Enumerator.Guard")--_Enumerator_Guard_cond = (Core.Name "cond")--data ImportExportStat = -  ImportExportStatImport Import |-  ImportExportStatExport Export-  deriving (Eq, Ord, Read, Show)--_ImportExportStat = (Core.Name "hydra/ext/scala/meta.ImportExportStat")--_ImportExportStat_import = (Core.Name "import")--_ImportExportStat_export = (Core.Name "export")--data Import = -  Import {-    importImporters :: [Importer]}-  deriving (Eq, Ord, Read, Show)--_Import = (Core.Name "hydra/ext/scala/meta.Import")--_Import_importers = (Core.Name "importers")--data Export = -  Export {-    exportImporters :: [Importer]}-  deriving (Eq, Ord, Read, Show)--_Export = (Core.Name "hydra/ext/scala/meta.Export")--_Export_importers = (Core.Name "importers")--data Importer = -  Importer {-    importerRef :: Data_Ref,-    importerImportees :: [Importee]}-  deriving (Eq, Ord, Read, Show)--_Importer = (Core.Name "hydra/ext/scala/meta.Importer")--_Importer_ref = (Core.Name "ref")--_Importer_importees = (Core.Name "importees")--data Importee = -  ImporteeWildcard  |-  ImporteeGiven Importee_Given |-  ImporteeGivenAll  |-  ImporteeName Importee_Name |-  ImporteeRename Importee_Rename |-  ImporteeUnimport Importee_Unimport-  deriving (Eq, Ord, Read, Show)--_Importee = (Core.Name "hydra/ext/scala/meta.Importee")--_Importee_wildcard = (Core.Name "wildcard")--_Importee_given = (Core.Name "given")--_Importee_givenAll = (Core.Name "givenAll")--_Importee_name = (Core.Name "name")--_Importee_rename = (Core.Name "rename")--_Importee_unimport = (Core.Name "unimport")--data Importee_Given = -  Importee_Given {-    importee_GivenTpe :: Type}-  deriving (Eq, Ord, Read, Show)--_Importee_Given = (Core.Name "hydra/ext/scala/meta.Importee.Given")--_Importee_Given_tpe = (Core.Name "tpe")--data Importee_Name = -  Importee_Name {-    importee_NameName :: Name}-  deriving (Eq, Ord, Read, Show)--_Importee_Name = (Core.Name "hydra/ext/scala/meta.Importee.Name")--_Importee_Name_name = (Core.Name "name")--data Importee_Rename = -  Importee_Rename {-    importee_RenameName :: Name,-    importee_RenameRename :: Name}-  deriving (Eq, Ord, Read, Show)--_Importee_Rename = (Core.Name "hydra/ext/scala/meta.Importee.Rename")--_Importee_Rename_name = (Core.Name "name")--_Importee_Rename_rename = (Core.Name "rename")--data Importee_Unimport = -  Importee_Unimport {-    importee_UnimportName :: Name}-  deriving (Eq, Ord, Read, Show)--_Importee_Unimport = (Core.Name "hydra/ext/scala/meta.Importee.Unimport")--_Importee_Unimport_name = (Core.Name "name")--data CaseTree = -  CaseTreeCase Case |-  CaseTreeTypeCase TypeCase-  deriving (Eq, Ord, Read, Show)--_CaseTree = (Core.Name "hydra/ext/scala/meta.CaseTree")--_CaseTree_case = (Core.Name "case")--_CaseTree_typeCase = (Core.Name "typeCase")--data Case = -  Case {-    casePat :: Pat,-    caseCond :: (Maybe Data),-    caseBody :: Data}-  deriving (Eq, Ord, Read, Show)--_Case = (Core.Name "hydra/ext/scala/meta.Case")--_Case_pat = (Core.Name "pat")--_Case_cond = (Core.Name "cond")--_Case_body = (Core.Name "body")--data TypeCase = -  TypeCase {-    typeCasePat :: Type,-    typeCaseBody :: Type}-  deriving (Eq, Ord, Read, Show)--_TypeCase = (Core.Name "hydra/ext/scala/meta.TypeCase")--_TypeCase_pat = (Core.Name "pat")--_TypeCase_body = (Core.Name "body")--data Source = -  Source {-    sourceStats :: [Stat]}-  deriving (Eq, Ord, Read, Show)--_Source = (Core.Name "hydra/ext/scala/meta.Source")--_Source_stats = (Core.Name "stats")--data Quasi = -  Quasi {}-  deriving (Eq, Ord, Read, Show)--_Quasi = (Core.Name "hydra/ext/scala/meta.Quasi")
− src/gen-main/haskell/Hydra/Ext/Tabular.hs 
@@ -1,40 +0,0 @@--- | A simple, untyped tabular data model, suitable for CSVs and TSVs--module Hydra.Ext.Tabular where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | A data row, containing optional-valued cells; one per column-newtype DataRow v = -  DataRow {-    unDataRow :: [Maybe v]}-  deriving (Eq, Ord, Read, Show)--_DataRow = (Core.Name "hydra/ext/tabular.DataRow")---- | A header row, containing column names (but no types or data)-newtype HeaderRow = -  HeaderRow {-    unHeaderRow :: [String]}-  deriving (Eq, Ord, Read, Show)--_HeaderRow = (Core.Name "hydra/ext/tabular.HeaderRow")---- | A simple table as in a CSV file, having an optional header row and any number of data rows-data Table v = -  Table {-    -- | The optional header row of the table. If present, the header must have the same number of cells as each data row.-    tableHeader :: (Maybe HeaderRow),-    -- | The data rows of the table. Each row must have the same number of cells.-    tableData :: [DataRow v]}-  deriving (Eq, Ord, Read, Show)--_Table = (Core.Name "hydra/ext/tabular.Table")--_Table_header = (Core.Name "header")--_Table_data = (Core.Name "data")
+ src/gen-main/haskell/Hydra/Extract/Core.hs view
@@ -0,0 +1,419 @@+-- | A DSL for decoding and validating Hydra terms at runtime. This module provides functions to extract typed values from Hydra terms with appropriate error handling.++module Hydra.Extract.Core where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Strings as Strings+import qualified Hydra.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core_+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Extract an arbitrary-precision floating-point value from a term+bigfloat :: (Core.Term -> Compute.Flow Graph.Graph Double)+bigfloat t = (Flows.bind (literal t) (\l -> Flows.bind (floatLiteral l) (\f -> bigfloatValue f)))++bigfloatValue :: (Core.FloatValue -> Compute.Flow t0 Double)+bigfloatValue v = ((\x -> case x of+  Core.FloatValueBigfloat v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "bigfloat" (Core_.float v))) v)++-- | Extract an arbitrary-precision integer value from a term+bigint :: (Core.Term -> Compute.Flow Graph.Graph Integer)+bigint t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> bigintValue i)))++bigintValue :: (Core.IntegerValue -> Compute.Flow t0 Integer)+bigintValue v = ((\x -> case x of+  Core.IntegerValueBigint v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "bigint" (Core_.integer v))) v)++-- | Extract a binary data value from a term+binary :: (Core.Term -> Compute.Flow Graph.Graph String)+binary t = (Flows.bind (literal t) binaryLiteral)++binaryLiteral :: (Core.Literal -> Compute.Flow t0 String)+binaryLiteral v = ((\x -> case x of+  Core.LiteralBinary v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "binary" (Core_.literal v))) v)++-- | Extract a boolean value from a term+boolean :: (Core.Term -> Compute.Flow Graph.Graph Bool)+boolean t = (Flows.bind (literal t) booleanLiteral)++booleanLiteral :: (Core.Literal -> Compute.Flow t0 Bool)+booleanLiteral v = ((\x -> case x of+  Core.LiteralBoolean v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "boolean" (Core_.literal v))) v)++-- | Extract a specific case handler from a case statement term+caseField :: (Core.Name -> String -> Core.Term -> Compute.Flow Graph.Graph Core.Field)+caseField name n term =  +  let fieldName = (Core.Name n)+  in (Flows.bind (cases name term) (\cs ->  +    let matching = (Lists.filter (\f -> Equality.equal (Core.unName (Core.fieldName f)) (Core.unName fieldName)) (Core.caseStatementCases cs))+    in (Logic.ifElse (Lists.null matching) (Flows.fail "not enough cases") (Flows.pure (Lists.head matching)))))++-- | Extract case statement from a term+cases :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph Core.CaseStatement)+cases name term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionElimination v2 -> ((\x -> case x of+      Core.EliminationUnion v3 -> (Logic.ifElse (Equality.equal (Core.unName (Core.caseStatementTypeName v3)) (Core.unName name)) (Flows.pure v3) (Monads.unexpected (Strings.cat [+        "case statement for type ",+        (Core.unName name)]) (Core_.term term)))+      _ -> (Monads.unexpected "case statement" (Core_.term term))) v2)+    _ -> (Monads.unexpected "case statement" (Core_.term term))) v1)+  _ -> (Monads.unexpected "case statement" (Core_.term term))) term))++field :: (Core.Name -> (Core.Term -> Compute.Flow Graph.Graph t0) -> [Core.Field] -> Compute.Flow Graph.Graph t0)+field fname mapping fields =  +  let matchingFields = (Lists.filter (\f -> Equality.equal (Core.unName (Core.fieldName f)) (Core.unName fname)) fields)+  in (Logic.ifElse (Lists.null matchingFields) (Flows.fail (Strings.cat [+    Strings.cat [+      "field ",+      (Core.unName fname)],+    " not found"])) (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Flows.bind (Lexical.stripAndDereferenceTerm (Core.fieldTerm (Lists.head matchingFields))) mapping) (Flows.fail (Strings.cat [+    "multiple fields named ",+    (Core.unName fname)]))))++-- | Extract a 32-bit floating-point value from a term+float32 :: (Core.Term -> Compute.Flow Graph.Graph Float)+float32 t = (Flows.bind (literal t) (\l -> Flows.bind (floatLiteral l) (\f -> float32Value f)))++float32Value :: (Core.FloatValue -> Compute.Flow t0 Float)+float32Value v = ((\x -> case x of+  Core.FloatValueFloat32 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "float32" (Core_.float v))) v)++-- | Extract a 64-bit floating-point value from a term+float64 :: (Core.Term -> Compute.Flow Graph.Graph Double)+float64 t = (Flows.bind (literal t) (\l -> Flows.bind (floatLiteral l) (\f -> float64Value f)))++float64Value :: (Core.FloatValue -> Compute.Flow t0 Double)+float64Value v = ((\x -> case x of+  Core.FloatValueFloat64 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "float64" (Core_.float v))) v)++floatLiteral :: (Core.Literal -> Compute.Flow t0 Core.FloatValue)+floatLiteral lit = ((\x -> case x of+  Core.LiteralFloat v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "floating-point value" (Core_.literal lit))) lit)++-- | Extract a float value from a term+floatValue :: (Core.Term -> Compute.Flow Graph.Graph Core.FloatValue)+floatValue t = (Flows.bind (literal t) floatLiteral)++functionType :: (Core.Type -> Compute.Flow t0 Core.FunctionType)+functionType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeFunction v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "function type" (Core_.type_ typ))) stripped)++-- | Extract a field from a union term+injection :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph Core.Field)+injection expected term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermUnion v1 -> (Logic.ifElse (Equality.equal (Core.unName (Core.injectionTypeName v1)) (Core.unName expected)) (Flows.pure (Core.injectionField v1)) (Monads.unexpected (Strings.cat [+    "injection of type ",+    (Core.unName expected)]) (Core.unName (Core.injectionTypeName v1))))+  _ -> (Monads.unexpected "injection" (Core_.term term))) term))++-- | Extract a 16-bit signed integer value from a term+int16 :: (Core.Term -> Compute.Flow Graph.Graph I.Int16)+int16 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> int16Value i)))++int16Value :: (Core.IntegerValue -> Compute.Flow t0 I.Int16)+int16Value v = ((\x -> case x of+  Core.IntegerValueInt16 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "int16" (Core_.integer v))) v)++-- | Extract a 32-bit signed integer value from a term+int32 :: (Core.Term -> Compute.Flow Graph.Graph Int)+int32 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> int32Value i)))++int32Value :: (Core.IntegerValue -> Compute.Flow t0 Int)+int32Value v = ((\x -> case x of+  Core.IntegerValueInt32 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "int32" (Core_.integer v))) v)++-- | Extract a 64-bit signed integer value from a term+int64 :: (Core.Term -> Compute.Flow Graph.Graph I.Int64)+int64 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> int64Value i)))++int64Value :: (Core.IntegerValue -> Compute.Flow t0 I.Int64)+int64Value v = ((\x -> case x of+  Core.IntegerValueInt64 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "int64" (Core_.integer v))) v)++-- | Extract an 8-bit signed integer value from a term+int8 :: (Core.Term -> Compute.Flow Graph.Graph I.Int8)+int8 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> int8Value i)))++int8Value :: (Core.IntegerValue -> Compute.Flow t0 I.Int8)+int8Value v = ((\x -> case x of+  Core.IntegerValueInt8 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "int8" (Core_.integer v))) v)++integerLiteral :: (Core.Literal -> Compute.Flow t0 Core.IntegerValue)+integerLiteral lit = ((\x -> case x of+  Core.LiteralInteger v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "integer value" (Core_.literal lit))) lit)++-- | Extract an integer value from a term+integerValue :: (Core.Term -> Compute.Flow Graph.Graph Core.IntegerValue)+integerValue t = (Flows.bind (literal t) integerLiteral)++-- | Extract the body of a lambda term+lambdaBody :: (Core.Term -> Compute.Flow Graph.Graph Core.Term)+lambdaBody term = (Flows.map Core.lambdaBody (lambda term))++-- | Extract a lambda from a term+lambda :: (Core.Term -> Compute.Flow Graph.Graph Core.Lambda)+lambda term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionLambda v2 -> (Flows.pure v2)+    _ -> (Monads.unexpected "lambda" (Core_.term term))) v1)+  _ -> (Monads.unexpected "lambda" (Core_.term term))) term))++-- | Extract a binding with the given name from a let term+letBinding :: (String -> Core.Term -> Compute.Flow Graph.Graph Core.Term)+letBinding n term =  +  let name = (Core.Name n)+  in (Flows.bind (letTerm term) (\letExpr ->  +    let matchingBindings = (Lists.filter (\b -> Equality.equal (Core.unName (Core.bindingName b)) (Core.unName name)) (Core.letBindings letExpr))+    in (Logic.ifElse (Lists.null matchingBindings) (Flows.fail (Strings.cat [+      "no such binding: ",+      n])) (Logic.ifElse (Equality.equal (Lists.length matchingBindings) 1) (Flows.pure (Core.bindingTerm (Lists.head matchingBindings))) (Flows.fail (Strings.cat [+      "multiple bindings named ",+      n]))))))++-- | Extract a let expression from a term+letTerm :: (Core.Term -> Compute.Flow Graph.Graph Core.Let)+letTerm term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermLet v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "let term" (Core_.term term))) term))++-- | Extract a list of terms from a term+list :: (Core.Term -> Compute.Flow Graph.Graph [Core.Term])+list term = (Flows.bind (Lexical.stripAndDereferenceTerm term) (\stripped -> (\x -> case x of+  Core.TermList v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "list" (Core_.term stripped))) stripped))++-- | Extract the first element of a list term+listHead :: (Core.Term -> Compute.Flow Graph.Graph Core.Term)+listHead term = (Flows.bind (list term) (\l -> Logic.ifElse (Lists.null l) (Flows.fail "empty list") (Flows.pure (Lists.head l))))++listOf :: ((Core.Term -> Compute.Flow Graph.Graph t0) -> Core.Term -> Compute.Flow Graph.Graph [t0])+listOf f term = (Flows.bind (list term) (\els -> Flows.mapList f els))++listType :: (Core.Type -> Compute.Flow t0 Core.Type)+listType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeList v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "list type" (Core_.type_ typ))) stripped)++-- | Extract a literal value from a term+literal :: (Core.Term -> Compute.Flow Graph.Graph Core.Literal)+literal term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermLiteral v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "literal" (Core_.term term))) term))++map :: (Ord t0) => ((Core.Term -> Compute.Flow Graph.Graph t0) -> (Core.Term -> Compute.Flow Graph.Graph t1) -> Core.Term -> Compute.Flow Graph.Graph (M.Map t0 t1))+map fk fv term0 =  +  let pair = (\kvPair ->  +          let kterm = (fst kvPair) +              vterm = (snd kvPair)+          in (Flows.bind (fk kterm) (\kval -> Flows.bind (fv vterm) (\vval -> Flows.pure (kval, vval)))))+  in (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+    Core.TermMap v1 -> (Flows.map Maps.fromList (Flows.mapList pair (Maps.toList v1)))+    _ -> (Monads.unexpected "map" (Core_.term term))) term))++mapType :: (Core.Type -> Compute.Flow t0 Core.MapType)+mapType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeMap v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "map type" (Core_.type_ typ))) stripped)++nArgs :: (Core.Name -> Int -> [t0] -> Compute.Flow t1 ())+nArgs name n args = (Logic.ifElse (Equality.equal (Lists.length args) n) (Flows.pure ()) (Monads.unexpected (Strings.cat [+  Literals.showInt32 n,+  " arguments to primitive ",+  (Literals.showString (Core.unName name))]) (Literals.showInt32 (Lists.length args))))++optional :: ((Core.Term -> Compute.Flow Graph.Graph t0) -> Core.Term -> Compute.Flow Graph.Graph (Maybe t0))+optional f term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermOptional v1 -> (Optionals.maybe (Flows.pure Nothing) (\t -> Flows.map Optionals.pure (f t)) v1)+  _ -> (Monads.unexpected "optional value" (Core_.term term))) term))++optionalType :: (Core.Type -> Compute.Flow t0 Core.Type)+optionalType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeOptional v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "optional type" (Core_.type_ typ))) stripped)++pair :: ((Core.Term -> Compute.Flow Graph.Graph t0) -> (Core.Term -> Compute.Flow Graph.Graph t1) -> Core.Term -> Compute.Flow Graph.Graph (t0, t1))+pair kf vf term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermProduct v1 -> (Logic.ifElse (Equality.equal (Lists.length v1) 2) (Flows.bind (kf (Lists.head v1)) (\kVal -> Flows.bind (vf (Lists.head (Lists.tail v1))) (\vVal -> Flows.pure (kVal, vVal)))) (Monads.unexpected "pair" (Core_.term term)))+  _ -> (Monads.unexpected "product" (Core_.term term))) term))++productType :: (Core.Type -> Compute.Flow t0 [Core.Type])+productType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeProduct v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "product type" (Core_.type_ typ))) stripped)++-- | Extract a record's fields from a term+record :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph [Core.Field])+record expected term0 = (Flows.bind (termRecord term0) (\record -> Logic.ifElse (Equality.equal (Core.recordTypeName record) expected) (Flows.pure (Core.recordFields record)) (Monads.unexpected (Strings.cat [+  "record of type ",+  (Core.unName expected)]) (Core.unName (Core.recordTypeName record)))))++recordType :: (Core.Name -> Core.Type -> Compute.Flow t0 [Core.FieldType])+recordType ename typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeRecord v1 -> (Logic.ifElse (Equality.equal (Core.unName (Core.rowTypeTypeName v1)) (Core.unName ename)) (Flows.pure (Core.rowTypeFields v1)) (Monads.unexpected (Strings.cat [+      "record of type ",+      (Core.unName ename)]) (Strings.cat [+      "record of type ",+      (Core.unName (Core.rowTypeTypeName v1))])))+    _ -> (Monads.unexpected "record type" (Core_.type_ typ))) stripped)++-- | Extract a set of terms from a term+set :: (Core.Term -> Compute.Flow Graph.Graph (S.Set Core.Term))+set term = (Flows.bind (Lexical.stripAndDereferenceTerm term) (\stripped -> (\x -> case x of+  Core.TermSet v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "set" (Core_.term stripped))) stripped))++setOf :: (Ord t0) => ((Core.Term -> Compute.Flow Graph.Graph t0) -> Core.Term -> Compute.Flow Graph.Graph (S.Set t0))+setOf f term = (Flows.bind (set term) (\els -> Flows.mapSet f els))++setType :: (Core.Type -> Compute.Flow t0 Core.Type)+setType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeSet v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "set type" (Core_.type_ typ))) stripped)++-- | Extract a string value from a term+string :: (Core.Term -> Compute.Flow Graph.Graph String)+string t = (Flows.bind (literal t) stringLiteral)++stringLiteral :: (Core.Literal -> Compute.Flow t0 String)+stringLiteral v = ((\x -> case x of+  Core.LiteralString v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "string" (Core_.literal v))) v)++sumType :: (Core.Type -> Compute.Flow t0 [Core.Type])+sumType typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeSum v1 -> (Flows.pure v1)+    _ -> (Monads.unexpected "sum type" (Core_.type_ typ))) stripped)++-- | Extract a record from a term+termRecord :: (Core.Term -> Compute.Flow Graph.Graph Core.Record)+termRecord term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermRecord v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "record" (Core_.term term))) term))++-- | Extract a 16-bit unsigned integer value from a term+uint16 :: (Core.Term -> Compute.Flow Graph.Graph Int)+uint16 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> uint16Value i)))++uint16Value :: (Core.IntegerValue -> Compute.Flow t0 Int)+uint16Value v = ((\x -> case x of+  Core.IntegerValueUint16 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "uint16" (Core_.integer v))) v)++-- | Extract a 32-bit unsigned integer value from a term+uint32 :: (Core.Term -> Compute.Flow Graph.Graph I.Int64)+uint32 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> uint32Value i)))++uint32Value :: (Core.IntegerValue -> Compute.Flow t0 I.Int64)+uint32Value v = ((\x -> case x of+  Core.IntegerValueUint32 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "uint32" (Core_.integer v))) v)++-- | Extract a 64-bit unsigned integer value from a term+uint64 :: (Core.Term -> Compute.Flow Graph.Graph Integer)+uint64 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> uint64Value i)))++uint64Value :: (Core.IntegerValue -> Compute.Flow t0 Integer)+uint64Value v = ((\x -> case x of+  Core.IntegerValueUint64 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "uint64" (Core_.integer v))) v)++-- | Extract an 8-bit unsigned integer value from a term+uint8 :: (Core.Term -> Compute.Flow Graph.Graph I.Int16)+uint8 t = (Flows.bind (literal t) (\l -> Flows.bind (integerLiteral l) (\i -> uint8Value i)))++uint8Value :: (Core.IntegerValue -> Compute.Flow t0 I.Int16)+uint8Value v = ((\x -> case x of+  Core.IntegerValueUint8 v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "uint8" (Core_.integer v))) v)++unionType :: (Core.Name -> Core.Type -> Compute.Flow t0 [Core.FieldType])+unionType ename typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeUnion v1 -> (Logic.ifElse (Equality.equal (Core.rowTypeTypeName v1) ename) (Flows.pure (Core.rowTypeFields v1)) (Monads.unexpected (Strings.cat [+      "union of type ",+      (Core.unName ename)]) (Strings.cat [+      "union of type ",+      (Core.unName (Core.rowTypeTypeName v1))])))+    _ -> (Monads.unexpected "union type" (Core_.type_ typ))) stripped)++unit :: (Core.Term -> Compute.Flow t0 ())+unit term = ((\x -> case x of+  Core.TermUnit -> (Flows.pure ())+  _ -> (Monads.unexpected "unit" (Core_.term term))) term)++-- | Extract a unit variant (a variant with an empty record value) from a union term+unitVariant :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph Core.Name)+unitVariant tname term = (Flows.bind (variant tname term) (\field -> Flows.bind (unit (Core.fieldTerm field)) (\ignored -> Flows.pure (Core.fieldName field))))++-- | Extract a field from a union term (alias for injection)+variant :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph Core.Field)+variant = injection++-- | Extract the wrapped value from a wrapped term+wrap :: (Core.Name -> Core.Term -> Compute.Flow Graph.Graph Core.Term)+wrap expected term0 = (Flows.bind (Lexical.stripAndDereferenceTerm term0) (\term -> (\x -> case x of+  Core.TermWrap v1 -> (Logic.ifElse (Equality.equal (Core.unName (Core.wrappedTermTypeName v1)) (Core.unName expected)) (Flows.pure (Core.wrappedTermObject v1)) (Monads.unexpected (Strings.cat [+    "wrapper of type ",+    (Core.unName expected)]) (Core.unName (Core.wrappedTermTypeName v1))))+  _ -> (Monads.unexpected (Strings.cat [+    Strings.cat [+      "wrap(",+      (Core.unName expected)],+    ")"]) (Core_.term term))) term))++wrappedType :: (Core.Name -> Core.Type -> Compute.Flow t0 Core.Type)+wrappedType ename typ =  +  let stripped = (Rewriting.deannotateType typ)+  in ((\x -> case x of+    Core.TypeWrap v1 -> (Logic.ifElse (Equality.equal (Core.unName (Core.wrappedTypeTypeName v1)) (Core.unName ename)) (Flows.pure (Core.wrappedTypeObject v1)) (Monads.unexpected (Strings.cat [+      "wrapped type ",+      (Core.unName ename)]) (Strings.cat [+      "wrapped type ",+      (Core.unName (Core.wrappedTypeTypeName v1))])))+    _ -> (Monads.unexpected "wrapped type" (Core_.type_ typ))) stripped)
+ src/gen-main/haskell/Hydra/Extract/Json.hs view
@@ -0,0 +1,63 @@+-- | Utilities for extracting values from JSON objects++module Hydra.Extract.Json where++import qualified Hydra.Compute as Compute+import qualified Hydra.Json as Json+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Monads as Monads+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++expectArray :: (Json.Value -> Compute.Flow t0 [Json.Value])+expectArray value = ((\x -> case x of+  Json.ValueArray v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "JSON array" (showValue value))) value)++expectNumber :: (Json.Value -> Compute.Flow t0 Double)+expectNumber value = ((\x -> case x of+  Json.ValueNumber v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "JSON number" (showValue value))) value)++expectObject :: (Json.Value -> Compute.Flow t0 (M.Map String Json.Value))+expectObject value = ((\x -> case x of+  Json.ValueObject v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "JSON object" (showValue value))) value)++expectString :: (Json.Value -> Compute.Flow t0 String)+expectString value = ((\x -> case x of+  Json.ValueString v1 -> (Flows.pure v1)+  _ -> (Monads.unexpected "JSON string" (showValue value))) value)++opt :: (Ord t0) => (t0 -> M.Map t0 t1 -> Maybe t1)+opt fname m = (Maps.lookup fname m)++optArray :: (Ord t0) => (t0 -> M.Map t0 Json.Value -> Compute.Flow t1 (Maybe [Json.Value]))+optArray fname m = (Optionals.maybe (Flows.pure Nothing) (\a -> Flows.map Optionals.pure (expectArray a)) (opt fname m))++optString :: (Ord t0) => (t0 -> M.Map t0 Json.Value -> Compute.Flow t1 (Maybe String))+optString fname m = (Optionals.maybe (Flows.pure Nothing) (\s -> Flows.map Optionals.pure (expectString s)) (opt fname m))++require :: (Ord t0) => (t0 -> M.Map t0 t1 -> Compute.Flow t2 t1)+require fname m = (Optionals.maybe (Flows.fail (Strings.cat [+  "required attribute ",+  showValue fname,+  " not found"])) (\value -> Flows.pure value) (Maps.lookup fname m))++requireArray :: (Ord t0) => (t0 -> M.Map t0 Json.Value -> Compute.Flow t1 [Json.Value])+requireArray fname m = (Flows.bind (require fname m) expectArray)++requireNumber :: (Ord t0) => (t0 -> M.Map t0 Json.Value -> Compute.Flow t1 Double)+requireNumber fname m = (Flows.bind (require fname m) expectNumber)++requireString :: (Ord t0) => (t0 -> M.Map t0 Json.Value -> Compute.Flow t1 String)+requireString fname m = (Flows.bind (require fname m) expectString)++showValue :: (t0 -> String)+showValue value = "TODO: implement showValue"
+ src/gen-main/haskell/Hydra/Extract/Mantle.hs view
@@ -0,0 +1,22 @@+-- | A DSL for decoding and validating Hydra terms at runtime. This module provides functions to extract typed values from Hydra terms with appropriate error handling.++module Hydra.Extract.Mantle where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Extract.Core as Core_+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Logic as Logic+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Monads as Monads+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Extract a comparison from a term+comparison :: (Core.Term -> Compute.Flow Graph.Graph Mantle.Comparison)+comparison term = (Flows.bind (Core_.unitVariant (Core.Name "hydra.mantle.Comparison") term) (\fname -> Logic.ifElse (Equality.equal (Core.unName fname) "equalTo") (Flows.pure Mantle.ComparisonEqualTo) (Logic.ifElse (Equality.equal (Core.unName fname) "lessThan") (Flows.pure Mantle.ComparisonLessThan) (Logic.ifElse (Equality.equal (Core.unName fname) "greaterThan") (Flows.pure Mantle.ComparisonGreaterThan) (Monads.unexpected "comparison" (Core.unName fname))))))
− src/gen-main/haskell/Hydra/Extras.hs 
@@ -1,62 +0,0 @@--- | Basic functions which depend on primitive functions--module Hydra.Extras where--import qualified Hydra.Core as Core-import qualified Hydra.Graph as Graph-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Maps as Maps-import qualified Hydra.Lib.Math as Math-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Module as Module-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--functionArity :: (Core.Function -> Int)-functionArity x = case x of-  Core.FunctionElimination _ -> 1-  Core.FunctionLambda v275 -> (Math.add 1 (termArity (Core.lambdaBody v275)))-  Core.FunctionPrimitive _ -> 42--lookupPrimitive :: (Graph.Graph -> Core.Name -> Maybe Graph.Primitive)-lookupPrimitive g name = (Maps.lookup name (Graph.graphPrimitives g))---- | Find the arity (expected number of arguments) of a primitive constant or function-primitiveArity :: (Graph.Primitive -> Int)-primitiveArity x = ((\x -> typeArity (Core.typeSchemeType x)) (Graph.primitiveType x))---- | Construct a qualified (dot-separated) name-qname :: (Module.Namespace -> String -> Core.Name)-qname ns name = (Core.Name (Strings.cat [-  Module.unNamespace ns,-  ".",-  name]))--termArity :: (Core.Term -> Int)-termArity x = case x of-  Core.TermApplication v277 -> ((\x -> (\x -> Math.sub x 1) (termArity x)) (Core.applicationFunction v277))-  Core.TermFunction v278 -> (functionArity v278)-  _ -> 0--typeArity :: (Core.Type -> Int)-typeArity x = case x of-  Core.TypeAnnotated v279 -> (typeArity (Core.annotatedTypeSubject v279))-  Core.TypeApplication v280 -> (typeArity (Core.applicationTypeFunction v280))-  Core.TypeLambda v281 -> (typeArity (Core.lambdaTypeBody v281))-  Core.TypeFunction v282 -> (Math.add 1 (typeArity (Core.functionTypeCodomain v282)))-  _ -> 0---- | Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)-uncurryType :: (Core.Type -> [Core.Type])-uncurryType t = ((\x -> case x of-  Core.TypeAnnotated v283 -> (uncurryType (Core.annotatedTypeSubject v283))-  Core.TypeApplication v284 -> (uncurryType (Core.applicationTypeFunction v284))-  Core.TypeLambda v285 -> (uncurryType (Core.lambdaTypeBody v285))-  Core.TypeFunction v286 -> (Lists.cons (Core.functionTypeDomain v286) (uncurryType (Core.functionTypeCodomain v286)))-  _ -> [-    t]) t)--getAnnotation :: (Core.Name -> Map Core.Name Core.Term -> Maybe Core.Term)-getAnnotation key ann = (Maps.lookup key ann)
+ src/gen-main/haskell/Hydra/Formatting.hs view
@@ -0,0 +1,164 @@+-- | String formatting types and functions.++module Hydra.Formatting where++import qualified Hydra.Lib.Chars as Chars+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Lists as Lists+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 Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Capitalize the first letter of a string+capitalize :: (String -> String)+capitalize = (mapFirstLetter Strings.toUpper)++-- | Convert a string from one case convention to another+convertCase :: (Mantle.CaseConvention -> Mantle.CaseConvention -> String -> String)+convertCase from to original =  +  let parts =  +          let byCaps =  +                  let splitOnUppercase = (\acc -> \c -> Lists.concat2 (Logic.ifElse (Chars.isUpper c) [+                          []] []) (Lists.cons (Lists.cons c (Lists.head acc)) (Lists.tail acc)))+                  in (Lists.map Strings.fromList (Lists.foldl splitOnUppercase [+                    []] (Lists.reverse (Strings.toList (decapitalize original))))) +              byUnderscores = (Strings.splitOn "_" original)+          in ((\x -> case x of+            Mantle.CaseConventionCamel -> byCaps+            Mantle.CaseConventionPascal -> byCaps+            Mantle.CaseConventionLowerSnake -> byUnderscores+            Mantle.CaseConventionUpperSnake -> byUnderscores) from)+  in ((\x -> case x of+    Mantle.CaseConventionCamel -> (decapitalize (Strings.cat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts)))+    Mantle.CaseConventionPascal -> (Strings.cat (Lists.map (\arg_ -> capitalize (Strings.toLower arg_)) parts))+    Mantle.CaseConventionLowerSnake -> (Strings.intercalate "_" (Lists.map Strings.toLower parts))+    Mantle.CaseConventionUpperSnake -> (Strings.intercalate "_" (Lists.map Strings.toUpper parts))) to)++-- | Convert a string from camel case to lower snake case+convertCaseCamelToLowerSnake :: (String -> String)+convertCaseCamelToLowerSnake = (convertCase Mantle.CaseConventionCamel Mantle.CaseConventionLowerSnake)++-- | Convert a string from camel case to upper snake case+convertCaseCamelToUpperSnake :: (String -> String)+convertCaseCamelToUpperSnake = (convertCase Mantle.CaseConventionCamel Mantle.CaseConventionUpperSnake)++-- | Convert a string from pascal case to upper snake case+convertCasePascalToUpperSnake :: (String -> String)+convertCasePascalToUpperSnake = (convertCase Mantle.CaseConventionPascal Mantle.CaseConventionUpperSnake)++-- | Decapitalize the first letter of a string+decapitalize :: (String -> String)+decapitalize = (mapFirstLetter Strings.toLower)++escapeWithUnderscore :: (S.Set String -> String -> String)+escapeWithUnderscore reserved s = (Logic.ifElse (Sets.member s reserved) (Strings.cat [+  s,+  "_"]) s)++indentLines :: (String -> String)+indentLines s =  +  let indent = (\l -> Strings.cat [+          "    ",+          l])+  in (Strings.unlines (Lists.map indent (Strings.lines s)))++javaStyleComment :: (String -> String)+javaStyleComment s = (Strings.cat [+  Strings.cat [+    Strings.cat [+      "/**\n",+      " * "],+    s],+  "\n */"])++-- | A helper which maps the first letter of a string to another string+mapFirstLetter :: ((String -> String) -> String -> String)+mapFirstLetter mapping s =  +  let list = (Strings.toList s)+  in  +    let firstLetter = (mapping (Strings.fromList (Lists.pure (Lists.head list))))+    in (Logic.ifElse (Strings.null s) s (Strings.cat2 firstLetter (Strings.fromList (Lists.tail list))))++nonAlnumToUnderscores :: (String -> String)+nonAlnumToUnderscores input =  +  let isAlnum = (\c -> Logic.or (Logic.and (Equality.gte c 65) (Equality.lte c 90)) (Logic.or (Logic.and (Equality.gte c 97) (Equality.lte c 122)) (Logic.and (Equality.gte c 48) (Equality.lte c 57))))+  in  +    let replace = (\p -> \c ->  +            let s = (fst p)+            in  +              let b = (snd p)+              in (Logic.ifElse (isAlnum c) (Lists.cons c s, False) (Logic.ifElse b (s, True) (Lists.cons 95 s, True))))+    in  +      let result = (Lists.foldl replace ([], False) (Strings.toList input))+      in (Strings.fromList (Lists.reverse (fst result)))++sanitizeWithUnderscores :: (S.Set String -> String -> String)+sanitizeWithUnderscores reserved s = (escapeWithUnderscore reserved (nonAlnumToUnderscores s))++showList :: ((t0 -> String) -> [t0] -> String)+showList f els = (Strings.cat [+  "[",+  Strings.intercalate ", " (Lists.map f els),+  "]"])++stripLeadingAndTrailingWhitespace :: (String -> String)+stripLeadingAndTrailingWhitespace s = (Strings.fromList (Lists.dropWhile Chars.isSpace (Lists.reverse (Lists.dropWhile Chars.isSpace (Lists.reverse (Strings.toList s))))))++withCharacterAliases :: (String -> String)+withCharacterAliases original =  +  let aliases = (Maps.fromList [+          (32, "sp"),+          (33, "excl"),+          (34, "quot"),+          (35, "num"),+          (36, "dollar"),+          (37, "percnt"),+          (38, "amp"),+          (39, "apos"),+          (40, "lpar"),+          (41, "rpar"),+          (42, "ast"),+          (43, "plus"),+          (44, "comma"),+          (45, "minus"),+          (46, "period"),+          (47, "sol"),+          (58, "colon"),+          (59, "semi"),+          (60, "lt"),+          (61, "equals"),+          (62, "gt"),+          (63, "quest"),+          (64, "commat"),+          (91, "lsqb"),+          (92, "bsol"),+          (93, "rsqb"),+          (94, "circ"),+          (95, "lowbar"),+          (96, "grave"),+          (123, "lcub"),+          (124, "verbar"),+          (125, "rcub"),+          (126, "tilde")]) +      alias = (\c -> Optionals.fromMaybe (Lists.pure c) (Optionals.map Strings.toList (Maps.lookup c aliases)))+  in (Strings.fromList (Lists.filter Chars.isAlphaNum (Lists.concat (Lists.map alias (Strings.toList original)))))++-- | A simple soft line wrap which is suitable for code comments+wrapLine :: (Int -> String -> String)+wrapLine maxlen input =  +  let helper = (\prev -> \rem ->  +          let trunc = (Lists.take maxlen rem) +              spanResult = (Lists.span (\c -> Logic.and (Logic.not (Equality.equal c 32)) (Logic.not (Equality.equal c 9))) (Lists.reverse trunc))+              prefix = (Lists.reverse (snd spanResult))+              suffix = (Lists.reverse (fst spanResult))+          in (Logic.ifElse (Equality.lte (Lists.length rem) maxlen) (Lists.reverse (Lists.cons rem prev)) (Logic.ifElse (Lists.null prefix) (helper (Lists.cons trunc prev) (Lists.drop maxlen rem)) (helper (Lists.cons (Lists.init prefix) prev) (Lists.concat2 suffix (Lists.drop maxlen rem))))))+  in (Strings.fromList (Lists.intercalate [+    10] (helper [] (Strings.toList input))))
src/gen-main/haskell/Hydra/Grammar.hs view
@@ -3,10 +3,11 @@ module Hydra.Grammar where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A constant pattern newtype Constant = @@ -14,7 +15,7 @@     unConstant :: String}   deriving (Eq, Ord, Read, Show) -_Constant = (Core.Name "hydra/grammar.Constant")+_Constant = (Core.Name "hydra.grammar.Constant")  -- | An enhanced Backus-Naur form (BNF) grammar newtype Grammar = @@ -22,7 +23,7 @@     unGrammar :: [Production]}   deriving (Eq, Ord, Read, Show) -_Grammar = (Core.Name "hydra/grammar.Grammar")+_Grammar = (Core.Name "hydra.grammar.Grammar")  -- | A name for a pattern newtype Label = @@ -30,7 +31,7 @@     unLabel :: String}   deriving (Eq, Ord, Read, Show) -_Label = (Core.Name "hydra/grammar.Label")+_Label = (Core.Name "hydra.grammar.Label")  -- | A pattern together with a name (label) data LabeledPattern = @@ -39,7 +40,7 @@     labeledPatternPattern :: Pattern}   deriving (Eq, Ord, Read, Show) -_LabeledPattern = (Core.Name "hydra/grammar.LabeledPattern")+_LabeledPattern = (Core.Name "hydra.grammar.LabeledPattern")  _LabeledPattern_label = (Core.Name "label") @@ -47,42 +48,42 @@  -- | A pattern which matches valid expressions in the language data Pattern = -  PatternNil  |+  PatternAlternatives [Pattern] |+  PatternConstant Constant |   PatternIgnored Pattern |   PatternLabeled LabeledPattern |-  PatternConstant Constant |-  PatternRegex Regex |+  PatternNil  |   PatternNonterminal Symbol |-  PatternSequence [Pattern] |-  PatternAlternatives [Pattern] |   PatternOption Pattern |-  PatternStar Pattern |-  PatternPlus Pattern+  PatternPlus Pattern |+  PatternRegex Regex |+  PatternSequence [Pattern] |+  PatternStar Pattern   deriving (Eq, Ord, Read, Show) -_Pattern = (Core.Name "hydra/grammar.Pattern")+_Pattern = (Core.Name "hydra.grammar.Pattern") -_Pattern_nil = (Core.Name "nil")+_Pattern_alternatives = (Core.Name "alternatives") +_Pattern_constant = (Core.Name "constant")+ _Pattern_ignored = (Core.Name "ignored")  _Pattern_labeled = (Core.Name "labeled") -_Pattern_constant = (Core.Name "constant")--_Pattern_regex = (Core.Name "regex")+_Pattern_nil = (Core.Name "nil")  _Pattern_nonterminal = (Core.Name "nonterminal") -_Pattern_sequence = (Core.Name "sequence")+_Pattern_option = (Core.Name "option") -_Pattern_alternatives = (Core.Name "alternatives")+_Pattern_plus = (Core.Name "plus") -_Pattern_option = (Core.Name "option")+_Pattern_regex = (Core.Name "regex") -_Pattern_star = (Core.Name "star")+_Pattern_sequence = (Core.Name "sequence") -_Pattern_plus = (Core.Name "plus")+_Pattern_star = (Core.Name "star")  -- | A BNF production data Production = @@ -91,7 +92,7 @@     productionPattern :: Pattern}   deriving (Eq, Ord, Read, Show) -_Production = (Core.Name "hydra/grammar.Production")+_Production = (Core.Name "hydra.grammar.Production")  _Production_symbol = (Core.Name "symbol") @@ -103,7 +104,7 @@     unRegex :: String}   deriving (Eq, Ord, Read, Show) -_Regex = (Core.Name "hydra/grammar.Regex")+_Regex = (Core.Name "hydra.grammar.Regex")  -- | A nonterminal symbol newtype Symbol = @@ -111,4 +112,4 @@     unSymbol :: String}   deriving (Eq, Ord, Read, Show) -_Symbol = (Core.Name "hydra/grammar.Symbol")+_Symbol = (Core.Name "hydra.grammar.Symbol")
+ src/gen-main/haskell/Hydra/Grammars.hs view
@@ -0,0 +1,157 @@+-- | A utility for converting a BNF grammar to a Hydra module.++module Hydra.Grammars where++import qualified Hydra.Annotations as Annotations+import qualified Hydra.Constants as Constants+import qualified Hydra.Core as Core+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Grammar as Grammar+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.Math as Math+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Module as Module+import qualified Hydra.Names as Names+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Generate child name+childName :: (String -> String -> String)+childName lname n = (Strings.cat [+  lname,+  "_",+  (Formatting.capitalize n)])++-- | Find unique names for patterns+findNames :: ([Grammar.Pattern] -> [String])+findNames pats =  +  let nextName = (\acc -> \pat ->  +          let names = (fst acc) +              nameMap = (snd acc)+              rn = (rawName pat)+              nameAndIndex = (Optionals.maybe (rn, 1) (\i -> (Strings.cat2 rn (Literals.showInt32 (Math.add i 1)), (Math.add i 1))) (Maps.lookup rn nameMap))+              nn = (fst nameAndIndex)+              ni = (snd nameAndIndex)+          in (Lists.cons nn names, (Maps.insert rn ni nameMap)))+  in (Lists.reverse (fst (Lists.foldl nextName ([], Maps.empty) pats)))++-- | Convert a BNF grammar to a Hydra module+grammarToModule :: (Module.Namespace -> Grammar.Grammar -> Maybe String -> Module.Module)+grammarToModule ns grammar desc =  +  let prodPairs = (Lists.map (\prod -> (Grammar.unSymbol (Grammar.productionSymbol prod), (Grammar.productionPattern prod))) (Grammar.unGrammar grammar)) +      capitalizedNames = (Lists.map (\pair -> Formatting.capitalize (fst pair)) prodPairs)+      patterns = (Lists.map (\pair -> snd pair) prodPairs)+      elementPairs = (Lists.concat (Lists.zipWith (makeElements False ns) capitalizedNames patterns))+      elements = (Lists.map (\pair ->  +              let lname = (fst pair) +                  typ = (wrapType (snd pair))+              in (Annotations.typeElement (toName ns lname) typ)) elementPairs)+  in Module.Module {+    Module.moduleNamespace = ns,+    Module.moduleElements = elements,+    Module.moduleTermDependencies = [],+    Module.moduleTypeDependencies = [],+    Module.moduleDescription = desc}++-- | Check if pattern is complex+isComplex :: (Grammar.Pattern -> Bool)+isComplex pat = ((\x -> case x of+  Grammar.PatternLabeled v1 -> (isComplex (Grammar.labeledPatternPattern v1))+  Grammar.PatternSequence v1 -> (isNontrivial True v1)+  Grammar.PatternAlternatives v1 -> (isNontrivial False v1)+  _ -> False) pat)++-- | Check if patterns are nontrivial+isNontrivial :: (Bool -> [Grammar.Pattern] -> Bool)+isNontrivial isRecord pats =  +  let minPats = (simplify isRecord pats)+  in (Logic.ifElse (Equality.equal (Lists.length minPats) 1) ((\x -> case x of+    Grammar.PatternLabeled _ -> True+    _ -> False) (Lists.head minPats)) True)++-- | Create elements from pattern+makeElements :: (Bool -> Module.Namespace -> String -> Grammar.Pattern -> [(String, Core.Type)])+makeElements omitTrivial ns lname pat =  +  let trivial = (Logic.ifElse omitTrivial [] [+          (lname, Core.TypeUnit)]) +      forRecordOrUnion = (\isRecord -> \construct -> \pats ->  +              let minPats = (simplify isRecord pats) +                  fieldNames = (findNames minPats)+                  toField = (\n -> \p -> descend n (\pairs -> (Core.FieldType {+                          Core.fieldTypeName = (Core.Name n),+                          Core.fieldTypeType = (snd (Lists.head pairs))}, (Lists.tail pairs))) p)+                  fieldPairs = (Lists.zipWith toField fieldNames minPats)+                  fields = (Lists.map fst fieldPairs)+                  els = (Lists.concat (Lists.map snd fieldPairs))+              in (Logic.ifElse (isNontrivial isRecord pats) (Lists.cons (lname, (construct fields)) els) (forPat (Lists.head minPats))))+      mod = (\n -> \f -> \p -> descend n (\pairs -> Lists.cons (lname, (f (snd (Lists.head pairs)))) (Lists.tail pairs)) p)+      descend = (\n -> \f -> \p ->  +              let cpairs = (makeElements False ns (childName lname n) p)+              in (f (Logic.ifElse (isComplex p) (Lists.cons (lname, (Core.TypeVariable (toName ns (fst (Lists.head cpairs))))) cpairs) (Logic.ifElse (Lists.null cpairs) [+                (lname, Core.TypeUnit)] (Lists.cons (lname, (snd (Lists.head cpairs))) (Lists.tail cpairs))))))+      forPat = (\pat -> (\x -> case x of+              Grammar.PatternAlternatives v1 -> (forRecordOrUnion False (\fields -> Core.TypeUnion (Core.RowType {+                Core.rowTypeTypeName = Constants.placeholderName,+                Core.rowTypeFields = fields})) v1)+              Grammar.PatternConstant _ -> trivial+              Grammar.PatternIgnored _ -> []+              Grammar.PatternLabeled v1 -> (forPat (Grammar.labeledPatternPattern v1))+              Grammar.PatternNil -> trivial+              Grammar.PatternNonterminal v1 -> [+                (lname, (Core.TypeVariable (toName ns (Grammar.unSymbol v1))))]+              Grammar.PatternOption v1 -> (mod "Option" (\x -> Core.TypeOptional x) v1)+              Grammar.PatternPlus v1 -> (mod "Elmt" (\x -> Core.TypeList x) v1)+              Grammar.PatternRegex _ -> [+                (lname, (Core.TypeLiteral Core.LiteralTypeString))]+              Grammar.PatternSequence v1 -> (forRecordOrUnion True (\fields -> Core.TypeRecord (Core.RowType {+                Core.rowTypeTypeName = Constants.placeholderName,+                Core.rowTypeFields = fields})) v1)+              Grammar.PatternStar v1 -> (mod "Elmt" (\x -> Core.TypeList x) v1)) pat)+  in (forPat pat)++-- | Get raw name from pattern+rawName :: (Grammar.Pattern -> String)+rawName pat = ((\x -> case x of+  Grammar.PatternAlternatives _ -> "alts"+  Grammar.PatternConstant v1 -> (Formatting.capitalize (Formatting.withCharacterAliases (Grammar.unConstant v1)))+  Grammar.PatternIgnored _ -> "ignored"+  Grammar.PatternLabeled v1 -> (Grammar.unLabel (Grammar.labeledPatternLabel v1))+  Grammar.PatternNil -> "none"+  Grammar.PatternNonterminal v1 -> (Formatting.capitalize (Grammar.unSymbol v1))+  Grammar.PatternOption v1 -> (Formatting.capitalize (rawName v1))+  Grammar.PatternPlus v1 -> (Strings.cat2 "listOf" (Formatting.capitalize (rawName v1)))+  Grammar.PatternRegex _ -> "regex"+  Grammar.PatternSequence _ -> "sequence"+  Grammar.PatternStar v1 -> (Strings.cat2 "listOf" (Formatting.capitalize (rawName v1)))) pat)++-- | Remove trivial patterns from records+simplify :: (Bool -> [Grammar.Pattern] -> [Grammar.Pattern])+simplify isRecord pats =  +  let isConstant = (\p -> (\x -> case x of+          Grammar.PatternConstant _ -> True+          _ -> False) p)+  in (Logic.ifElse isRecord (Lists.filter (\p -> Logic.not (isConstant p)) pats) pats)++-- | Convert local name to qualified name+toName :: (Module.Namespace -> String -> Core.Name)+toName ns local = (Names.unqualifyName (Module.QualifiedName {+  Module.qualifiedNameNamespace = (Just ns),+  Module.qualifiedNameLocal = local}))++-- | Wrap a type in a placeholder name, unless it is already a wrapper, record, or union type+wrapType :: (Core.Type -> Core.Type)+wrapType t = ((\x -> case x of+  Core.TypeRecord _ -> t+  Core.TypeUnion _ -> t+  Core.TypeWrap _ -> t+  _ -> (Core.TypeWrap (Core.WrappedType {+    Core.wrappedTypeTypeName = (Core.Name "Placeholder"),+    Core.wrappedTypeObject = t}))) t)
src/gen-main/haskell/Hydra/Graph.hs view
@@ -1,46 +1,32 @@--- | The extension to graphs of Hydra's core type system (hydra/core)+-- | The extension to graphs of Hydra's core type system (hydra.core)  module Hydra.Graph where  import qualified Hydra.Compute as Compute import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | An equality judgement: less than, equal to, or greater than-data Comparison = -  ComparisonLessThan  |-  ComparisonEqualTo  |-  ComparisonGreaterThan -  deriving (Eq, Ord, Read, Show)--_Comparison = (Core.Name "hydra/graph.Comparison")--_Comparison_lessThan = (Core.Name "lessThan")--_Comparison_equalTo = (Core.Name "equalTo")--_Comparison_greaterThan = (Core.Name "greaterThan")+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph data Graph =    Graph {     -- | All of the elements in the graph-    graphElements :: (Map Core.Name Element),+    graphElements :: (M.Map Core.Name Core.Binding),     -- | The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term)-    graphEnvironment :: (Map Core.Name (Maybe Core.Term)),+    graphEnvironment :: (M.Map Core.Name (Maybe Core.Term)),     -- | The typing environment of the graph-    graphTypes :: (Map Core.Name Core.TypeScheme),+    graphTypes :: (M.Map Core.Name Core.TypeScheme),     -- | The body of the term which generated this context     graphBody :: Core.Term,     -- | All supported primitive constants and functions, by name-    graphPrimitives :: (Map Core.Name Primitive),+    graphPrimitives :: (M.Map Core.Name Primitive),     -- | The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph.     graphSchema :: (Maybe Graph)} -_Graph = (Core.Name "hydra/graph.Graph")+_Graph = (Core.Name "hydra.graph.Graph")  _Graph_elements = (Core.Name "elements") @@ -54,19 +40,6 @@  _Graph_schema = (Core.Name "schema") --- | A graph element, having a name, data term (value), and schema term (type)-data Element = -  Element {-    elementName :: Core.Name,-    elementData :: Core.Term}-  deriving (Eq, Ord, Read, Show)--_Element = (Core.Name "hydra/graph.Element")--_Element_name = (Core.Name "name")--_Element_data = (Core.Name "data")- -- | A built-in function data Primitive =    Primitive {@@ -77,7 +50,7 @@     -- | A concrete implementation of the primitive function     primitiveImplementation :: ([Core.Term] -> Compute.Flow Graph Core.Term)} -_Primitive = (Core.Name "hydra/graph.Primitive")+_Primitive = (Core.Name "hydra.graph.Primitive")  _Primitive_name = (Core.Name "name") @@ -86,25 +59,13 @@ _Primitive_implementation = (Core.Name "implementation")  -- | A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms-data TermCoder x = +data TermCoder a =    TermCoder {     termCoderType :: Core.Type,-    termCoderCoder :: (Compute.Coder Graph Graph Core.Term x)}+    termCoderCoder :: (Compute.Coder Graph Graph Core.Term a)} -_TermCoder = (Core.Name "hydra/graph.TermCoder")+_TermCoder = (Core.Name "hydra.graph.TermCoder")  _TermCoder_type = (Core.Name "type")  _TermCoder_coder = (Core.Name "coder")---- | Any of a small number of built-in type classes-data TypeClass = -  TypeClassEquality  |-  TypeClassOrdering -  deriving (Eq, Ord, Read, Show)--_TypeClass = (Core.Name "hydra/graph.TypeClass")--_TypeClass_equality = (Core.Name "equality")--_TypeClass_ordering = (Core.Name "ordering")
+ src/gen-main/haskell/Hydra/Inference.hs view
@@ -0,0 +1,1179 @@+-- | Type inference following Algorithm W, extended for nominal terms and types++module Hydra.Inference where++import qualified Hydra.Annotations as Annotations+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Extract.Core as Core_+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Math as Math+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.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import qualified Hydra.Show.Core as Core__+import qualified Hydra.Show.Mantle as Mantle_+import qualified Hydra.Show.Typing as Typing+import qualified Hydra.Sorting as Sorting+import qualified Hydra.Substitution as Substitution+import qualified Hydra.Typing as Typing_+import qualified Hydra.Unification as Unification+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++bindConstraints :: (Typing_.InferenceContext -> (Typing_.TypeSubst -> Compute.Flow t0 t1) -> [Typing_.TypeConstraint] -> Compute.Flow t0 t1)+bindConstraints cx f constraints = (Flows.bind (Unification.unifyTypeConstraints (Typing_.inferenceContextSchemaTypes cx) constraints) f)++checkSameType :: (String -> [Core.Type] -> Compute.Flow t0 Core.Type)+checkSameType desc types =  +  let h = (Lists.head types)+  in  +    let allEqual = (Lists.foldl (\b -> \t -> Logic.and b (Equality.equal t h)) True types)+    in (Logic.ifElse allEqual (Flows.pure h) (Flows.fail (Strings.cat [+      "unequal types ",+      Formatting.showList Core__.type_ types,+      " in ",+      desc])))++checkType :: (S.Set Core.Name -> Typing_.InferenceContext -> Core.Type -> Core.Term -> Compute.Flow t0 ())+checkType k g t e = (Logic.ifElse debugInference (Flows.bind (typeOfInternal g k (toFContext g) [] e) (\t0 -> Logic.ifElse (Equality.equal t0 t) (Flows.pure ()) (Flows.fail (Strings.cat [+  "type checking failed: expected ",+  Core__.type_ t,+  " but found ",+  (Core__.type_ t0)])))) (Flows.pure ()))++checkTypeVariables :: (Typing_.InferenceContext -> S.Set Core.Name -> Core.Type -> Compute.Flow t0 ())+checkTypeVariables cx tyvars typ = (Monads.withTrace (Strings.cat [+  "checking variables of: ",+  (Core__.type_ typ)]) ((\x -> case x of+  Core.TypeForall v1 -> (checkTypeVariables cx (Sets.insert (Core.forallTypeParameter v1) tyvars) (Core.forallTypeBody v1))+  Core.TypeVariable v1 -> (Logic.ifElse (Sets.member v1 tyvars) (Flows.pure ()) (Logic.ifElse (Maps.member v1 (Typing_.inferenceContextSchemaTypes cx)) (Flows.pure ()) (Flows.fail (Strings.cat [+    "unbound type variable \"",+    Core.unName v1,+    "\" in ",+    (Core__.type_ typ)]))))+  _ -> (Flows.bind (Flows.mapList (checkTypeVariables cx tyvars) (Rewriting.subtypes typ)) (\result -> Flows.pure ()))) typ))++-- | Disable type checking by default, for better performance+debugInference :: Bool+debugInference = True++-- | An empty inference context+emptyInferenceContext :: Typing_.InferenceContext+emptyInferenceContext = Typing_.InferenceContext {+  Typing_.inferenceContextSchemaTypes = (M.fromList []),+  Typing_.inferenceContextPrimitiveTypes = (M.fromList []),+  Typing_.inferenceContextDataTypes = (M.fromList []),+  Typing_.inferenceContextDebug = False}++-- | Add (term variable, type scheme) pairs to the typing environment+extendContext :: ([(Core.Name, Core.TypeScheme)] -> Typing_.InferenceContext -> Typing_.InferenceContext)+extendContext pairs cx = Typing_.InferenceContext {+  Typing_.inferenceContextSchemaTypes = (Typing_.inferenceContextSchemaTypes cx),+  Typing_.inferenceContextPrimitiveTypes = (Typing_.inferenceContextPrimitiveTypes cx),+  Typing_.inferenceContextDataTypes = (Maps.union (Maps.fromList pairs) (Typing_.inferenceContextDataTypes cx)),+  Typing_.inferenceContextDebug = (Typing_.inferenceContextDebug cx)}++forInferredTerm :: (Typing_.InferenceContext -> Core.Term -> String -> (Typing_.InferenceResult -> t0) -> Compute.Flow t1 t0)+forInferredTerm cx term desc f = (Flows.map f (inferTypeOfTerm cx term desc))++-- | Get all free variables in an inference context+freeVariablesInContext :: (Typing_.InferenceContext -> S.Set Core.Name)+freeVariablesInContext cx = (Lists.foldl Sets.union Sets.empty (Lists.map Rewriting.freeVariablesInTypeSchemeSimple (Maps.elems (Typing_.inferenceContextDataTypes cx))))++freshName :: (Compute.Flow t0 Core.Name)+freshName = (Flows.map normalTypeVariable (Annotations.nextCount key_vcount))++freshNames :: (Int -> Compute.Flow t0 [Core.Name])+freshNames n = (Flows.sequence (Lists.replicate n freshName))++freshVariableType :: (Compute.Flow t0 Core.Type)+freshVariableType = (Flows.map (\x -> Core.TypeVariable x) freshName)++-- | Generalize a type to a type scheme+generalize :: (Typing_.InferenceContext -> Core.Type -> Core.TypeScheme)+generalize cx typ =  +  let vars = (Lists.nub (Lists.filter (isUnbound cx) (Rewriting.freeVariablesInTypeOrdered typ)))+  in Core.TypeScheme {+    Core.typeSchemeVariables = vars,+    Core.typeSchemeType = typ}++graphToInferenceContext :: (Graph.Graph -> Compute.Flow t0 Typing_.InferenceContext)+graphToInferenceContext g0 =  +  let schema = (Optionals.fromMaybe g0 (Graph.graphSchema g0))+  in  +    let primTypes = (Maps.fromList (Lists.map (\p -> (Graph.primitiveName p, (Graph.primitiveType p))) (Maps.elems (Graph.graphPrimitives g0))))+    in  +      let varTypes = Maps.empty+      in (Flows.bind (Schemas.schemaGraphToTypingEnvironment schema) (\schemaTypes -> Flows.pure (Typing_.InferenceContext {+        Typing_.inferenceContextSchemaTypes = schemaTypes,+        Typing_.inferenceContextPrimitiveTypes = primTypes,+        Typing_.inferenceContextDataTypes = varTypes,+        Typing_.inferenceContextDebug = False})))++inferGraphTypes :: (Graph.Graph -> Compute.Flow t0 Graph.Graph)+inferGraphTypes g0 =  +  let fromLetTerm = (\l ->  +          let bindings = (Core.letBindings l)+          in  +            let env = (Core.letEnvironment l)+            in  +              let fromBinding = (\b -> (Core.bindingName b, b))+              in Graph.Graph {+                Graph.graphElements = (Maps.fromList (Lists.map fromBinding bindings)),+                Graph.graphEnvironment = Maps.empty,+                Graph.graphTypes = Maps.empty,+                Graph.graphBody = env,+                Graph.graphPrimitives = (Graph.graphPrimitives g0),+                Graph.graphSchema = (Graph.graphSchema g0)})+  in  +    let toLetTerm = (\g ->  +            let toBinding = (\el -> Core.Binding {+                    Core.bindingName = (Core.bindingName el),+                    Core.bindingTerm = (Core.bindingTerm el),+                    Core.bindingType = Nothing})+            in (Core.TermLet (Core.Let {+              Core.letBindings = (Lists.map toBinding (Maps.elems (Graph.graphElements g))),+              Core.letEnvironment = (Graph.graphBody g)})))+    in (Monads.withTrace "graph inference" (Flows.bind (graphToInferenceContext g0) (\cx -> Flows.bind (inferTypeOfTerm cx (toLetTerm g0) "graph term") (\result ->  +      let term = (Typing_.inferenceResultTerm result)+      in  +        let ts = (Typing_.inferenceResultType result)+        in ((\x -> case x of+          Core.TermLet v1 -> (Flows.pure (fromLetTerm v1))+          Core.TermVariable _ -> (Flows.fail "Expected inferred graph as let term")) (Rewriting.normalizeTypeVariablesInTerm term))))))++-- | Infer the type of a term in graph context+inferInGraphContext :: (Core.Term -> Compute.Flow Graph.Graph Typing_.InferenceResult)+inferInGraphContext term = (Flows.bind Monads.getState (\g -> Flows.bind (graphToInferenceContext g) (\cx -> inferTypeOfTerm cx term "single term")))++inferMany :: (Typing_.InferenceContext -> [(Core.Term, String)] -> Compute.Flow t0 ([Core.Term], ([Core.Type], Typing_.TypeSubst)))+inferMany cx pairs = (Logic.ifElse (Lists.null pairs) (Flows.pure ([], ([], Substitution.idTypeSubst))) ( +  let e = (fst (Lists.head pairs))+  in  +    let desc = (snd (Lists.head pairs))+    in  +      let tl = (Lists.tail pairs)+      in (Flows.bind (inferTypeOfTerm cx e desc) (\result1 ->  +        let e1 = (Typing_.inferenceResultTerm result1)+        in  +          let t1 = (Typing_.inferenceResultType result1)+          in  +            let s1 = (Typing_.inferenceResultSubst result1)+            in (Flows.bind (inferMany (Substitution.substInContext s1 cx) tl) (\result2 ->  +              let e2 = (fst result2)+              in  +                let t2 = (fst (snd result2))+                in  +                  let s2 = (snd (snd result2))+                  in (Flows.pure (Lists.cons (Substitution.substTypesInTerm s2 e1) e2, (Lists.cons (Substitution.substInType s2 t1) t2, (Substitution.composeTypeSubst s1 s2))))))))))++inferTypeOfAnnotatedTerm :: (Typing_.InferenceContext -> Core.AnnotatedTerm -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfAnnotatedTerm cx at =  +  let term = (Core.annotatedTermSubject at)+  in  +    let ann = (Core.annotatedTermAnnotation at)+    in (Flows.bind (inferTypeOfTerm cx term "annotated term") (\result ->  +      let iterm = (Typing_.inferenceResultTerm result)+      in  +        let itype = (Typing_.inferenceResultType result)+        in  +          let isubst = (Typing_.inferenceResultSubst result)+          in (Flows.pure (Typing_.InferenceResult {+            Typing_.inferenceResultTerm = (Core.TermAnnotated (Core.AnnotatedTerm {+              Core.annotatedTermSubject = iterm,+              Core.annotatedTermAnnotation = ann})),+            Typing_.inferenceResultType = itype,+            Typing_.inferenceResultSubst = isubst}))))++inferTypeOfApplication :: (Typing_.InferenceContext -> Core.Application -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfApplication cx app =  +  let e0 = (Core.applicationFunction app)+  in  +    let e1 = (Core.applicationArgument app)+    in (Flows.bind (inferTypeOfTerm cx e0 "lhs") (\lhsResult ->  +      let a = (Typing_.inferenceResultTerm lhsResult)+      in  +        let t0 = (Typing_.inferenceResultType lhsResult)+        in  +          let s0 = (Typing_.inferenceResultSubst lhsResult)+          in (Flows.bind (inferTypeOfTerm (Substitution.substInContext s0 cx) e1 "rhs") (\rhsResult ->  +            let b = (Typing_.inferenceResultTerm rhsResult)+            in  +              let t1 = (Typing_.inferenceResultType rhsResult)+              in  +                let s1 = (Typing_.inferenceResultSubst rhsResult)+                in (Flows.bind freshName (\v -> Flows.bind (Unification.unifyTypes (Typing_.inferenceContextSchemaTypes cx) (Substitution.substInType s1 t0) (Core.TypeFunction (Core.FunctionType {+                  Core.functionTypeDomain = t1,+                  Core.functionTypeCodomain = (Core.TypeVariable v)})) "application lhs") (\s2 ->  +                  let rExpr = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Substitution.substTypesInTerm (Substitution.composeTypeSubst s1 s2) a),+                          Core.applicationArgument = (Substitution.substTypesInTerm s2 b)}))+                  in  +                    let rType = (Substitution.substInType s2 (Core.TypeVariable v))+                    in  +                      let rSubst = (Substitution.composeTypeSubstList [+                              s0,+                              s1,+                              s2])+                      in (Flows.pure (Typing_.InferenceResult {+                        Typing_.inferenceResultTerm = rExpr,+                        Typing_.inferenceResultType = rType,+                        Typing_.inferenceResultSubst = rSubst})))))))))++inferTypeOfCaseStatement :: (Typing_.InferenceContext -> Core.CaseStatement -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfCaseStatement cx caseStmt =  +  let tname = (Core.caseStatementTypeName caseStmt)+  in  +    let dflt = (Core.caseStatementDefault caseStmt)+    in  +      let cases = (Core.caseStatementCases caseStmt)+      in  +        let fnames = (Lists.map Core.fieldName cases)+        in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +          let svars = (Core.typeSchemeVariables schemaType)+          in  +            let stype = (Core.typeSchemeType schemaType)+            in (Flows.bind (Core_.unionType tname stype) (\sfields -> Flows.bind (Flows.mapOptional (\t -> inferTypeOfTerm cx t (Strings.cat [+              "case ",+              Core.unName tname,+              ".<default>"])) dflt) (\dfltResult -> Flows.bind (inferMany cx (Lists.map (\f -> (Core.fieldTerm f, (Strings.cat [+              "case ",+              Core.unName tname,+              ".",+              (Core.unName (Core.fieldName f))]))) cases)) (\caseResults ->  +              let iterms = (fst caseResults)+              in  +                let itypes = (fst (snd caseResults))+                in  +                  let isubst = (snd (snd caseResults))+                  in (Flows.bind freshName (\codv ->  +                    let cod = (Core.TypeVariable codv)+                    in  +                      let caseMap = (Maps.fromList (Lists.map (\ft -> (Core.fieldTypeName ft, (Core.fieldTypeType ft))) sfields))+                      in  +                        let dfltConstraints = (Monads.optionalToList (Optionals.map (\r -> Typing_.TypeConstraint {+                                Typing_.typeConstraintLeft = cod,+                                Typing_.typeConstraintRight = (Typing_.inferenceResultType r),+                                Typing_.typeConstraintComment = "match default"}) dfltResult))+                        in  +                          let caseConstraints = (Optionals.cat (Lists.zipWith (\fname -> \itype -> Optionals.map (\ftype -> Typing_.TypeConstraint {+                                  Typing_.typeConstraintLeft = itype,+                                  Typing_.typeConstraintRight = (Core.TypeFunction (Core.FunctionType {+                                    Core.functionTypeDomain = ftype,+                                    Core.functionTypeCodomain = cod})),+                                  Typing_.typeConstraintComment = "case type"}) (Maps.lookup fname caseMap)) fnames itypes))+                          in (mapConstraints cx (\subst -> yield (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+                            Core.typedTermTerm = t,+                            Core.typedTermType = (Core.TypeVariable v)})) (Core.TermFunction (Core.FunctionElimination (Core.EliminationUnion (Core.CaseStatement {+                            Core.caseStatementTypeName = tname,+                            Core.caseStatementDefault = (Optionals.map Typing_.inferenceResultTerm dfltResult),+                            Core.caseStatementCases = (Lists.zipWith (\n -> \t -> Core.Field {+                              Core.fieldName = n,+                              Core.fieldTerm = t}) fnames iterms)})))) svars) (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)),+                            Core.functionTypeCodomain = cod})) (Substitution.composeTypeSubstList (Lists.concat [+                            Monads.optionalToList (Optionals.map Typing_.inferenceResultSubst dfltResult),+                            [+                              isubst,+                              subst]]))) (Lists.concat [+                            dfltConstraints,+                            caseConstraints]))))))))))++inferTypeOfCollection :: (Typing_.InferenceContext -> (Core.Type -> Core.Type) -> ([Core.Term] -> Core.Term) -> String -> [Core.Term] -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfCollection cx typCons trmCons desc els = (Flows.bind freshName (\var -> Logic.ifElse (Lists.null els) (Flows.pure (yield (Core.TermTypeApplication (Core.TypedTerm {+  Core.typedTermTerm = (trmCons []),+  Core.typedTermType = (Core.TypeVariable var)})) (typCons (Core.TypeVariable var)) Substitution.idTypeSubst)) (Flows.bind (inferMany cx (Lists.zip els (Lists.map (\i -> Strings.cat [+  "#",+  (Literals.showInt32 i)]) (Math.range 1 (Math.add (Lists.length els) 1))))) (\results ->  +  let terms = (fst results)+  in  +    let types = (fst (snd results))+    in  +      let subst1 = (snd (snd results))+      in  +        let constraints = (Lists.map (\t -> Typing_.TypeConstraint {+                Typing_.typeConstraintLeft = (Core.TypeVariable var),+                Typing_.typeConstraintRight = t,+                Typing_.typeConstraintComment = desc}) types)+        in (mapConstraints cx (\subst2 ->  +          let iterm = (trmCons terms)+          in  +            let itype = (typCons (Core.TypeVariable var))+            in  +              let isubst = (Substitution.composeTypeSubst subst1 subst2)+              in (yield iterm itype isubst)) constraints)))))++inferTypeOf :: (Typing_.InferenceContext -> Core.Term -> Compute.Flow t0 (Core.Term, Core.TypeScheme))+inferTypeOf cx term =  +  let letTerm = (Core.TermLet (Core.Let {+          Core.letBindings = [+            Core.Binding {+              Core.bindingName = (Core.Name "ignoredVariableName"),+              Core.bindingTerm = term,+              Core.bindingType = Nothing}],+          Core.letEnvironment = (Core.TermLiteral (Core.LiteralString "ignoredEnvironment"))}))+  in  +    let unifyAndSubst = (\result ->  +            let subst = (Typing_.inferenceResultSubst result)+            in (Flows.bind (Lexical.withEmptyGraph (Core_.letTerm (Rewriting.normalizeTypeVariablesInTerm (Typing_.inferenceResultTerm result)))) (\letResult ->  +              let bindings = (Core.letBindings letResult)+              in (Logic.ifElse (Equality.equal 1 (Lists.length bindings)) ( +                let binding = (Lists.head bindings)+                in  +                  let term1 = (Core.bindingTerm binding)+                  in  +                    let mts = (Core.bindingType binding)+                    in (Optionals.maybe (Flows.fail "Expected a type scheme") (\ts -> Flows.pure (term1, ts)) mts)) (Flows.fail (Strings.cat [+                "Expected a single binding with a type scheme, but got: ",+                Literals.showInt32 (Lists.length bindings),+                " bindings"]))))))+    in (Flows.bind (inferTypeOfTerm cx letTerm "infer type of term") (\result -> unifyAndSubst result))++inferTypeOfElimination :: (Typing_.InferenceContext -> Core.Elimination -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfElimination cx elm = ((\x -> case x of+  Core.EliminationProduct v1 -> (inferTypeOfTupleProjection cx v1)+  Core.EliminationRecord v1 -> (inferTypeOfProjection cx v1)+  Core.EliminationUnion v1 -> (inferTypeOfCaseStatement cx v1)+  Core.EliminationWrap v1 -> (inferTypeOfUnwrap cx v1)) elm)++inferTypeOfFunction :: (Typing_.InferenceContext -> Core.Function -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfFunction cx f = ((\x -> case x of+  Core.FunctionElimination v1 -> (inferTypeOfElimination cx v1)+  Core.FunctionLambda v1 -> (inferTypeOfLambda cx v1)+  Core.FunctionPrimitive v1 -> (inferTypeOfPrimitive cx v1)) f)++inferTypeOfInjection :: (Typing_.InferenceContext -> Core.Injection -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfInjection cx injection =  +  let tname = (Core.injectionTypeName injection)+  in  +    let field = (Core.injectionField injection)+    in  +      let fname = (Core.fieldName field)+      in  +        let term = (Core.fieldTerm field)+        in (Flows.bind (inferTypeOfTerm cx term "injected term") (\result -> Flows.bind (requireSchemaType cx tname) (\schemaType ->  +          let svars = (Core.typeSchemeVariables schemaType)+          in  +            let stype = (Core.typeSchemeType schemaType)+            in  +              let iterm = (Typing_.inferenceResultTerm result)+              in  +                let ityp = (Typing_.inferenceResultType result)+                in  +                  let isubst = (Typing_.inferenceResultSubst result)+                  in (Flows.bind (Core_.unionType tname stype) (\sfields -> Flows.bind (Schemas.findFieldType fname sfields) (\ftyp -> mapConstraints cx (\subst -> yield (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+                    Core.typedTermTerm = t,+                    Core.typedTermType = (Core.TypeVariable v)})) (Core.TermUnion (Core.Injection {+                    Core.injectionTypeName = tname,+                    Core.injectionField = Core.Field {+                      Core.fieldName = fname,+                      Core.fieldTerm = iterm}})) svars) (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)) (Substitution.composeTypeSubst isubst subst)) [+                    Typing_.TypeConstraint {+                      Typing_.typeConstraintLeft = ftyp,+                      Typing_.typeConstraintRight = ityp,+                      Typing_.typeConstraintComment = "schema type of injected field"}]))))))++inferTypeOfLambda :: (Typing_.InferenceContext -> Core.Lambda -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfLambda cx lambda =  +  let var = (Core.lambdaParameter lambda)+  in  +    let body = (Core.lambdaBody lambda)+    in (Flows.bind freshName (\vdom ->  +      let dom = (Core.TypeVariable vdom)+      in  +        let cx2 = (extendContext [+                (var, Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = dom})] cx)+        in (Flows.bind (inferTypeOfTerm cx2 body "lambda body") (\result ->  +          let iterm = (Typing_.inferenceResultTerm result)+          in  +            let icod = (Typing_.inferenceResultType result)+            in  +              let isubst = (Typing_.inferenceResultSubst result)+              in  +                let rdom = (Substitution.substInType isubst dom)+                in  +                  let rterm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = var,+                          Core.lambdaDomain = (Just rdom),+                          Core.lambdaBody = iterm})))+                  in  +                    let rtype = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = rdom,+                            Core.functionTypeCodomain = icod}))+                    in  +                      let vars = (Sets.unions [+                              Rewriting.freeVariablesInType rdom,+                              Rewriting.freeVariablesInType icod,+                              (freeVariablesInContext (Substitution.substInContext isubst cx2))])+                      in  +                        let cx3 = (Substitution.substInContext isubst cx)+                        in (Flows.pure (Typing_.InferenceResult {+                          Typing_.inferenceResultTerm = rterm,+                          Typing_.inferenceResultType = rtype,+                          Typing_.inferenceResultSubst = isubst}))))))++inferTypeOfLetNormalized :: (Typing_.InferenceContext -> Core.Let -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfLetNormalized cx0 letTerm =  +  let bins0 = (Core.letBindings letTerm)+  in  +    let env0 = (Core.letEnvironment letTerm)+    in  +      let bnames = (Lists.map Core.bindingName bins0)+      in (Flows.bind (freshNames (Lists.length bins0)) (\bvars ->  +        let tbins0 = (Lists.map (\x -> Core.TypeVariable x) bvars)+        in  +          let cx1 = (extendContext (Lists.zip bnames (Lists.map (\t -> Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = t}) tbins0)) cx0)+          in (Flows.bind (inferTypesOfTemporaryBindings cx1 bins0) (\inferredResult ->  +            let bterms1 = (fst inferredResult)+            in  +              let tbins1 = (fst (snd inferredResult))+              in  +                let s1 = (snd (snd inferredResult))+                in (Flows.bind (Unification.unifyTypeLists (Typing_.inferenceContextSchemaTypes cx0) (Lists.map (Substitution.substInType s1) tbins0) tbins1 "temporary type bindings") (\s2 ->  +                  let g2 = (Substitution.substInContext (Substitution.composeTypeSubst s1 s2) cx0)+                  in  +                    let tsbins1 = (Lists.zip bnames (Lists.map (\t -> generalize g2 (Substitution.substInType s2 t)) tbins1))+                    in (Flows.bind (inferTypeOfTerm (extendContext tsbins1 g2) env0 "let environment") (\envResult ->  +                      let env1 = (Typing_.inferenceResultTerm envResult)+                      in  +                        let tenv = (Typing_.inferenceResultType envResult)+                        in  +                          let senv = (Typing_.inferenceResultSubst envResult)+                          in  +                            let st1 = (Typing_.TermSubst (Maps.fromList (Lists.map (\pair ->  +                                    let name = (fst pair)+                                    in  +                                      let ts = (snd pair)+                                      in (name, (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+                                        Core.typedTermTerm = t,+                                        Core.typedTermType = (Core.TypeVariable v)})) (Core.TermVariable name) (Lists.reverse (Core.typeSchemeVariables ts))))) tsbins1)))+                            in  +                              let createBinding = (\bindingPair ->  +                                      let nameTsPair = (fst bindingPair)+                                      in  +                                        let term = (snd bindingPair)+                                        in  +                                          let name = (fst nameTsPair)+                                          in  +                                            let ts = (snd nameTsPair)+                                            in  +                                              let typeAbstractedTerm = (Lists.foldl (\b -> \v -> Core.TermTypeLambda (Core.TypeLambda {+                                                      Core.typeLambdaParameter = v,+                                                      Core.typeLambdaBody = b})) (Substitution.substituteInTerm st1 term) (Lists.reverse (Core.typeSchemeVariables ts)))+                                              in Core.Binding {+                                                Core.bindingName = name,+                                                Core.bindingTerm = (Substitution.substTypesInTerm (Substitution.composeTypeSubst senv s2) typeAbstractedTerm),+                                                Core.bindingType = (Just (Substitution.substInTypeScheme senv ts))})+                              in  +                                let bins1 = (Lists.map createBinding (Lists.zip tsbins1 bterms1))+                                in  +                                  let ret = Typing_.InferenceResult {+                                          Typing_.inferenceResultTerm = (Core.TermLet (Core.Let {+                                            Core.letBindings = bins1,+                                            Core.letEnvironment = env1})),+                                          Typing_.inferenceResultType = tenv,+                                          Typing_.inferenceResultSubst = (Substitution.composeTypeSubstList [+                                            s1,+                                            s2,+                                            senv])}+                                  in (Flows.pure ret)))))))))++inferTypeOfLet :: (Typing_.InferenceContext -> Core.Let -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfLet cx let0 =  +  let bindings0 = (Core.letBindings let0)+  in  +    let env0 = (Core.letEnvironment let0)+    in  +      let names = (Lists.map Core.bindingName bindings0)+      in  +        let nameSet = (Sets.fromList names)+        in  +          let toPair = (\binding ->  +                  let name = (Core.bindingName binding)+                  in  +                    let term = (Core.bindingTerm binding)+                    in (name, (Lists.filter (\n -> Sets.member n nameSet) (Sets.toList (Rewriting.freeVariablesInTerm term)))))+          in  +            let adjList = (Lists.map toPair bindings0)+            in  +              let groups = (Sorting.topologicalSortComponents adjList)+              in  +                let bindingMap = (Maps.fromList (Lists.zip names bindings0))+                in  +                  let createLet = (\e -> \group -> Core.TermLet (Core.Let {+                          Core.letBindings = (Optionals.cat (Lists.map (\n -> Maps.lookup n bindingMap) group)),+                          Core.letEnvironment = e}))+                  in  +                    let rewrittenLet = (Lists.foldl createLet env0 (Lists.reverse groups))+                    in  +                      let restoreLet = (\iterm ->  +                              let helper = (\level -> \bins -> \term -> Logic.ifElse (Equality.equal level 0) (bins, term) ((\x -> case x of+                                      Core.TermLet v1 ->  +                                        let bs = (Core.letBindings v1)+                                        in  +                                          let e = (Core.letEnvironment v1)+                                          in (helper (Math.sub level 1) (Lists.concat [+                                            bs,+                                            bins]) e)) term))+                              in  +                                let result = (helper (Lists.length groups) [] iterm)+                                in  +                                  let bindingList = (fst result)+                                  in  +                                    let e = (snd result)+                                    in  +                                      let bindingMap2 = (Maps.fromList (Lists.map (\b -> (Core.bindingName b, b)) bindingList))+                                      in (Core.TermLet (Core.Let {+                                        Core.letBindings = (Optionals.cat (Lists.map (\n -> Maps.lookup n bindingMap2) names)),+                                        Core.letEnvironment = e})))+                      in  +                        let rewriteResult = (\result ->  +                                let iterm = (Typing_.inferenceResultTerm result)+                                in  +                                  let itype = (Typing_.inferenceResultType result)+                                  in  +                                    let isubst = (Typing_.inferenceResultSubst result)+                                    in Typing_.InferenceResult {+                                      Typing_.inferenceResultTerm = (restoreLet iterm),+                                      Typing_.inferenceResultType = itype,+                                      Typing_.inferenceResultSubst = isubst})+                        in (Flows.map rewriteResult ((\x -> case x of+                          Core.TermLet v1 -> (inferTypeOfLetNormalized cx v1)+                          _ -> (inferTypeOfTerm cx rewrittenLet "empty let term")) rewrittenLet))++inferTypeOfList :: (Typing_.InferenceContext -> [Core.Term] -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfList cx = (inferTypeOfCollection cx (\x -> Core.TypeList x) (\x -> Core.TermList x) "list element")++inferTypeOfLiteral :: (t0 -> Core.Literal -> Compute.Flow t1 Typing_.InferenceResult)+inferTypeOfLiteral _ lit = (Flows.pure (Typing_.InferenceResult {+  Typing_.inferenceResultTerm = (Core.TermLiteral lit),+  Typing_.inferenceResultType = (Core.TypeLiteral (Variants.literalType lit)),+  Typing_.inferenceResultSubst = Substitution.idTypeSubst}))++inferTypeOfMap :: (Typing_.InferenceContext -> M.Map Core.Term Core.Term -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfMap cx m = (Flows.bind freshName (\kvar -> Flows.bind freshName (\vvar -> Logic.ifElse (Maps.null m) (Flows.pure (yield (Core.TermTypeApplication (Core.TypedTerm {+  Core.typedTermTerm = (Core.TermTypeApplication (Core.TypedTerm {+    Core.typedTermTerm = (Core.TermMap Maps.empty),+    Core.typedTermType = (Core.TypeVariable vvar)})),+  Core.typedTermType = (Core.TypeVariable kvar)})) (Core.TypeMap (Core.MapType {+  Core.mapTypeKeys = (Core.TypeVariable kvar),+  Core.mapTypeValues = (Core.TypeVariable vvar)})) Substitution.idTypeSubst)) (Flows.bind (inferMany cx (Lists.map (\k -> (k, "map key")) (Maps.keys m))) (\kresults ->  +  let kterms = (fst kresults)+  in  +    let ktypes = (fst (snd kresults))+    in  +      let ksubst = (snd (snd kresults))+      in (Flows.bind (inferMany cx (Lists.map (\v -> (v, "map value")) (Maps.elems m))) (\vresults ->  +        let vterms = (fst vresults)+        in  +          let vtypes = (fst (snd vresults))+          in  +            let vsubst = (snd (snd vresults))+            in  +              let kcons = (Lists.map (\t -> Typing_.TypeConstraint {+                      Typing_.typeConstraintLeft = (Core.TypeVariable kvar),+                      Typing_.typeConstraintRight = t,+                      Typing_.typeConstraintComment = "map key"}) ktypes)+              in  +                let vcons = (Lists.map (\t -> Typing_.TypeConstraint {+                        Typing_.typeConstraintLeft = (Core.TypeVariable vvar),+                        Typing_.typeConstraintRight = t,+                        Typing_.typeConstraintComment = "map value"}) vtypes)+                in (mapConstraints cx (\subst -> yield (Core.TermMap (Maps.fromList (Lists.zip kterms vterms))) (Core.TypeMap (Core.MapType {+                  Core.mapTypeKeys = (Core.TypeVariable kvar),+                  Core.mapTypeValues = (Core.TypeVariable vvar)})) (Substitution.composeTypeSubstList [+                  ksubst,+                  vsubst,+                  subst])) (Lists.concat [+                  kcons,+                  vcons])))))))))++inferTypeOfOptional :: (Typing_.InferenceContext -> Maybe Core.Term -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfOptional cx m =  +  let trmCons = (\terms -> Logic.ifElse (Lists.null terms) (Core.TermOptional Nothing) (Core.TermOptional (Just (Lists.head terms))))+  in (inferTypeOfCollection cx (\x -> Core.TypeOptional x) trmCons "optional element" (Optionals.maybe [] Lists.singleton m))++inferTypeOfPrimitive :: (Typing_.InferenceContext -> Core.Name -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfPrimitive cx name = (Optionals.maybe (Flows.fail (Strings.cat2 "No such primitive: " (Core.unName name))) (\scheme -> Flows.bind (instantiateTypeScheme scheme) (\ts ->  +  let vars = (Core.typeSchemeVariables ts)+  in  +    let itype = (Core.typeSchemeType ts)+    in  +      let iterm = (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+              Core.typedTermTerm = t,+              Core.typedTermType = (Core.TypeVariable v)})) (Core.TermFunction (Core.FunctionPrimitive name)) vars)+      in (yieldChecked cx vars iterm itype Substitution.idTypeSubst))) (Maps.lookup name (Typing_.inferenceContextPrimitiveTypes cx)))++inferTypeOfProduct :: (Typing_.InferenceContext -> [Core.Term] -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfProduct cx els = (Flows.map (\results ->  +  let iterms = (fst results)+  in  +    let itypes = (fst (snd results))+    in  +      let isubst = (snd (snd results))+      in (yield (Core.TermProduct iterms) (Core.TypeProduct itypes) isubst)) (inferMany cx (Lists.map (\e -> (e, "tuple element")) els)))++inferTypeOfProjection :: (Typing_.InferenceContext -> Core.Projection -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfProjection cx proj =  +  let tname = (Core.projectionTypeName proj)+  in  +    let fname = (Core.projectionField proj)+    in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +      let svars = (Core.typeSchemeVariables schemaType)+      in  +        let stype = (Core.typeSchemeType schemaType)+        in (Flows.bind (Core_.recordType tname stype) (\sfields -> Flows.bind (Schemas.findFieldType fname sfields) (\ftyp -> Flows.pure (yield (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+          Core.typedTermTerm = t,+          Core.typedTermType = (Core.TypeVariable v)})) (Core.TermFunction (Core.FunctionElimination (Core.EliminationRecord (Core.Projection {+          Core.projectionTypeName = tname,+          Core.projectionField = fname})))) svars) (Core.TypeFunction (Core.FunctionType {+          Core.functionTypeDomain = (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)),+          Core.functionTypeCodomain = ftyp})) Substitution.idTypeSubst))))))++inferTypeOfRecord :: (Typing_.InferenceContext -> Core.Record -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfRecord cx record =  +  let tname = (Core.recordTypeName record)+  in  +    let fields = (Core.recordFields record)+    in  +      let fnames = (Lists.map Core.fieldName fields)+      in (Flows.bind (requireSchemaType cx tname) (\schemaType -> Flows.bind (inferMany cx (Lists.map (\f -> (Core.fieldTerm f, (Strings.cat2 "field " (Core.unName (Core.fieldName f))))) fields)) (\results ->  +        let svars = (Core.typeSchemeVariables schemaType)+        in  +          let stype = (Core.typeSchemeType schemaType)+          in  +            let iterms = (fst results)+            in  +              let itypes = (fst (snd results))+              in  +                let isubst = (snd (snd results))+                in  +                  let ityp = (Core.TypeRecord (Core.RowType {+                          Core.rowTypeTypeName = tname,+                          Core.rowTypeFields = (Lists.zipWith (\n -> \t -> Core.FieldType {+                            Core.fieldTypeName = n,+                            Core.fieldTypeType = t}) fnames itypes)}))+                  in (mapConstraints cx (\subst -> yield (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+                    Core.typedTermTerm = t,+                    Core.typedTermType = (Core.TypeVariable v)})) (Core.TermRecord (Core.Record {+                    Core.recordTypeName = tname,+                    Core.recordFields = (Lists.zipWith (\n -> \t -> Core.Field {+                      Core.fieldName = n,+                      Core.fieldTerm = t}) fnames iterms)})) svars) (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)) (Substitution.composeTypeSubst isubst subst)) [+                    Typing_.TypeConstraint {+                      Typing_.typeConstraintLeft = stype,+                      Typing_.typeConstraintRight = ityp,+                      Typing_.typeConstraintComment = "schema type of record"}]))))++inferTypeOfSet :: (Typing_.InferenceContext -> S.Set Core.Term -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfSet cx s = (inferTypeOfCollection cx (\x -> Core.TypeSet x) (\terms -> Core.TermSet (Sets.fromList terms)) "set element" (Sets.toList s))++inferTypeOfSum :: (Typing_.InferenceContext -> Core.Sum -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfSum cx sum =  +  let i = (Core.sumIndex sum)+  in  +    let s = (Core.sumSize sum)+    in  +      let term = (Core.sumTerm sum)+      in (Flows.bind (inferTypeOfTerm cx term "sum term") (\result ->  +        let iterm = (Typing_.inferenceResultTerm result)+        in  +          let ityp = (Typing_.inferenceResultType result)+          in  +            let isubst = (Typing_.inferenceResultSubst result)+            in  +              let varOrTerm = (\t -> \j -> Logic.ifElse (Equality.equal i j) (Flows.pure (Mantle.EitherLeft t)) (Flows.map (\x -> Mantle.EitherRight x) freshName))+              in (Flows.bind (Flows.mapList (varOrTerm ityp) (Math.range 0 (Math.sub s 1))) (\vars ->  +                let toType = (\e -> (\x -> case x of+                        Mantle.EitherLeft v1 -> v1+                        Mantle.EitherRight v1 -> (Core.TypeVariable v1)) e)+                in (Flows.pure (yield (Core.TermSum (Core.Sum {+                  Core.sumIndex = i,+                  Core.sumSize = s,+                  Core.sumTerm = iterm})) (Core.TypeSum (Lists.map toType vars)) isubst))))))++inferTypeOfTerm :: (Typing_.InferenceContext -> Core.Term -> String -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfTerm cx term desc = (Monads.withTrace desc ((\x -> case x of+  Core.TermAnnotated v1 -> (inferTypeOfAnnotatedTerm cx v1)+  Core.TermApplication v1 -> (inferTypeOfApplication cx v1)+  Core.TermFunction v1 -> (inferTypeOfFunction cx v1)+  Core.TermLet v1 -> (inferTypeOfLet cx v1)+  Core.TermList v1 -> (inferTypeOfList cx v1)+  Core.TermLiteral v1 -> (inferTypeOfLiteral cx v1)+  Core.TermMap v1 -> (inferTypeOfMap cx v1)+  Core.TermOptional v1 -> (inferTypeOfOptional cx v1)+  Core.TermProduct v1 -> (inferTypeOfProduct cx v1)+  Core.TermRecord v1 -> (inferTypeOfRecord cx v1)+  Core.TermSet v1 -> (inferTypeOfSet cx v1)+  Core.TermSum v1 -> (inferTypeOfSum cx v1)+  Core.TermTypeLambda v1 -> (inferTypeOfTypeLambda cx v1)+  Core.TermTypeApplication v1 -> (inferTypeOfTypeApplication cx v1)+  Core.TermUnion v1 -> (inferTypeOfInjection cx v1)+  Core.TermUnit -> (Flows.pure inferTypeOfUnit)+  Core.TermVariable v1 -> (inferTypeOfVariable cx v1)+  Core.TermWrap v1 -> (inferTypeOfWrappedTerm cx v1)) term))++inferTypeOfTupleProjection :: (t0 -> Core.TupleProjection -> Compute.Flow t1 Typing_.InferenceResult)+inferTypeOfTupleProjection cx tp =  +  let arity = (Core.tupleProjectionArity tp)+  in  +    let idx = (Core.tupleProjectionIndex tp)+    in (Flows.bind (freshNames arity) (\vars ->  +      let types = (Lists.map (\x -> Core.TypeVariable x) vars)+      in  +        let cod = (Lists.at idx types)+        in (Flows.pure (yield (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+          Core.tupleProjectionArity = arity,+          Core.tupleProjectionIndex = idx,+          Core.tupleProjectionDomain = (Just types)})))) (Core.TypeFunction (Core.FunctionType {+          Core.functionTypeDomain = (Core.TypeProduct types),+          Core.functionTypeCodomain = cod})) Substitution.idTypeSubst))))++inferTypeOfTypeLambda :: (Typing_.InferenceContext -> Core.TypeLambda -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfTypeLambda cx ta = (inferTypeOfTerm cx (Core.typeLambdaBody ta) "type abstraction")++inferTypeOfTypeApplication :: (Typing_.InferenceContext -> Core.TypedTerm -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfTypeApplication cx tt = (inferTypeOfTerm cx (Core.typedTermTerm tt) "type application term")++inferTypeOfUnwrap :: (Typing_.InferenceContext -> Core.Name -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfUnwrap cx tname = (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +  let svars = (Core.typeSchemeVariables schemaType)+  in  +    let stype = (Core.typeSchemeType schemaType)+    in (Flows.bind (Core_.wrappedType tname stype) (\wtyp -> Flows.pure (yield (Lists.foldl (\t -> \v -> Core.TermTypeApplication (Core.TypedTerm {+      Core.typedTermTerm = t,+      Core.typedTermType = (Core.TypeVariable v)})) (Core.TermFunction (Core.FunctionElimination (Core.EliminationWrap tname))) svars) (Core.TypeFunction (Core.FunctionType {+      Core.functionTypeDomain = (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) svars)),+      Core.functionTypeCodomain = wtyp})) Substitution.idTypeSubst)))))++inferTypeOfVariable :: (Typing_.InferenceContext -> Core.Name -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfVariable cx name = (Optionals.maybe (Flows.fail (Strings.cat2 "Variable not bound to type: " (Core.unName name))) (\scheme -> Flows.bind (instantiateTypeScheme scheme) (\ts ->  +  let vars = (Core.typeSchemeVariables ts)+  in  +    let itype = (Core.typeSchemeType ts)+    in  +      let iterm = (Lists.foldl (\t -> \ty -> Core.TermTypeApplication (Core.TypedTerm {+              Core.typedTermTerm = t,+              Core.typedTermType = ty})) (Core.TermVariable name) (Lists.map (\x -> Core.TypeVariable x) vars))+      in (Flows.pure (Typing_.InferenceResult {+        Typing_.inferenceResultTerm = iterm,+        Typing_.inferenceResultType = itype,+        Typing_.inferenceResultSubst = Substitution.idTypeSubst})))) (Maps.lookup name (Typing_.inferenceContextDataTypes cx)))++inferTypeOfWrappedTerm :: (Typing_.InferenceContext -> Core.WrappedTerm -> Compute.Flow t0 Typing_.InferenceResult)+inferTypeOfWrappedTerm cx wt =  +  let tname = (Core.wrappedTermTypeName wt)+  in  +    let term = (Core.wrappedTermObject wt)+    in (Flows.bind (requireSchemaType cx tname) (\schemaType -> Flows.bind (inferTypeOfTerm cx term "wrapped term") (\result ->  +      let svars = (Core.typeSchemeVariables schemaType)+      in  +        let stype = (Core.typeSchemeType schemaType)+        in  +          let iterm = (Typing_.inferenceResultTerm result)+          in  +            let ityp = (Typing_.inferenceResultType result)+            in  +              let isubst = (Typing_.inferenceResultSubst result)+              in (Flows.bind (freshNames (Lists.length svars)) (\freshVars ->  +                let subst = (Typing_.TypeSubst (Maps.fromList (Lists.zip svars (Lists.map (\x -> Core.TypeVariable x) freshVars))))+                in  +                  let stypInst = (Substitution.substInType subst stype)+                  in  +                    let nominalInst = (nominalApplication tname (Lists.map (\x -> Core.TypeVariable x) freshVars))+                    in  +                      let expected = (Core.TypeWrap (Core.WrappedType {+                              Core.wrappedTypeTypeName = tname,+                              Core.wrappedTypeObject = ityp}))+                      in  +                        let freeVars = (Sets.toList (Sets.unions [+                                Rewriting.freeVariablesInType ityp,+                                Rewriting.freeVariablesInTerm iterm,+                                (Sets.fromList freshVars)]))+                        in (bindConstraints cx (\subst2 -> yieldChecked cx freeVars (Core.TermWrap (Core.WrappedTerm {+                          Core.wrappedTermTypeName = tname,+                          Core.wrappedTermObject = iterm})) nominalInst (Substitution.composeTypeSubst isubst subst2)) [+                          Typing_.TypeConstraint {+                            Typing_.typeConstraintLeft = stypInst,+                            Typing_.typeConstraintRight = expected,+                            Typing_.typeConstraintComment = "schema type of wrapper"}]))))))++inferTypesOfTemporaryBindings :: (Typing_.InferenceContext -> [Core.Binding] -> Compute.Flow t0 ([Core.Term], ([Core.Type], Typing_.TypeSubst)))+inferTypesOfTemporaryBindings cx bins = (Logic.ifElse (Lists.null bins) (Flows.pure ([], ([], Substitution.idTypeSubst))) ( +  let binding = (Lists.head bins)+  in  +    let k = (Core.bindingName binding)+    in  +      let v = (Core.bindingTerm binding)+      in  +        let tl = (Lists.tail bins)+        in (Flows.bind (inferTypeOfTerm cx v (Strings.cat [+          "temporary let binding '",+          Core.unName k,+          "'"])) (\result1 ->  +          let j = (Typing_.inferenceResultTerm result1)+          in  +            let u_prime = (Typing_.inferenceResultType result1)+            in  +              let u = (Typing_.inferenceResultSubst result1)+              in (Flows.bind (inferTypesOfTemporaryBindings (Substitution.substInContext u cx) tl) (\result2 ->  +                let h = (fst result2)+                in  +                  let r_prime = (fst (snd result2))+                  in  +                    let r = (snd (snd result2))+                    in (Flows.pure (Lists.cons (Substitution.substTypesInTerm r j) h, (Lists.cons (Substitution.substInType r u_prime) r_prime, (Substitution.composeTypeSubst u r))))))))))++initialTypeContext :: (Graph.Graph -> Compute.Flow t0 Typing_.TypeContext)+initialTypeContext g =  +  let toPair = (\pair ->  +          let name = (fst pair)+          in  +            let el = (snd pair)+            in (Optionals.maybe (Flows.fail (Strings.cat [+              "untyped element: ",+              (Core.unName name)])) (\ts -> Flows.pure (name, (Schemas.typeSchemeToFType ts))) (Core.bindingType el)))+  in (Flows.bind (graphToInferenceContext g) (\ix -> Flows.bind (Flows.map Maps.fromList (Flows.mapList toPair (Maps.toList (Graph.graphElements g)))) (\types -> Flows.pure (Typing_.TypeContext {+    Typing_.typeContextTypes = types,+    Typing_.typeContextVariables = Sets.empty,+    Typing_.typeContextInferenceContext = ix}))))++instantiateTypeScheme :: (Core.TypeScheme -> Compute.Flow t0 Core.TypeScheme)+instantiateTypeScheme scheme =  +  let oldVars = (Core.typeSchemeVariables scheme)+  in (Flows.bind (freshNames (Lists.length oldVars)) (\newVars ->  +    let subst = (Typing_.TypeSubst (Maps.fromList (Lists.zip oldVars (Lists.map (\x -> Core.TypeVariable x) newVars))))+    in (Flows.pure (Core.TypeScheme {+      Core.typeSchemeVariables = newVars,+      Core.typeSchemeType = (Substitution.substInType subst (Core.typeSchemeType scheme))}))))++-- | Check if a variable is unbound in context+isUnbound :: (Typing_.InferenceContext -> Core.Name -> Bool)+isUnbound cx v = (Logic.and (Logic.not (Sets.member v (freeVariablesInContext cx))) (Logic.not (Maps.member v (Typing_.inferenceContextSchemaTypes cx))))++-- | Key for inference type variable count+key_vcount :: Core.Name+key_vcount = (Core.Name "inferenceTypeVariableCount")++mapConstraints :: (Typing_.InferenceContext -> (Typing_.TypeSubst -> t0) -> [Typing_.TypeConstraint] -> Compute.Flow t1 t0)+mapConstraints cx f constraints = (Flows.map f (Unification.unifyTypeConstraints (Typing_.inferenceContextSchemaTypes cx) constraints))++-- | Apply type arguments to a nominal type+nominalApplication :: (Core.Name -> [Core.Type] -> Core.Type)+nominalApplication tname args = (Lists.foldl (\t -> \a -> Core.TypeApplication (Core.ApplicationType {+  Core.applicationTypeFunction = t,+  Core.applicationTypeArgument = a})) (Core.TypeVariable tname) args)++-- | Type variable naming convention follows Haskell: t0, t1, etc.+normalTypeVariable :: (Int -> Core.Name)+normalTypeVariable i = (Core.Name (Strings.cat2 "t" (Literals.showInt32 i)))++requireSchemaType :: (Typing_.InferenceContext -> Core.Name -> Compute.Flow t0 Core.TypeScheme)+requireSchemaType cx tname = (Optionals.maybe (Flows.fail (Strings.cat2 "No such schema type: " (Core.unName tname))) (\ts -> instantiateTypeScheme (Rewriting.deannotateTypeSchemeRecursive ts)) (Maps.lookup tname (Typing_.inferenceContextSchemaTypes cx)))++-- | Show an inference result for debugging+showInferenceResult :: (Typing_.InferenceResult -> String)+showInferenceResult result =  +  let term = (Typing_.inferenceResultTerm result)+  in  +    let typ = (Typing_.inferenceResultType result)+    in  +      let subst = (Typing_.inferenceResultSubst result)+      in (Strings.cat [+        "{term=",+        Core__.term term,+        ", type=",+        Core__.type_ typ,+        ", subst=",+        Typing.typeSubst subst,+        "}"])++-- | Convert inference context to type context+toFContext :: (Typing_.InferenceContext -> M.Map Core.Name Core.Type)+toFContext cx = (Maps.map Schemas.typeSchemeToFType (Typing_.inferenceContextDataTypes cx))++typeOf :: (Typing_.TypeContext -> Core.Term -> Compute.Flow t0 Core.Type)+typeOf tcontext term = (typeOfInternal (Typing_.typeContextInferenceContext tcontext) (Typing_.typeContextVariables tcontext) (Typing_.typeContextTypes tcontext) [] term)++typeOfInternal :: (Typing_.InferenceContext -> S.Set Core.Name -> M.Map Core.Name Core.Type -> [Core.Type] -> Core.Term -> Compute.Flow t0 Core.Type)+typeOfInternal cx vars types apptypes term =  +  let checkApplied = (\e -> Logic.ifElse (Lists.null apptypes) e ( +          let app = (\t -> \apptypes -> Logic.ifElse (Lists.null apptypes) (Flows.pure t) ((\x -> case x of+                  Core.TypeForall v1 ->  +                    let v = (Core.forallTypeParameter v1)+                    in  +                      let t2 = (Core.forallTypeBody v1)+                      in (app (Substitution.substInType (Typing_.TypeSubst (Maps.singleton v (Lists.head apptypes))) t2) (Lists.tail apptypes))+                  _ -> (Flows.fail (Strings.cat [+                    "not a forall type: ",+                    Core__.type_ t,+                    " in ",+                    (Core__.term term)]))) t))+          in (Flows.bind (typeOfInternal cx vars types [] term) (\t1 -> Flows.bind (checkTypeVariables cx vars t1) (\_ -> app t1 apptypes)))))+  in (Monads.withTrace (Strings.cat [+    "checking type of: ",+    Core__.term term,+    " (vars: ",+    Formatting.showList Core.unName (Sets.toList vars),+    ", types: ",+    Formatting.showList Core.unName (Maps.keys types),+    ")"]) ((\x -> case x of+    Core.TermAnnotated v1 -> (checkApplied ( +      let term1 = (Core.annotatedTermSubject v1)+      in (typeOfInternal cx vars types apptypes term1)))+    Core.TermApplication v1 -> (checkApplied ( +      let a = (Core.applicationFunction v1)+      in  +        let b = (Core.applicationArgument v1)+        in (Flows.bind (typeOfInternal cx vars types [] a) (\t1 -> Flows.bind (typeOfInternal cx vars types [] b) (\t2 -> Flows.bind (checkTypeVariables cx vars t1) (\_ -> Flows.bind (checkTypeVariables cx vars t2) (\_ -> (\x -> case x of+          Core.TypeFunction v2 ->  +            let p = (Core.functionTypeDomain v2)+            in  +              let q = (Core.functionTypeCodomain v2)+              in (Logic.ifElse (Equality.equal p t2) (Flows.pure q) (Flows.fail (Strings.cat [+                "expected ",+                Core__.type_ p,+                " in ",+                Core__.term term,+                " but found ",+                (Core__.type_ t2)])))+          _ -> (Flows.fail (Strings.cat [+            "left hand side of application ",+            Core__.term term,+            " is not a function type: ",+            (Core__.type_ t1)]))) t1)))))))+    Core.TermFunction v1 -> ((\x -> case x of+      Core.FunctionElimination v2 -> ((\x -> case x of+        Core.EliminationProduct v3 -> (checkApplied ( +          let index = (Core.tupleProjectionIndex v3)+          in  +            let arity = (Core.tupleProjectionArity v3)+            in  +              let mtypes = (Core.tupleProjectionDomain v3)+              in (Optionals.maybe (Flows.fail (Strings.cat [+                "untyped tuple projection: ",+                (Core__.term term)])) (\types -> Flows.bind (Flows.mapList (checkTypeVariables cx vars) types) (\_ -> Flows.pure (Core.TypeFunction (Core.FunctionType {+                Core.functionTypeDomain = (Core.TypeProduct types),+                Core.functionTypeCodomain = (Lists.at index types)})))) mtypes)))+        Core.EliminationRecord v3 ->  +          let tname = (Core.projectionTypeName v3)+          in  +            let fname = (Core.projectionField v3)+            in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +              let svars = (Core.typeSchemeVariables schemaType)+              in  +                let stype = (Core.typeSchemeType schemaType)+                in (Flows.bind (Core_.recordType tname stype) (\sfields -> Flows.bind (Schemas.findFieldType fname sfields) (\ftyp ->  +                  let subst = (Typing_.TypeSubst (Maps.fromList (Lists.zip svars apptypes)))+                  in  +                    let sftyp = (Substitution.substInType subst ftyp)+                    in (Flows.pure (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (nominalApplication tname apptypes),+                      Core.functionTypeCodomain = sftyp}))))))))+        Core.EliminationUnion v3 ->  +          let tname = (Core.caseStatementTypeName v3)+          in  +            let dflt = (Core.caseStatementDefault v3)+            in  +              let cases = (Core.caseStatementCases v3)+              in  +                let cterms = (Lists.map Core.fieldTerm cases)+                in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +                  let svars = (Core.typeSchemeVariables schemaType)+                  in  +                    let stype = (Core.typeSchemeType schemaType)+                    in (Flows.bind (Core_.unionType tname stype) (\sfields -> Flows.bind (Flows.mapOptional (\e -> typeOfInternal cx vars types [] e) dflt) (\tdflt -> Flows.bind (Flows.mapList (\e -> typeOfInternal cx vars types [] e) cterms) (\tcterms -> Flows.bind (Flows.mapList (\t -> Flows.map Core.functionTypeCodomain (Core_.functionType t)) tcterms) (\cods ->  +                      let ts = (Optionals.cat (Lists.cons tdflt (Lists.map Optionals.pure cods)))+                      in (Flows.bind (checkSameType "case branches" ts) (\cod ->  +                        let subst = (Typing_.TypeSubst (Maps.fromList (Lists.zip svars apptypes)))+                        in  +                          let scod = (Substitution.substInType subst cod)+                          in (Flows.pure (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (nominalApplication tname apptypes),+                            Core.functionTypeCodomain = scod}))))))))))))+        Core.EliminationWrap v3 -> (Flows.bind (requireSchemaType cx v3) (\schemaType ->  +          let svars = (Core.typeSchemeVariables schemaType)+          in  +            let stype = (Core.typeSchemeType schemaType)+            in (Flows.bind (Core_.wrappedType v3 stype) (\wrapped ->  +              let subst = (Typing_.TypeSubst (Maps.fromList (Lists.zip svars apptypes)))+              in  +                let swrapped = (Substitution.substInType subst wrapped)+                in (Flows.pure (Core.TypeFunction (Core.FunctionType {+                  Core.functionTypeDomain = (nominalApplication v3 apptypes),+                  Core.functionTypeCodomain = swrapped})))))))) v2)+      Core.FunctionLambda v2 -> (checkApplied ( +        let x = (Core.lambdaParameter v2)+        in  +          let mt = (Core.lambdaDomain v2)+          in  +            let e = (Core.lambdaBody v2)+            in (Optionals.maybe (Flows.fail (Strings.cat [+              "untyped lambda: ",+              (Core__.term term)])) (\t -> Flows.bind (checkTypeVariables cx vars t) (\_ -> Flows.bind (typeOfInternal cx vars (Maps.insert x t types) [] e) (\t1 -> Flows.bind (checkTypeVariables cx vars t1) (\_ -> Flows.pure (Core.TypeFunction (Core.FunctionType {+              Core.functionTypeDomain = t,+              Core.functionTypeCodomain = t1})))))) mt)))+      Core.FunctionPrimitive v2 -> (checkApplied ( +        let ts = (Optionals.maybe (Flows.fail (Strings.cat [+                "no such primitive: ",+                (Core.unName v2)])) Flows.pure (Maps.lookup v2 (Typing_.inferenceContextPrimitiveTypes cx)))+        in (Flows.map Schemas.typeSchemeToFType ts)))) v1)+    Core.TermLet v1 -> (checkApplied ( +      let bs = (Core.letBindings v1)+      in  +        let env = (Core.letEnvironment v1)+        in  +          let bnames = (Lists.map Core.bindingName bs)+          in  +            let bterms = (Lists.map Core.bindingTerm bs)+            in  +              let btypeOf = (\b -> Optionals.maybe (Flows.fail (Strings.cat [+                      "untyped let binding in ",+                      (Core__.term term)])) (\ts -> Flows.pure (Schemas.typeSchemeToFType ts)) (Core.bindingType b))+              in (Flows.bind (Flows.mapList btypeOf bs) (\btypes ->  +                let types2 = (Maps.union (Maps.fromList (Lists.zip bnames btypes)) types)+                in (Flows.bind (Flows.mapList (typeOfInternal cx vars types2 []) bterms) (\typeofs -> Flows.bind (Flows.mapList (checkTypeVariables cx vars) btypes) (\_ -> Flows.bind (Flows.mapList (checkTypeVariables cx vars) typeofs) (\_ -> Logic.ifElse (Equality.equal typeofs btypes) (typeOfInternal cx vars types2 [] env) (Flows.fail (Strings.cat [+                  "binding types disagree: ",+                  Formatting.showList Core__.type_ btypes,+                  " and ",+                  Formatting.showList Core__.type_ typeofs,+                  " from terms: ",+                  (Formatting.showList Core__.term bterms)]))))))))))+    Core.TermList v1 -> (Logic.ifElse (Lists.null v1) (Logic.ifElse (Equality.equal (Lists.length apptypes) 1) (Flows.pure (Core.TypeList (Lists.head apptypes))) (Flows.fail "list type applied to more or less than one argument")) (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) v1) (\eltypes -> Flows.bind (checkSameType "list elements" eltypes) (\unifiedType -> Flows.bind (checkTypeVariables cx vars unifiedType) (\_ -> Flows.pure (Core.TypeList unifiedType))))))+    Core.TermLiteral v1 -> (checkApplied (Flows.pure (Core.TypeLiteral (Variants.literalType v1))))+    Core.TermMap v1 -> (Logic.ifElse (Maps.null v1) (Logic.ifElse (Equality.equal (Lists.length apptypes) 2) (Flows.pure (Core.TypeMap (Core.MapType {+      Core.mapTypeKeys = (Lists.at 1 apptypes),+      Core.mapTypeValues = (Lists.at 0 apptypes)}))) (Flows.fail "map type applied to more or less than two arguments")) (checkApplied ( +      let pairs = (Maps.toList v1)+      in (Flows.bind (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) (Lists.map fst pairs)) (checkSameType "map keys")) (\kt -> Flows.bind (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) (Lists.map snd pairs)) (checkSameType "map values")) (\vt -> Flows.bind (checkTypeVariables cx vars kt) (\_ -> Flows.bind (checkTypeVariables cx vars vt) (\_ -> Flows.pure (Core.TypeMap (Core.MapType {+        Core.mapTypeKeys = kt,+        Core.mapTypeValues = vt}))))))))))+    Core.TermOptional v1 -> (Optionals.maybe (Logic.ifElse (Equality.equal (Lists.length apptypes) 1) (Flows.pure (Core.TypeOptional (Lists.head apptypes))) (Flows.fail "optional type applied to more or less than one argument")) (\term -> checkApplied (Flows.bind (typeOfInternal cx vars types [] term) (\termType -> Flows.bind (checkTypeVariables cx vars termType) (\_ -> Flows.pure (Core.TypeOptional termType))))) v1)+    Core.TermProduct v1 -> (checkApplied (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) v1) (\etypes -> Flows.bind (Flows.mapList (checkTypeVariables cx vars) etypes) (\_ -> Flows.pure (Core.TypeProduct etypes)))))+    Core.TermRecord v1 ->  +      let tname = (Core.recordTypeName v1)+      in  +        let fields = (Core.recordFields v1)+        in (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) (Lists.map Core.fieldTerm fields)) (\ftypes -> Flows.bind (Flows.mapList (checkTypeVariables cx vars) ftypes) (\_ -> typeOfNominal "record typeOf" cx tname (Core.TypeRecord (Core.RowType {+          Core.rowTypeTypeName = tname,+          Core.rowTypeFields = (Lists.zipWith (\n -> \t -> Core.FieldType {+            Core.fieldTypeName = n,+            Core.fieldTypeType = t}) (Lists.map Core.fieldName fields) ftypes)})))))+    Core.TermSet v1 -> (Logic.ifElse (Sets.null v1) (Logic.ifElse (Equality.equal (Lists.length apptypes) 1) (Flows.pure (Core.TypeSet (Lists.head apptypes))) (Flows.fail "set type applied to more or less than one argument")) (Flows.bind (Flows.mapList (typeOfInternal cx vars types []) (Sets.toList v1)) (\eltypes -> Flows.bind (checkSameType "set elements" eltypes) (\unifiedType -> Flows.bind (checkTypeVariables cx vars unifiedType) (\_ -> Flows.pure (Core.TypeSet unifiedType))))))+    Core.TermTypeLambda v1 ->  +      let v = (Core.typeLambdaParameter v1)+      in  +        let e = (Core.typeLambdaBody v1)+        in (Flows.bind (typeOfInternal cx (Sets.insert v vars) types [] e) (\t1 -> Flows.bind (checkTypeVariables cx (Sets.insert v vars) t1) (\_ -> Flows.pure (Core.TypeForall (Core.ForallType {+          Core.forallTypeParameter = v,+          Core.forallTypeBody = t1})))))+    Core.TermTypeApplication v1 ->  +      let e = (Core.typedTermTerm v1)+      in  +        let t = (Core.typedTermType v1)+        in (typeOfInternal cx vars types (Lists.cons t apptypes) e)+    Core.TermUnion v1 ->  +      let tname = (Core.injectionTypeName v1)+      in  +        let field = (Core.injectionField v1)+        in  +          let fname = (Core.fieldName field)+          in  +            let fterm = (Core.fieldTerm field)+            in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +              let svars = (Core.typeSchemeVariables schemaType)+              in  +                let stype = (Core.typeSchemeType schemaType)+                in (Flows.bind (Core_.unionType tname stype) (\sfields -> Flows.bind (Schemas.findFieldType fname sfields) (\ftyp -> Flows.pure (nominalApplication tname apptypes))))))+    Core.TermUnit -> (checkApplied (Flows.pure Core.TypeUnit))+    Core.TermVariable v1 -> (checkApplied (Optionals.maybe (Flows.fail (Strings.cat [+      "unbound variable: ",+      (Core.unName v1)])) Flows.pure (Maps.lookup v1 types)))+    Core.TermWrap v1 ->  +      let tname = (Core.wrappedTermTypeName v1)+      in  +        let innerTerm = (Core.wrappedTermObject v1)+        in (Flows.bind (typeOfInternal cx vars types [] innerTerm) (\innerType -> Flows.bind (checkTypeVariables cx vars innerType) (\_ -> typeOfNominal "wrapper typeOf" cx tname (Core.TypeWrap (Core.WrappedType {+          Core.wrappedTypeTypeName = tname,+          Core.wrappedTypeObject = innerType})))))+    _ -> (Flows.fail (Strings.cat [+      "unsupported term variant in typeOf: ",+      (Mantle_.termVariant (Variants.termVariant term))]))) term))++typeOfNominal :: (String -> Typing_.InferenceContext -> Core.Name -> Core.Type -> Compute.Flow t0 Core.Type)+typeOfNominal desc cx tname expected =  +  let resolveType = (\subst -> \v -> Optionals.fromMaybe (Core.TypeVariable v) (Maps.lookup v subst))+  in (Flows.bind (requireSchemaType cx tname) (\schemaType ->  +    let svars = (Core.typeSchemeVariables schemaType)+    in  +      let stype = (Core.typeSchemeType schemaType)+      in (Flows.bind (Unification.unifyTypes (Typing_.inferenceContextSchemaTypes cx) stype expected desc) (\substWrapper ->  +        let subst = (Typing_.unTypeSubst substWrapper)+        in  +          let tparams = (Lists.map (resolveType subst) svars)+          in (Flows.pure (nominalApplication tname tparams))))))++-- | The trivial inference result for the unit term+inferTypeOfUnit :: Typing_.InferenceResult+inferTypeOfUnit = Typing_.InferenceResult {+  Typing_.inferenceResultTerm = Core.TermUnit,+  Typing_.inferenceResultType = Core.TypeUnit,+  Typing_.inferenceResultSubst = Substitution.idTypeSubst}++-- | Create an inference result+yield :: (Core.Term -> Core.Type -> Typing_.TypeSubst -> Typing_.InferenceResult)+yield term typ subst = Typing_.InferenceResult {+  Typing_.inferenceResultTerm = (Substitution.substTypesInTerm subst term),+  Typing_.inferenceResultType = (Substitution.substInType subst typ),+  Typing_.inferenceResultSubst = subst}++yieldChecked :: (t0 -> t1 -> Core.Term -> Core.Type -> Typing_.TypeSubst -> Compute.Flow t2 Typing_.InferenceResult)+yieldChecked cx vars term typ subst =  +  let iterm = (Substitution.substTypesInTerm subst term)+  in  +    let itype = (Substitution.substInType subst typ)+    in (Flows.pure (Typing_.InferenceResult {+      Typing_.inferenceResultTerm = iterm,+      Typing_.inferenceResultType = itype,+      Typing_.inferenceResultSubst = subst}))++yieldDebug :: (t0 -> t1 -> Core.Term -> Core.Type -> Typing_.TypeSubst -> Compute.Flow t2 Typing_.InferenceResult)+yieldDebug cx debugId term typ subst =  +  let rterm = (Substitution.substTypesInTerm subst term)+  in  +    let rtyp = (Substitution.substInType subst typ)+    in (Flows.bind (Annotations.debugIf debugId (Strings.cat [+      "\n\tterm: ",+      Core__.term term,+      "\n\ttyp: ",+      Core__.type_ typ,+      "\n\tsubst: ",+      Typing.typeSubst subst,+      "\n\trterm: ",+      Core__.term rterm,+      "\n\trtyp: ",+      (Core__.type_ rtyp)])) (\result -> Flows.pure (Typing_.InferenceResult {+      Typing_.inferenceResultTerm = rterm,+      Typing_.inferenceResultType = rtyp,+      Typing_.inferenceResultSubst = subst})))
src/gen-main/haskell/Hydra/Json.hs view
@@ -3,10 +3,11 @@ module Hydra.Json where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | A JSON value data Value = @@ -19,12 +20,12 @@   -- | A numeric value   ValueNumber Double |   -- | A JSON object as a set of key/value pairs-  ValueObject (Map String Value) |+  ValueObject (M.Map String Value) |   -- | A string value   ValueString String   deriving (Eq, Ord, Read, Show) -_Value = (Core.Name "hydra/json.Value")+_Value = (Core.Name "hydra.json.Value")  _Value_array = (Core.Name "array")
+ src/gen-main/haskell/Hydra/Languages.hs view
@@ -0,0 +1,37 @@+-- | Language constraints for Hydra Core++module Hydra.Languages where++import qualified Hydra.Coders as Coders+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Language constraints for Hydra Core, i.e. no constraints.+hydraLanguage :: Coders.Language+hydraLanguage = Coders.Language {+  Coders.languageName = (Coders.LanguageName "hydra.core"),+  Coders.languageConstraints = Coders.LanguageConstraints {+    Coders.languageConstraintsEliminationVariants = eliminationVariants,+    Coders.languageConstraintsLiteralVariants = literalVariants,+    Coders.languageConstraintsFloatTypes = floatTypes,+    Coders.languageConstraintsFunctionVariants = functionVariants,+    Coders.languageConstraintsIntegerTypes = integerTypes,+    Coders.languageConstraintsTermVariants = termVariants,+    Coders.languageConstraintsTypeVariants = typeVariants,+    Coders.languageConstraintsTypes = types}} +  where +    eliminationVariants = (Sets.fromList Variants.eliminationVariants)+    literalVariants = (Sets.fromList Variants.literalVariants)+    floatTypes = (Sets.fromList Variants.floatTypes)+    functionVariants = (Sets.fromList Variants.functionVariants)+    integerTypes = (Sets.fromList Variants.integerTypes)+    termVariants = (Sets.fromList Variants.termVariants)+    typeVariants = (Sets.fromList Variants.typeVariants)+    types = (\t -> (\x -> case x of+      _ -> True) t)
+ src/gen-main/haskell/Hydra/Lexical.hs view
@@ -0,0 +1,180 @@+-- | A module for lexical operations over graphs.++module Hydra.Lexical where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Strings as Strings+import qualified Hydra.Monads as Monads+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core_+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++dereferenceElement :: (Core.Name -> Compute.Flow Graph.Graph (Maybe Core.Binding))+dereferenceElement name = (Flows.map (\g -> lookupElement g name) Monads.getState)++elementsToGraph :: (Graph.Graph -> Maybe Graph.Graph -> [Core.Binding] -> Graph.Graph)+elementsToGraph parent schema elements =  +  let toPair = (\el -> (Core.bindingName el, el))+  in Graph.Graph {+    Graph.graphElements = (Maps.fromList (Lists.map toPair elements)),+    Graph.graphEnvironment = (Graph.graphEnvironment parent),+    Graph.graphTypes = (Graph.graphTypes parent),+    Graph.graphBody = (Graph.graphBody parent),+    Graph.graphPrimitives = (Graph.graphPrimitives parent),+    Graph.graphSchema = schema}++-- | An empty graph; no elements, no primitives, no schema, and an arbitrary body.+emptyGraph :: Graph.Graph+emptyGraph = Graph.Graph {+  Graph.graphElements = Maps.empty,+  Graph.graphEnvironment = Maps.empty,+  Graph.graphTypes = Maps.empty,+  Graph.graphBody = (Core.TermLiteral (Core.LiteralString "empty graph")),+  Graph.graphPrimitives = Maps.empty,+  Graph.graphSchema = Nothing}++extendGraphWithBindings :: ([Core.Binding] -> Graph.Graph -> Graph.Graph)+extendGraphWithBindings bindings g =  +  let newEls = (Maps.fromList (Lists.map toEl bindings)) +      toEl = (\binding ->  +              let name = (Core.bindingName binding) +                  term = (Core.bindingTerm binding)+                  mts = (Core.bindingType binding)+              in (name, Core.Binding {+                Core.bindingName = name,+                Core.bindingTerm = term,+                Core.bindingType = mts}))+  in Graph.Graph {+    Graph.graphElements = (Maps.union newEls (Graph.graphElements g)),+    Graph.graphEnvironment = (Graph.graphEnvironment g),+    Graph.graphTypes = (Graph.graphTypes g),+    Graph.graphBody = (Graph.graphBody g),+    Graph.graphPrimitives = (Graph.graphPrimitives g),+    Graph.graphSchema = (Graph.graphSchema g)}++fieldsOf :: (Core.Type -> [Core.FieldType])+fieldsOf t =  +  let stripped = (Rewriting.deannotateType t)+  in ((\x -> case x of+    Core.TypeForall v1 -> (fieldsOf (Core.forallTypeBody v1))+    Core.TypeRecord v1 -> (Core.rowTypeFields v1)+    Core.TypeUnion v1 -> (Core.rowTypeFields v1)+    _ -> []) stripped)++getField :: (M.Map Core.Name t0 -> Core.Name -> (t0 -> Compute.Flow t1 t2) -> Compute.Flow t1 t2)+getField m fname decode = (Optionals.maybe (Flows.fail (Strings.cat [+  Strings.cat [+    "expected field ",+    (Core.unName fname)],+  " not found"])) decode (Maps.lookup fname m))++lookupElement :: (Graph.Graph -> Core.Name -> Maybe Core.Binding)+lookupElement g name = (Maps.lookup name (Graph.graphElements g))++lookupPrimitive :: (Graph.Graph -> Core.Name -> Maybe Graph.Primitive)+lookupPrimitive g name = (Maps.lookup name (Graph.graphPrimitives g))++matchEnum :: (Core.Name -> [(Core.Name, t0)] -> Core.Term -> Compute.Flow Graph.Graph t0)+matchEnum tname pairs = (matchUnion tname (Lists.map (\pair -> matchUnitField (fst pair) (snd pair)) pairs))++matchRecord :: ((M.Map Core.Name Core.Term -> Compute.Flow t0 t1) -> Core.Term -> Compute.Flow t0 t1)+matchRecord decode term =  +  let stripped = (Rewriting.deannotateAndDetypeTerm term)+  in ((\x -> case x of+    Core.TermRecord v1 -> (decode (Maps.fromList (Lists.map (\field -> (Core.fieldName field, (Core.fieldTerm field))) (Core.recordFields v1))))+    _ -> (Monads.unexpected "record" (Core_.term term))) stripped)++matchUnion :: (Core.Name -> [(Core.Name, (Core.Term -> Compute.Flow Graph.Graph t0))] -> Core.Term -> Compute.Flow Graph.Graph t0)+matchUnion tname pairs term =  +  let stripped = (Rewriting.deannotateAndDetypeTerm term) +      mapping = (Maps.fromList pairs)+  in ((\x -> case x of+    Core.TermVariable v1 -> (Flows.bind (requireElement v1) (\el -> matchUnion tname pairs (Core.bindingTerm el)))+    Core.TermUnion v1 -> (Logic.ifElse (Equality.equal (Core.unName (Core.injectionTypeName v1)) (Core.unName tname)) ( +      let fname = (Core.fieldName (Core.injectionField v1)) +          val = (Core.fieldTerm (Core.injectionField v1))+      in (Optionals.maybe (Flows.fail (Strings.cat [+        Strings.cat [+          Strings.cat [+            "no matching case for field ",+            (Core.unName fname)],+          " in union type "],+        (Core.unName tname)])) (\f -> f val) (Maps.lookup fname mapping))) (Monads.unexpected (Strings.cat [+      "injection for type ",+      (Core.unName tname)]) (Core_.term term)))+    _ -> (Monads.unexpected (Strings.cat [+      Strings.cat [+        "union with one of {",+        (Strings.intercalate ", " (Lists.map (\pair -> Core.unName (fst pair)) pairs))],+      "}"]) (Core_.term stripped))) stripped)++matchUnitField :: (t0 -> t1 -> (t0, (t2 -> Compute.Flow t3 t1)))+matchUnitField fname x = (fname, (\ignored -> Flows.pure x))++requireElement :: (Core.Name -> Compute.Flow Graph.Graph Core.Binding)+requireElement name =  +  let showAll = False +      ellipsis = (\strings -> Logic.ifElse (Logic.and (Equality.gt (Lists.length strings) 3) (Logic.not showAll)) (Lists.concat2 (Lists.take 3 strings) [+              "..."]) strings)+      err = (\g -> Flows.fail (Strings.cat [+              Strings.cat [+                Strings.cat [+                  Strings.cat [+                    "no such element: ",+                    (Core.unName name)],+                  ". Available elements: {"],+                (Strings.intercalate ", " (ellipsis (Lists.map (\el -> Core.unName (Core.bindingName el)) (Maps.elems (Graph.graphElements g)))))],+              "}"]))+  in (Flows.bind (dereferenceElement name) (\mel -> Optionals.maybe (Flows.bind Monads.getState err) Flows.pure mel))++requirePrimitive :: (Core.Name -> Compute.Flow Graph.Graph Graph.Primitive)+requirePrimitive name = (Flows.bind Monads.getState (\g -> Optionals.maybe (Flows.fail (Strings.cat [+  "no such primitive function: ",+  (Core.unName name)])) Flows.pure (lookupPrimitive g name)))++requireTerm :: (Core.Name -> Compute.Flow Graph.Graph Core.Term)+requireTerm name = (Flows.bind (resolveTerm name) (\mt -> Optionals.maybe (Flows.fail (Strings.cat [+  "no such element: ",+  (Core.unName name)])) Flows.pure mt))++-- | TODO: distinguish between lambda-bound and let-bound variables+resolveTerm :: (Core.Name -> Compute.Flow Graph.Graph (Maybe Core.Term))+resolveTerm name =  +  let recurse = (\el ->  +          let stripped = (Rewriting.deannotateTerm (Core.bindingTerm el))+          in ((\x -> case x of+            Core.TermVariable v1 -> (resolveTerm v1)+            _ -> (Flows.pure (Just (Core.bindingTerm el)))) stripped))+  in (Flows.bind Monads.getState (\g -> Optionals.maybe (Flows.pure Nothing) recurse (Maps.lookup name (Graph.graphElements g))))++-- | Note: assuming for now that primitive functions are the same in the schema graph+schemaContext :: (Graph.Graph -> Graph.Graph)+schemaContext g = (Optionals.fromMaybe g (Graph.graphSchema g))++stripAndDereferenceTerm :: (Core.Term -> Compute.Flow Graph.Graph Core.Term)+stripAndDereferenceTerm term =  +  let stripped = (Rewriting.deannotateAndDetypeTerm term)+  in ((\x -> case x of+    Core.TermVariable v1 -> (Flows.bind (requireTerm v1) (\t -> stripAndDereferenceTerm t))+    _ -> (Flows.pure stripped)) stripped)++typeOfPrimitive :: (Core.Name -> Compute.Flow Graph.Graph Core.TypeScheme)+typeOfPrimitive name = (Flows.map Graph.primitiveType (requirePrimitive name))++withEmptyGraph :: (Compute.Flow Graph.Graph t0 -> Compute.Flow t1 t0)+withEmptyGraph = (Monads.withState emptyGraph)++withSchemaContext :: (Compute.Flow Graph.Graph t0 -> Compute.Flow Graph.Graph t0)+withSchemaContext f = (Flows.bind Monads.getState (\g -> Monads.withState (schemaContext g) f))
+ src/gen-main/haskell/Hydra/Literals.hs view
@@ -0,0 +1,51 @@+-- | Conversion functions for literal values.++module Hydra.Literals where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Literals as Literals+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Convert a bigfloat to a floating-point value of a given type (note: lossy)+bigfloatToFloatValue :: (Core.FloatType -> Double -> Core.FloatValue)+bigfloatToFloatValue ft bf = ((\x -> case x of+  Core.FloatTypeBigfloat -> (Core.FloatValueBigfloat bf)+  Core.FloatTypeFloat32 -> (Core.FloatValueFloat32 (Literals.bigfloatToFloat32 bf))+  Core.FloatTypeFloat64 -> (Core.FloatValueFloat64 (Literals.bigfloatToFloat64 bf))) ft)++-- | Convert a bigint to an integer value of a given type (note: lossy)+bigintToIntegerValue :: (Core.IntegerType -> Integer -> Core.IntegerValue)+bigintToIntegerValue it bi = ((\x -> case x of+  Core.IntegerTypeBigint -> (Core.IntegerValueBigint bi)+  Core.IntegerTypeInt8 -> (Core.IntegerValueInt8 (Literals.bigintToInt8 bi))+  Core.IntegerTypeInt16 -> (Core.IntegerValueInt16 (Literals.bigintToInt16 bi))+  Core.IntegerTypeInt32 -> (Core.IntegerValueInt32 (Literals.bigintToInt32 bi))+  Core.IntegerTypeInt64 -> (Core.IntegerValueInt64 (Literals.bigintToInt64 bi))+  Core.IntegerTypeUint8 -> (Core.IntegerValueUint8 (Literals.bigintToUint8 bi))+  Core.IntegerTypeUint16 -> (Core.IntegerValueUint16 (Literals.bigintToUint16 bi))+  Core.IntegerTypeUint32 -> (Core.IntegerValueUint32 (Literals.bigintToUint32 bi))+  Core.IntegerTypeUint64 -> (Core.IntegerValueUint64 (Literals.bigintToUint64 bi))) it)++-- | Convert a floating-point value of any precision to a bigfloat+floatValueToBigfloat :: (Core.FloatValue -> Double)+floatValueToBigfloat x = case x of+  Core.FloatValueBigfloat v1 -> v1+  Core.FloatValueFloat32 v1 -> (Literals.float32ToBigfloat v1)+  Core.FloatValueFloat64 v1 -> (Literals.float64ToBigfloat v1)++-- | Convert an integer value of any precision to a bigint+integerValueToBigint :: (Core.IntegerValue -> Integer)+integerValueToBigint x = case x of+  Core.IntegerValueBigint v1 -> v1+  Core.IntegerValueInt8 v1 -> (Literals.int8ToBigint v1)+  Core.IntegerValueInt16 v1 -> (Literals.int16ToBigint v1)+  Core.IntegerValueInt32 v1 -> (Literals.int32ToBigint v1)+  Core.IntegerValueInt64 v1 -> (Literals.int64ToBigint v1)+  Core.IntegerValueUint8 v1 -> (Literals.uint8ToBigint v1)+  Core.IntegerValueUint16 v1 -> (Literals.uint16ToBigint v1)+  Core.IntegerValueUint32 v1 -> (Literals.uint32ToBigint v1)+  Core.IntegerValueUint64 v1 -> (Literals.uint64ToBigint v1)
src/gen-main/haskell/Hydra/Mantle.hs view
@@ -1,20 +1,53 @@--- | A set of types which supplement hydra/core with variants and accessors+-- | A set of types which supplement hydra.core, but are not referenced by hydra.core.  module Hydra.Mantle where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S +data CaseConvention = +  CaseConventionCamel  |+  CaseConventionPascal  |+  CaseConventionLowerSnake  |+  CaseConventionUpperSnake +  deriving (Eq, Ord, Read, Show)++_CaseConvention = (Core.Name "hydra.mantle.CaseConvention")++_CaseConvention_camel = (Core.Name "camel")++_CaseConvention_pascal = (Core.Name "pascal")++_CaseConvention_lowerSnake = (Core.Name "lowerSnake")++_CaseConvention_upperSnake = (Core.Name "upperSnake")++-- | An equality judgement: less than, equal to, or greater than+data Comparison = +  ComparisonLessThan  |+  ComparisonEqualTo  |+  ComparisonGreaterThan +  deriving (Eq, Ord, Read, Show)++_Comparison = (Core.Name "hydra.mantle.Comparison")++_Comparison_lessThan = (Core.Name "lessThan")++_Comparison_equalTo = (Core.Name "equalTo")++_Comparison_greaterThan = (Core.Name "greaterThan")+ -- | A disjoint union between a 'left' type and a 'right' type-data Either_ a b = +data Either a b =    EitherLeft a |   EitherRight b   deriving (Eq, Ord, Read, Show) -_Either = (Core.Name "hydra/mantle.Either")+_Either = (Core.Name "hydra.mantle.Either")  _Either_left = (Core.Name "left") @@ -22,19 +55,13 @@  -- | The identifier of an elimination constructor data EliminationVariant = -  EliminationVariantList  |-  EliminationVariantOptional  |   EliminationVariantProduct  |   EliminationVariantRecord  |   EliminationVariantUnion  |   EliminationVariantWrap    deriving (Eq, Ord, Read, Show) -_EliminationVariant = (Core.Name "hydra/mantle.EliminationVariant")--_EliminationVariant_list = (Core.Name "list")--_EliminationVariant_optional = (Core.Name "optional")+_EliminationVariant = (Core.Name "hydra.mantle.EliminationVariant")  _EliminationVariant_product = (Core.Name "product") @@ -51,7 +78,7 @@   FunctionVariantPrimitive    deriving (Eq, Ord, Read, Show) -_FunctionVariant = (Core.Name "hydra/mantle.FunctionVariant")+_FunctionVariant = (Core.Name "hydra.mantle.FunctionVariant")  _FunctionVariant_elimination = (Core.Name "elimination") @@ -68,7 +95,7 @@   LiteralVariantString    deriving (Eq, Ord, Read, Show) -_LiteralVariant = (Core.Name "hydra/mantle.LiteralVariant")+_LiteralVariant = (Core.Name "hydra.mantle.LiteralVariant")  _LiteralVariant_binary = (Core.Name "binary") @@ -86,90 +113,12 @@   PrecisionBits Int   deriving (Eq, Ord, Read, Show) -_Precision = (Core.Name "hydra/mantle.Precision")+_Precision = (Core.Name "hydra.mantle.Precision")  _Precision_arbitrary = (Core.Name "arbitrary")  _Precision_bits = (Core.Name "bits") --- | A function which maps from a term to a particular immediate subterm-data TermAccessor = -  TermAccessorAnnotatedSubject  |-  TermAccessorApplicationFunction  |-  TermAccessorApplicationArgument  |-  TermAccessorLambdaBody  |-  TermAccessorListFold  |-  TermAccessorOptionalCasesNothing  |-  TermAccessorOptionalCasesJust  |-  TermAccessorUnionCasesDefault  |-  TermAccessorUnionCasesBranch Core.Name |-  TermAccessorLetEnvironment  |-  TermAccessorLetBinding Core.Name |-  TermAccessorListElement Int |-  TermAccessorMapKey Int |-  TermAccessorMapValue Int |-  TermAccessorOptionalTerm  |-  TermAccessorProductTerm Int |-  TermAccessorRecordField Core.Name |-  TermAccessorSetElement Int |-  TermAccessorSumTerm  |-  TermAccessorTypeAbstractionBody  |-  TermAccessorTypeApplicationTerm  |-  TermAccessorTypedTerm  |-  TermAccessorInjectionTerm  |-  TermAccessorWrappedTerm -  deriving (Eq, Ord, Read, Show)--_TermAccessor = (Core.Name "hydra/mantle.TermAccessor")--_TermAccessor_annotatedSubject = (Core.Name "annotatedSubject")--_TermAccessor_applicationFunction = (Core.Name "applicationFunction")--_TermAccessor_applicationArgument = (Core.Name "applicationArgument")--_TermAccessor_lambdaBody = (Core.Name "lambdaBody")--_TermAccessor_listFold = (Core.Name "listFold")--_TermAccessor_optionalCasesNothing = (Core.Name "optionalCasesNothing")--_TermAccessor_optionalCasesJust = (Core.Name "optionalCasesJust")--_TermAccessor_unionCasesDefault = (Core.Name "unionCasesDefault")--_TermAccessor_unionCasesBranch = (Core.Name "unionCasesBranch")--_TermAccessor_letEnvironment = (Core.Name "letEnvironment")--_TermAccessor_letBinding = (Core.Name "letBinding")--_TermAccessor_listElement = (Core.Name "listElement")--_TermAccessor_mapKey = (Core.Name "mapKey")--_TermAccessor_mapValue = (Core.Name "mapValue")--_TermAccessor_optionalTerm = (Core.Name "optionalTerm")--_TermAccessor_productTerm = (Core.Name "productTerm")--_TermAccessor_recordField = (Core.Name "recordField")--_TermAccessor_setElement = (Core.Name "setElement")--_TermAccessor_sumTerm = (Core.Name "sumTerm")--_TermAccessor_typeAbstractionBody = (Core.Name "typeAbstractionBody")--_TermAccessor_typeApplicationTerm = (Core.Name "typeApplicationTerm")--_TermAccessor_typedTerm = (Core.Name "typedTerm")--_TermAccessor_injectionTerm = (Core.Name "injectionTerm")--_TermAccessor_wrappedTerm = (Core.Name "wrappedTerm")- -- | The identifier of a term expression constructor data TermVariant =    TermVariantAnnotated  |@@ -184,15 +133,15 @@   TermVariantRecord  |   TermVariantSet  |   TermVariantSum  |-  TermVariantTypeAbstraction  |   TermVariantTypeApplication  |-  TermVariantTyped  |+  TermVariantTypeLambda  |   TermVariantUnion  |+  TermVariantUnit  |   TermVariantVariable  |   TermVariantWrap    deriving (Eq, Ord, Read, Show) -_TermVariant = (Core.Name "hydra/mantle.TermVariant")+_TermVariant = (Core.Name "hydra.mantle.TermVariant")  _TermVariant_annotated = (Core.Name "annotated") @@ -218,40 +167,36 @@  _TermVariant_sum = (Core.Name "sum") -_TermVariant_typeAbstraction = (Core.Name "typeAbstraction")- _TermVariant_typeApplication = (Core.Name "typeApplication") -_TermVariant_typed = (Core.Name "typed")+_TermVariant_typeLambda = (Core.Name "typeLambda")  _TermVariant_union = (Core.Name "union") +_TermVariant_unit = (Core.Name "unit")+ _TermVariant_variable = (Core.Name "variable")  _TermVariant_wrap = (Core.Name "wrap") --- | An assertion that two types can be unified into a single type-data TypeConstraint = -  TypeConstraint {-    typeConstraintLeft :: Core.Type,-    typeConstraintRight :: Core.Type,-    typeConstraintContext :: (Maybe String)}+-- | Any of a small number of built-in type classes+data TypeClass = +  TypeClassEquality  |+  TypeClassOrdering    deriving (Eq, Ord, Read, Show) -_TypeConstraint = (Core.Name "hydra/mantle.TypeConstraint")--_TypeConstraint_left = (Core.Name "left")+_TypeClass = (Core.Name "hydra.mantle.TypeClass") -_TypeConstraint_right = (Core.Name "right")+_TypeClass_equality = (Core.Name "equality") -_TypeConstraint_context = (Core.Name "context")+_TypeClass_ordering = (Core.Name "ordering")  -- | The identifier of a type constructor data TypeVariant =    TypeVariantAnnotated  |   TypeVariantApplication  |+  TypeVariantForall  |   TypeVariantFunction  |-  TypeVariantLambda  |   TypeVariantList  |   TypeVariantLiteral  |   TypeVariantMap  |@@ -261,19 +206,20 @@   TypeVariantSet  |   TypeVariantSum  |   TypeVariantUnion  |+  TypeVariantUnit  |   TypeVariantVariable  |   TypeVariantWrap    deriving (Eq, Ord, Read, Show) -_TypeVariant = (Core.Name "hydra/mantle.TypeVariant")+_TypeVariant = (Core.Name "hydra.mantle.TypeVariant")  _TypeVariant_annotated = (Core.Name "annotated")  _TypeVariant_application = (Core.Name "application") -_TypeVariant_function = (Core.Name "function")+_TypeVariant_forall = (Core.Name "forall") -_TypeVariant_lambda = (Core.Name "lambda")+_TypeVariant_function = (Core.Name "function")  _TypeVariant_list = (Core.Name "list") @@ -292,6 +238,8 @@ _TypeVariant_sum = (Core.Name "sum")  _TypeVariant_union = (Core.Name "union")++_TypeVariant_unit = (Core.Name "unit")  _TypeVariant_variable = (Core.Name "variable")
− src/gen-main/haskell/Hydra/Messages.hs 
@@ -1,11 +0,0 @@--- | A collection of standard error and warning messages--module Hydra.Messages where--import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--warningAutoGeneratedFile :: String-warningAutoGeneratedFile = "Note: this is an automatically generated file. Do not edit."
src/gen-main/haskell/Hydra/Module.hs view
@@ -1,20 +1,34 @@--- | A model for Hydra namespaces and modules (collections of elements in the same namespace)+-- | A model for Hydra namespaces and modules  module Hydra.Module where  import qualified Hydra.Core as Core import qualified Hydra.Graph as Graph-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S +-- | A definition, which may be either a term or type definition+data Definition = +  DefinitionTerm TermDefinition |+  DefinitionType TypeDefinition+  deriving (Eq, Ord, Read, Show)++_Definition = (Core.Name "hydra.module.Definition")++_Definition_term = (Core.Name "term")++_Definition_type = (Core.Name "type")++-- | A file extension (without the dot), e.g. "json" or "py" newtype FileExtension =    FileExtension {     unFileExtension :: String}   deriving (Eq, Ord, Read, Show) -_FileExtension = (Core.Name "hydra/module.FileExtension")+_FileExtension = (Core.Name "hydra.module.FileExtension")  -- | A library of primitive functions data Library = @@ -26,7 +40,7 @@     -- | The primitives defined in this library     libraryPrimitives :: [Graph.Primitive]} -_Library = (Core.Name "hydra/module.Library")+_Library = (Core.Name "hydra.module.Library")  _Library_namespace = (Core.Name "namespace") @@ -40,7 +54,7 @@     -- | A common prefix for all element names in the module     moduleNamespace :: Namespace,     -- | The elements defined in this module-    moduleElements :: [Graph.Element],+    moduleElements :: [Core.Binding],     -- | Any modules which the term expressions of this module directly depend upon     moduleTermDependencies :: [Module],     -- | Any modules which the type expressions of this module directly depend upon@@ -49,7 +63,7 @@     moduleDescription :: (Maybe String)}   deriving (Eq, Ord, Read, Show) -_Module = (Core.Name "hydra/module.Module")+_Module = (Core.Name "hydra.module.Module")  _Module_namespace = (Core.Name "namespace") @@ -67,8 +81,21 @@     unNamespace :: String}   deriving (Eq, Ord, Read, Show) -_Namespace = (Core.Name "hydra/module.Namespace")+_Namespace = (Core.Name "hydra.module.Namespace") +-- | A mapping from namespaces to values of type n, with a focus on one namespace+data Namespaces n = +  Namespaces {+    namespacesFocus :: (Namespace, n),+    namespacesMapping :: (M.Map Namespace n)}+  deriving (Eq, Ord, Read, Show)++_Namespaces = (Core.Name "hydra.module.Namespaces")++_Namespaces_focus = (Core.Name "focus")++_Namespaces_mapping = (Core.Name "mapping")+ -- | A qualified name consisting of an optional namespace together with a mandatory local name data QualifiedName =    QualifiedName {@@ -76,8 +103,37 @@     qualifiedNameLocal :: String}   deriving (Eq, Ord, Read, Show) -_QualifiedName = (Core.Name "hydra/module.QualifiedName")+_QualifiedName = (Core.Name "hydra.module.QualifiedName")  _QualifiedName_namespace = (Core.Name "namespace")  _QualifiedName_local = (Core.Name "local")++-- | A term-level definition, including a name, a term, and the type of the term+data TermDefinition = +  TermDefinition {+    termDefinitionName :: Core.Name,+    termDefinitionTerm :: Core.Term,+    termDefinitionType :: Core.Type}+  deriving (Eq, Ord, Read, Show)++_TermDefinition = (Core.Name "hydra.module.TermDefinition")++_TermDefinition_name = (Core.Name "name")++_TermDefinition_term = (Core.Name "term")++_TermDefinition_type = (Core.Name "type")++-- | A type-level definition, including a name and the type+data TypeDefinition = +  TypeDefinition {+    typeDefinitionName :: Core.Name,+    typeDefinitionType :: Core.Type}+  deriving (Eq, Ord, Read, Show)++_TypeDefinition = (Core.Name "hydra.module.TypeDefinition")++_TypeDefinition_name = (Core.Name "name")++_TypeDefinition_type = (Core.Name "type")
+ src/gen-main/haskell/Hydra/Monads.hs view
@@ -0,0 +1,203 @@+-- | Functions for working with Hydra's 'flow' and other monads.++module Hydra.Monads where++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.Strings as Strings+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Show.Core as Core_+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++bind :: (Compute.Flow t0 t1 -> (t1 -> Compute.Flow t0 t2) -> Compute.Flow t0 t2)+bind l r =  +  let q = (\s0 -> \t0 ->  +          let fs1 = (Compute.unFlow l s0 t0)+          in (Optionals.maybe (Compute.FlowState {+            Compute.flowStateValue = Nothing,+            Compute.flowStateState = (Compute.flowStateState fs1),+            Compute.flowStateTrace = (Compute.flowStateTrace fs1)}) (\v -> Compute.unFlow (r v) (Compute.flowStateState fs1) (Compute.flowStateTrace fs1)) (Compute.flowStateValue fs1)))+  in (Compute.Flow q)++emptyTrace :: Compute.Trace+emptyTrace = Compute.Trace {+  Compute.traceStack = [],+  Compute.traceMessages = [],+  Compute.traceOther = Maps.empty}++exec :: (Compute.Flow t0 t1 -> t0 -> t0)+exec f s0 = (Compute.flowStateState (Compute.unFlow f s0 emptyTrace))++fail :: (String -> Compute.Flow t0 t1)+fail msg = (Compute.Flow (\s -> \t -> Compute.FlowState {+  Compute.flowStateValue = Nothing,+  Compute.flowStateState = s,+  Compute.flowStateTrace = (pushError msg t)}))++flowSucceeds :: (t0 -> Compute.Flow t0 t1 -> Bool)+flowSucceeds s f = (Optionals.isJust (Compute.flowStateValue (Compute.unFlow f s emptyTrace)))++fromFlow :: (t0 -> t1 -> Compute.Flow t1 t0 -> t0)+fromFlow def cx f = (Optionals.maybe def (\xmo -> xmo) (Compute.flowStateValue (Compute.unFlow f cx emptyTrace)))++getState :: (Compute.Flow t0 t0)+getState = (Compute.Flow (\s0 -> \t0 ->  +  let fs1 = (Compute.unFlow (pure ()) s0 t0) +      v = (Compute.flowStateValue fs1)+      s = (Compute.flowStateState fs1)+      t = (Compute.flowStateTrace fs1)+  in (Optionals.maybe (Compute.FlowState {+    Compute.flowStateValue = Nothing,+    Compute.flowStateState = s,+    Compute.flowStateTrace = t}) (\_ -> Compute.FlowState {+    Compute.flowStateValue = (Just s),+    Compute.flowStateState = s,+    Compute.flowStateTrace = t}) v)))++map :: ((t0 -> t1) -> Compute.Flow t2 t0 -> Compute.Flow t2 t1)+map f f1 = (Compute.Flow (\s0 -> \t0 ->  +  let f2 = (Compute.unFlow f1 s0 t0)+  in Compute.FlowState {+    Compute.flowStateValue = (Optionals.map f (Compute.flowStateValue f2)),+    Compute.flowStateState = (Compute.flowStateState f2),+    Compute.flowStateTrace = (Compute.flowStateTrace f2)}))++modify :: ((t0 -> t0) -> Compute.Flow t0 ())+modify f = (bind getState (\s -> putState (f s)))++mutateTrace :: ((Compute.Trace -> Mantle.Either String Compute.Trace) -> (Compute.Trace -> Compute.Trace -> Compute.Trace) -> Compute.Flow t0 t1 -> Compute.Flow t0 t1)+mutateTrace mutate restore f = (Compute.Flow (\s0 -> \t0 ->  +  let forLeft = (\msg -> Compute.FlowState {+          Compute.flowStateValue = Nothing,+          Compute.flowStateState = s0,+          Compute.flowStateTrace = (pushError msg t0)}) +      forRight = (\t1 ->  +              let f2 = (Compute.unFlow f s0 t1)+              in Compute.FlowState {+                Compute.flowStateValue = (Compute.flowStateValue f2),+                Compute.flowStateState = (Compute.flowStateState f2),+                Compute.flowStateTrace = (restore t0 (Compute.flowStateTrace f2))})+  in ((\x -> case x of+    Mantle.EitherLeft v1 -> (forLeft v1)+    Mantle.EitherRight v1 -> (forRight v1)) (mutate t0))))++optionalToList :: (Maybe t0 -> [t0])+optionalToList mx = (Optionals.maybe [] Lists.pure mx)++pure :: (t0 -> Compute.Flow t1 t0)+pure xp = (Compute.Flow (\s -> \t -> Compute.FlowState {+  Compute.flowStateValue = (Just xp),+  Compute.flowStateState = s,+  Compute.flowStateTrace = t}))++-- | Push an error message+pushError :: (String -> Compute.Trace -> Compute.Trace)+pushError msg t =  +  let condenseRepeats =  +          let condenseGroup = (\xs ->  +                  let x = (Lists.head xs) +                      n = (Lists.length xs)+                  in (Logic.ifElse (Equality.equal n 1) x (Strings.cat [+                    x,+                    " (x",+                    Literals.showInt32 n,+                    ")"])))+          in (\ys -> Lists.map condenseGroup (Lists.group ys)) +      errorMsg = (Strings.cat [+              "Error: ",+              msg,+              " (",+              Strings.intercalate " > " (condenseRepeats (Lists.reverse (Compute.traceStack t))),+              ")"])+  in Compute.Trace {+    Compute.traceStack = (Compute.traceStack t),+    Compute.traceMessages = (Lists.cons errorMsg (Compute.traceMessages t)),+    Compute.traceOther = (Compute.traceOther t)}++putState :: (t0 -> Compute.Flow t0 ())+putState cx = (Compute.Flow (\s0 -> \t0 ->  +  let f1 = (Compute.unFlow (pure ()) s0 t0)+  in Compute.FlowState {+    Compute.flowStateValue = (Compute.flowStateValue f1),+    Compute.flowStateState = cx,+    Compute.flowStateTrace = (Compute.flowStateTrace f1)}))++-- | Summarize a trace as a string+traceSummary :: (Compute.Trace -> String)+traceSummary t =  +  let messageLines = (Lists.nub (Compute.traceMessages t)) +      keyvalLines = (Logic.ifElse (Maps.null (Compute.traceOther t)) [] (Lists.cons "key/value pairs: " (Lists.map toLine (Maps.toList (Compute.traceOther t)))))+      toLine = (\pair -> Strings.cat [+              Strings.cat [+                Strings.cat [+                  "\t",+                  (Core.unName (fst pair))],+                ": "],+              (Core_.term (snd pair))])+  in (Strings.intercalate "\n" (Lists.concat2 messageLines keyvalLines))++unexpected :: (String -> String -> Compute.Flow t0 t1)+unexpected expected actual = (fail (Strings.cat [+  Strings.cat [+    Strings.cat [+      "expected ",+      expected],+    " but found: "],+  actual]))++warn :: (String -> Compute.Flow t0 t1 -> Compute.Flow t0 t1)+warn msg b = (Compute.Flow (\s0 -> \t0 ->  +  let f1 = (Compute.unFlow b s0 t0) +      addMessage = (\t -> Compute.Trace {+              Compute.traceStack = (Compute.traceStack t),+              Compute.traceMessages = (Lists.cons (Strings.cat [+                "Warning: ",+                msg]) (Compute.traceMessages t)),+              Compute.traceOther = (Compute.traceOther t)})+  in Compute.FlowState {+    Compute.flowStateValue = (Compute.flowStateValue f1),+    Compute.flowStateState = (Compute.flowStateState f1),+    Compute.flowStateTrace = (addMessage (Compute.flowStateTrace f1))}))++withFlag :: (Core.Name -> Compute.Flow t0 t1 -> Compute.Flow t0 t1)+withFlag flag =  +  let mutate = (\t -> Mantle.EitherRight (Compute.Trace {+          Compute.traceStack = (Compute.traceStack t),+          Compute.traceMessages = (Compute.traceMessages t),+          Compute.traceOther = (Maps.insert flag (Core.TermLiteral (Core.LiteralBoolean True)) (Compute.traceOther t))})) +      restore = (\ignored -> \t1 -> Compute.Trace {+              Compute.traceStack = (Compute.traceStack t1),+              Compute.traceMessages = (Compute.traceMessages t1),+              Compute.traceOther = (Maps.remove flag (Compute.traceOther t1))})+  in (mutateTrace mutate restore)++withState :: (t0 -> Compute.Flow t0 t1 -> Compute.Flow t2 t1)+withState cx0 f = (Compute.Flow (\cx1 -> \t1 ->  +  let f1 = (Compute.unFlow f cx0 t1)+  in Compute.FlowState {+    Compute.flowStateValue = (Compute.flowStateValue f1),+    Compute.flowStateState = cx1,+    Compute.flowStateTrace = (Compute.flowStateTrace f1)}))++withTrace :: (String -> Compute.Flow t0 t1 -> Compute.Flow t0 t1)+withTrace msg =  +  let mutate = (\t -> Logic.ifElse (Equality.gte (Lists.length (Compute.traceStack t)) Constants.maxTraceDepth) (Mantle.EitherLeft "maximum trace depth exceeded. This may indicate an infinite loop") (Mantle.EitherRight (Compute.Trace {+          Compute.traceStack = (Lists.cons msg (Compute.traceStack t)),+          Compute.traceMessages = (Compute.traceMessages t),+          Compute.traceOther = (Compute.traceOther t)}))) +      restore = (\t0 -> \t1 -> Compute.Trace {+              Compute.traceStack = (Compute.traceStack t0),+              Compute.traceMessages = (Compute.traceMessages t1),+              Compute.traceOther = (Compute.traceOther t1)})+  in (mutateTrace mutate restore)
+ src/gen-main/haskell/Hydra/Names.hs view
@@ -0,0 +1,76 @@+-- | Functions for working with qualified names.++module Hydra.Names where++import qualified Hydra.Core as Core+import qualified Hydra.Formatting as Formatting+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Lists as Lists+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 Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Given a mapping of namespaces to prefixes, convert a name to a compact string representation+compactName :: (M.Map Module.Namespace String -> Core.Name -> String)+compactName namespaces name =  +  let qualName = (qualifyName name) +      mns = (Module.qualifiedNameNamespace qualName)+      local = (Module.qualifiedNameLocal qualName)+  in (Optionals.maybe (Core.unName name) (\ns -> Optionals.maybe local (\pre -> Strings.cat [+    pre,+    ":",+    local]) (Maps.lookup ns namespaces)) mns)++localNameOf :: (Core.Name -> String)+localNameOf arg_ = (Module.qualifiedNameLocal (qualifyName arg_))++namespaceOf :: (Core.Name -> Maybe Module.Namespace)+namespaceOf arg_ = (Module.qualifiedNameNamespace (qualifyName arg_))++namespaceToFilePath :: (Mantle.CaseConvention -> Module.FileExtension -> Module.Namespace -> String)+namespaceToFilePath caseConv ext ns =  +  let parts = (Lists.map (Formatting.convertCase Mantle.CaseConventionCamel caseConv) (Strings.splitOn "." (Module.unNamespace ns)))+  in (Strings.cat [+    Strings.cat [+      Strings.intercalate "/" parts,+      "."],+    (Module.unFileExtension ext)])++-- | Construct a qualified (dot-separated) name+qname :: (Module.Namespace -> String -> Core.Name)+qname ns name = (Core.Name (Strings.cat [+  Module.unNamespace ns,+  ".",+  name]))++qualifyName :: (Core.Name -> Module.QualifiedName)+qualifyName name =  +  let parts = (Lists.reverse (Strings.splitOn "." (Core.unName name)))+  in (Logic.ifElse (Equality.equal 1 (Lists.length parts)) (Module.QualifiedName {+    Module.qualifiedNameNamespace = Nothing,+    Module.qualifiedNameLocal = (Core.unName name)}) (Module.QualifiedName {+    Module.qualifiedNameNamespace = (Just (Module.Namespace (Strings.intercalate "." (Lists.reverse (Lists.tail parts))))),+    Module.qualifiedNameLocal = (Lists.head parts)}))++-- | Generate a unique label by appending a suffix if the label is already in use+uniqueLabel :: (S.Set String -> String -> String)+uniqueLabel visited l = (Logic.ifElse (Sets.member l visited) (uniqueLabel visited (Strings.cat2 l "'")) l)++-- | Convert a qualified name to a dot-separated name+unqualifyName :: (Module.QualifiedName -> Core.Name)+unqualifyName qname =  +  let prefix = (Optionals.maybe "" (\n -> Strings.cat [+          Module.unNamespace n,+          "."]) (Module.qualifiedNameNamespace qname))+  in (Core.Name (Strings.cat [+    prefix,+    (Module.qualifiedNameLocal qname)]))
− src/gen-main/haskell/Hydra/Pg/Mapping.hs 
@@ -1,183 +0,0 @@--- | A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs--module Hydra.Pg.Mapping where--import qualified Hydra.Compute as Compute-import qualified Hydra.Core as Core-import qualified Hydra.Pg.Model as Model-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Configurable annotation keys for property graph mapping specifications-data AnnotationSchema = -  AnnotationSchema {-    annotationSchemaVertexLabel :: String,-    annotationSchemaEdgeLabel :: String,-    annotationSchemaVertexId :: String,-    annotationSchemaEdgeId :: String,-    annotationSchemaPropertyKey :: String,-    annotationSchemaPropertyValue :: String,-    annotationSchemaOutVertex :: String,-    annotationSchemaOutVertexLabel :: String,-    annotationSchemaInVertex :: String,-    annotationSchemaInVertexLabel :: String,-    annotationSchemaOutEdge :: String,-    annotationSchemaOutEdgeLabel :: String,-    annotationSchemaInEdge :: String,-    annotationSchemaInEdgeLabel :: String,-    annotationSchemaIgnore :: String}-  deriving (Eq, Ord, Read, Show)--_AnnotationSchema = (Core.Name "hydra/pg/mapping.AnnotationSchema")--_AnnotationSchema_vertexLabel = (Core.Name "vertexLabel")--_AnnotationSchema_edgeLabel = (Core.Name "edgeLabel")--_AnnotationSchema_vertexId = (Core.Name "vertexId")--_AnnotationSchema_edgeId = (Core.Name "edgeId")--_AnnotationSchema_propertyKey = (Core.Name "propertyKey")--_AnnotationSchema_propertyValue = (Core.Name "propertyValue")--_AnnotationSchema_outVertex = (Core.Name "outVertex")--_AnnotationSchema_outVertexLabel = (Core.Name "outVertexLabel")--_AnnotationSchema_inVertex = (Core.Name "inVertex")--_AnnotationSchema_inVertexLabel = (Core.Name "inVertexLabel")--_AnnotationSchema_outEdge = (Core.Name "outEdge")--_AnnotationSchema_outEdgeLabel = (Core.Name "outEdgeLabel")--_AnnotationSchema_inEdge = (Core.Name "inEdge")--_AnnotationSchema_inEdgeLabel = (Core.Name "inEdgeLabel")--_AnnotationSchema_ignore = (Core.Name "ignore")---- | A mapping specification producing edges of a specified label.-data EdgeSpec = -  EdgeSpec {-    -- | The label of the target edges, which must conform to the edge type associated with that label.-    edgeSpecLabel :: Model.EdgeLabel,-    -- | A specification of the id of each target edge-    edgeSpecId :: ValueSpec,-    -- | A specification of the out-vertex reference of each target edge-    edgeSpecOut :: ValueSpec,-    -- | A specification of the in-vertex reference of each target edge-    edgeSpecIn :: ValueSpec,-    -- | Zero or more property specifications for each target edge-    edgeSpecProperties :: [PropertySpec]}-  deriving (Eq, Ord, Read, Show)--_EdgeSpec = (Core.Name "hydra/pg/mapping.EdgeSpec")--_EdgeSpec_label = (Core.Name "label")--_EdgeSpec_id = (Core.Name "id")--_EdgeSpec_out = (Core.Name "out")--_EdgeSpec_in = (Core.Name "in")--_EdgeSpec_properties = (Core.Name "properties")---- | Either a vertex specification or an edge specification-data ElementSpec = -  ElementSpecVertex VertexSpec |-  ElementSpecEdge EdgeSpec-  deriving (Eq, Ord, Read, Show)--_ElementSpec = (Core.Name "hydra/pg/mapping.ElementSpec")--_ElementSpec_vertex = (Core.Name "vertex")--_ElementSpec_edge = (Core.Name "edge")---- | A mapping specification producing properties of a specified key, and values of the appropriate type.-data PropertySpec = -  PropertySpec {-    -- | The key of the target properties-    propertySpecKey :: Model.PropertyKey,-    -- | A specification of the value of each target property, which must conform to the type associated with the property key-    propertySpecValue :: ValueSpec}-  deriving (Eq, Ord, Read, Show)--_PropertySpec = (Core.Name "hydra/pg/mapping.PropertySpec")--_PropertySpec_key = (Core.Name "key")--_PropertySpec_value = (Core.Name "value")---- | A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types-data Schema s t v = -  Schema {-    schemaVertexIdTypes :: (Compute.Coder s s Core.Type t),-    schemaVertexIds :: (Compute.Coder s s Core.Term v),-    schemaEdgeIdTypes :: (Compute.Coder s s Core.Type t),-    schemaEdgeIds :: (Compute.Coder s s Core.Term v),-    schemaPropertyTypes :: (Compute.Coder s s Core.Type t),-    schemaPropertyValues :: (Compute.Coder s s Core.Term v),-    schemaAnnotations :: AnnotationSchema,-    schemaDefaultVertexId :: v,-    schemaDefaultEdgeId :: v}--_Schema = (Core.Name "hydra/pg/mapping.Schema")--_Schema_vertexIdTypes = (Core.Name "vertexIdTypes")--_Schema_vertexIds = (Core.Name "vertexIds")--_Schema_edgeIdTypes = (Core.Name "edgeIdTypes")--_Schema_edgeIds = (Core.Name "edgeIds")--_Schema_propertyTypes = (Core.Name "propertyTypes")--_Schema_propertyValues = (Core.Name "propertyValues")--_Schema_annotations = (Core.Name "annotations")--_Schema_defaultVertexId = (Core.Name "defaultVertexId")--_Schema_defaultEdgeId = (Core.Name "defaultEdgeId")---- | A mapping specification producing values (usually literal values) whose type is understood in context-data ValueSpec = -  -- | A trivial no-op specification which passes the entire value-  ValueSpecValue  |-  -- | A compact path representing the function, e.g. engine-${engineInfo/model/name}-  ValueSpecPattern String-  deriving (Eq, Ord, Read, Show)--_ValueSpec = (Core.Name "hydra/pg/mapping.ValueSpec")--_ValueSpec_value = (Core.Name "value")--_ValueSpec_pattern = (Core.Name "pattern")---- | A mapping specification producing vertices of a specified label-data VertexSpec = -  VertexSpec {-    -- | The label of the target vertices, which must conform to the vertex type associated with that label.-    vertexSpecLabel :: Model.VertexLabel,-    -- | A specification of the id of each target vertex-    vertexSpecId :: ValueSpec,-    -- | Zero or more property specifications for each target vertex-    vertexSpecProperties :: [PropertySpec]}-  deriving (Eq, Ord, Read, Show)--_VertexSpec = (Core.Name "hydra/pg/mapping.VertexSpec")--_VertexSpec_label = (Core.Name "label")--_VertexSpec_id = (Core.Name "id")--_VertexSpec_properties = (Core.Name "properties")
− src/gen-main/haskell/Hydra/Pg/Model.hs 
@@ -1,279 +0,0 @@--- | A typed property graph data model. Property graphs are parameterized a type for property and id values, while property graph schemas are parameterized by a type for property and id types--module Hydra.Pg.Model where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | The direction of an edge or edge pattern-data Direction = -  DirectionOut  |-  DirectionIn  |-  DirectionBoth  |-  DirectionUndirected -  deriving (Eq, Ord, Read, Show)--_Direction = (Core.Name "hydra/pg/model.Direction")--_Direction_out = (Core.Name "out")--_Direction_in = (Core.Name "in")--_Direction_both = (Core.Name "both")--_Direction_undirected = (Core.Name "undirected")---- | An edge-data Edge v = -  Edge {-    -- | The label of the edge-    edgeLabel :: EdgeLabel,-    -- | The unique identifier of the edge-    edgeId :: v,-    -- | The id of the out-vertex (tail) of the edge-    edgeOut :: v,-    -- | The id of the in-vertex (head) of the edge-    edgeIn :: v,-    -- | A key/value map of edge properties-    edgeProperties :: (Map PropertyKey v)}-  deriving (Eq, Ord, Read, Show)--_Edge = (Core.Name "hydra/pg/model.Edge")--_Edge_label = (Core.Name "label")--_Edge_id = (Core.Name "id")--_Edge_out = (Core.Name "out")--_Edge_in = (Core.Name "in")--_Edge_properties = (Core.Name "properties")---- | The label of an edge-newtype EdgeLabel = -  EdgeLabel {-    unEdgeLabel :: String}-  deriving (Eq, Ord, Read, Show)--_EdgeLabel = (Core.Name "hydra/pg/model.EdgeLabel")---- | The type of an edge-data EdgeType t = -  EdgeType {-    -- | The label of any edge of this edge type-    edgeTypeLabel :: EdgeLabel,-    -- | The type of the id of any edge of this edge type-    edgeTypeId :: t,-    -- | The label of the out-vertex (tail) of any edge of this edge type-    edgeTypeOut :: VertexLabel,-    -- | The label of the in-vertex (head) of any edge of this edge type-    edgeTypeIn :: VertexLabel,-    -- | A list of property types. The types are ordered for the sake of applications in which property order is significant.-    edgeTypeProperties :: [PropertyType t]}-  deriving (Eq, Ord, Read, Show)--_EdgeType = (Core.Name "hydra/pg/model.EdgeType")--_EdgeType_label = (Core.Name "label")--_EdgeType_id = (Core.Name "id")--_EdgeType_out = (Core.Name "out")--_EdgeType_in = (Core.Name "in")--_EdgeType_properties = (Core.Name "properties")---- | Either a vertex or an edge-data Element v = -  ElementVertex (Vertex v) |-  ElementEdge (Edge v)-  deriving (Eq, Ord, Read, Show)--_Element = (Core.Name "hydra/pg/model.Element")--_Element_vertex = (Core.Name "vertex")--_Element_edge = (Core.Name "edge")---- | The kind of an element: vertex or edge-data ElementKind = -  ElementKindVertex  |-  ElementKindEdge -  deriving (Eq, Ord, Read, Show)--_ElementKind = (Core.Name "hydra/pg/model.ElementKind")--_ElementKind_vertex = (Core.Name "vertex")--_ElementKind_edge = (Core.Name "edge")---- | An element together with its dependencies in some context-data ElementTree v = -  ElementTree {-    elementTreeSelf :: (Element v),-    elementTreeDependencies :: [ElementTree v]}-  deriving (Eq, Ord, Read, Show)--_ElementTree = (Core.Name "hydra/pg/model.ElementTree")--_ElementTree_self = (Core.Name "self")--_ElementTree_dependencies = (Core.Name "dependencies")---- | The type of a vertex or edge-data ElementType t = -  ElementTypeVertex (VertexType t) |-  ElementTypeEdge (EdgeType t)-  deriving (Eq, Ord, Read, Show)--_ElementType = (Core.Name "hydra/pg/model.ElementType")--_ElementType_vertex = (Core.Name "vertex")--_ElementType_edge = (Core.Name "edge")---- | An element type together with its dependencies in some context-data ElementTypeTree t = -  ElementTypeTree {-    elementTypeTreeSelf :: (ElementType t),-    elementTypeTreeDependencies :: [ElementTypeTree t]}-  deriving (Eq, Ord, Read, Show)--_ElementTypeTree = (Core.Name "hydra/pg/model.ElementTypeTree")--_ElementTypeTree_self = (Core.Name "self")--_ElementTypeTree_dependencies = (Core.Name "dependencies")---- | A graph; a self-contained collection of vertices and edges-data Graph v = -  Graph {-    graphVertices :: (Map v (Vertex v)),-    graphEdges :: (Map v (Edge v))}-  deriving (Eq, Ord, Read, Show)--_Graph = (Core.Name "hydra/pg/model.Graph")--_Graph_vertices = (Core.Name "vertices")--_Graph_edges = (Core.Name "edges")---- | A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema-data GraphSchema t = -  GraphSchema {-    -- | A unique vertex type for each vertex label which may occur in a graph-    graphSchemaVertices :: (Map VertexLabel (VertexType t)),-    -- | A unique edge type for each edge label which may occur in a graph-    graphSchemaEdges :: (Map EdgeLabel (EdgeType t))}-  deriving (Eq, Ord, Read, Show)--_GraphSchema = (Core.Name "hydra/pg/model.GraphSchema")--_GraphSchema_vertices = (Core.Name "vertices")--_GraphSchema_edges = (Core.Name "edges")---- | Either a vertex or edge label-data Label = -  LabelVertex VertexLabel |-  LabelEdge EdgeLabel-  deriving (Eq, Ord, Read, Show)--_Label = (Core.Name "hydra/pg/model.Label")--_Label_vertex = (Core.Name "vertex")--_Label_edge = (Core.Name "edge")---- | A key/value property-data Property v = -  Property {-    -- | They key of the property-    propertyKey :: PropertyKey,-    -- | The value of the property-    propertyValue :: v}-  deriving (Eq, Ord, Read, Show)--_Property = (Core.Name "hydra/pg/model.Property")--_Property_key = (Core.Name "key")--_Property_value = (Core.Name "value")---- | A property key-newtype PropertyKey = -  PropertyKey {-    unPropertyKey :: String}-  deriving (Eq, Ord, Read, Show)--_PropertyKey = (Core.Name "hydra/pg/model.PropertyKey")---- | The type of a property-data PropertyType t = -  PropertyType {-    -- | A property's key-    propertyTypeKey :: PropertyKey,-    -- | The type of a property's value-    propertyTypeValue :: t,-    -- | Whether the property is required; values may be omitted from a property map otherwise-    propertyTypeRequired :: Bool}-  deriving (Eq, Ord, Read, Show)--_PropertyType = (Core.Name "hydra/pg/model.PropertyType")--_PropertyType_key = (Core.Name "key")--_PropertyType_value = (Core.Name "value")--_PropertyType_required = (Core.Name "required")---- | A vertex-data Vertex v = -  Vertex {-    -- | The label of the vertex-    vertexLabel :: VertexLabel,-    -- | The unique identifier of the vertex-    vertexId :: v,-    -- | A key/value map of vertex properties-    vertexProperties :: (Map PropertyKey v)}-  deriving (Eq, Ord, Read, Show)--_Vertex = (Core.Name "hydra/pg/model.Vertex")--_Vertex_label = (Core.Name "label")--_Vertex_id = (Core.Name "id")--_Vertex_properties = (Core.Name "properties")---- | The label of a vertex. The default (null) vertex is represented by the empty string-newtype VertexLabel = -  VertexLabel {-    unVertexLabel :: String}-  deriving (Eq, Ord, Read, Show)--_VertexLabel = (Core.Name "hydra/pg/model.VertexLabel")---- | The type of a vertex-data VertexType t = -  VertexType {-    -- | The label of any vertex of this vertex type-    vertexTypeLabel :: VertexLabel,-    -- | The type of the id of any vertex of this vertex type-    vertexTypeId :: t,-    -- | A list of property types. The types are ordered for the sake of applications in which property order is significant.-    vertexTypeProperties :: [PropertyType t]}-  deriving (Eq, Ord, Read, Show)--_VertexType = (Core.Name "hydra/pg/model.VertexType")--_VertexType_label = (Core.Name "label")--_VertexType_id = (Core.Name "id")--_VertexType_properties = (Core.Name "properties")
− src/gen-main/haskell/Hydra/Pg/Query.hs 
@@ -1,329 +0,0 @@--- | A common model for pattern-matching queries over property graphs--module Hydra.Pg.Query where--import qualified Hydra.Core as Core-import qualified Hydra.Pg.Model as Model-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--data AggregationQuery = -  AggregationQueryCount -  deriving (Eq, Ord, Read, Show)--_AggregationQuery = (Core.Name "hydra/pg/query.AggregationQuery")--_AggregationQuery_count = (Core.Name "count")--newtype ApplicationQuery = -  ApplicationQuery {-    unApplicationQuery :: [Query]}-  deriving (Eq, Ord, Read, Show)--_ApplicationQuery = (Core.Name "hydra/pg/query.ApplicationQuery")--data AssociativeExpression = -  AssociativeExpression {-    associativeExpressionOperator :: BinaryOperator,-    associativeExpressionOperands :: [Expression]}-  deriving (Eq, Ord, Read, Show)--_AssociativeExpression = (Core.Name "hydra/pg/query.AssociativeExpression")--_AssociativeExpression_operator = (Core.Name "operator")--_AssociativeExpression_operands = (Core.Name "operands")--data BinaryExpression = -  BinaryExpression {-    binaryExpressionLeft :: Expression,-    binaryExpressionOperator :: BinaryOperator,-    binaryExpressionRight :: Expression}-  deriving (Eq, Ord, Read, Show)--_BinaryExpression = (Core.Name "hydra/pg/query.BinaryExpression")--_BinaryExpression_left = (Core.Name "left")--_BinaryExpression_operator = (Core.Name "operator")--_BinaryExpression_right = (Core.Name "right")--data BinaryBooleanOperator = -  BinaryBooleanOperatorAnd  |-  BinaryBooleanOperatorOr  |-  BinaryBooleanOperatorXor -  deriving (Eq, Ord, Read, Show)--_BinaryBooleanOperator = (Core.Name "hydra/pg/query.BinaryBooleanOperator")--_BinaryBooleanOperator_and = (Core.Name "and")--_BinaryBooleanOperator_or = (Core.Name "or")--_BinaryBooleanOperator_xor = (Core.Name "xor")--data BinaryOperator = -  BinaryOperatorBoolean BinaryBooleanOperator |-  BinaryOperatorComparison ComparisonOperator |-  BinaryOperatorPower -  deriving (Eq, Ord, Read, Show)--_BinaryOperator = (Core.Name "hydra/pg/query.BinaryOperator")--_BinaryOperator_boolean = (Core.Name "boolean")--_BinaryOperator_comparison = (Core.Name "comparison")--_BinaryOperator_power = (Core.Name "power")--data Binding = -  Binding {-    bindingKey :: Variable,-    bindingValue :: Query}-  deriving (Eq, Ord, Read, Show)--_Binding = (Core.Name "hydra/pg/query.Binding")--_Binding_key = (Core.Name "key")--_Binding_value = (Core.Name "value")--data ComparisonOperator = -  ComparisonOperatorEq  |-  ComparisonOperatorNeq  |-  ComparisonOperatorLt  |-  ComparisonOperatorLte  |-  ComparisonOperatorGt  |-  ComparisonOperatorGte -  deriving (Eq, Ord, Read, Show)--_ComparisonOperator = (Core.Name "hydra/pg/query.ComparisonOperator")--_ComparisonOperator_eq = (Core.Name "eq")--_ComparisonOperator_neq = (Core.Name "neq")--_ComparisonOperator_lt = (Core.Name "lt")--_ComparisonOperator_lte = (Core.Name "lte")--_ComparisonOperator_gt = (Core.Name "gt")--_ComparisonOperator_gte = (Core.Name "gte")--data EdgeProjectionPattern = -  EdgeProjectionPattern {-    edgeProjectionPatternDirection :: Model.Direction,-    edgeProjectionPatternLabel :: (Maybe Model.EdgeLabel),-    edgeProjectionPatternProperties :: [PropertyPattern],-    edgeProjectionPatternVertex :: (Maybe VertexPattern)}-  deriving (Eq, Ord, Read, Show)--_EdgeProjectionPattern = (Core.Name "hydra/pg/query.EdgeProjectionPattern")--_EdgeProjectionPattern_direction = (Core.Name "direction")--_EdgeProjectionPattern_label = (Core.Name "label")--_EdgeProjectionPattern_properties = (Core.Name "properties")--_EdgeProjectionPattern_vertex = (Core.Name "vertex")--data Expression = -  ExpressionAssociative AssociativeExpression |-  ExpressionBinary BinaryExpression |-  ExpressionProperty PropertyProjection |-  ExpressionUnary UnaryExpression |-  ExpressionVariable Variable |-  ExpressionVertex VertexPattern-  deriving (Eq, Ord, Read, Show)--_Expression = (Core.Name "hydra/pg/query.Expression")--_Expression_associative = (Core.Name "associative")--_Expression_binary = (Core.Name "binary")--_Expression_property = (Core.Name "property")--_Expression_unary = (Core.Name "unary")--_Expression_variable = (Core.Name "variable")--_Expression_vertex = (Core.Name "vertex")--data LetQuery = -  LetQuery {-    letQueryBindings :: [Binding],-    letQueryEnvironment :: Query}-  deriving (Eq, Ord, Read, Show)--_LetQuery = (Core.Name "hydra/pg/query.LetQuery")--_LetQuery_bindings = (Core.Name "bindings")--_LetQuery_environment = (Core.Name "environment")--data MatchQuery = -  MatchQuery {-    matchQueryOptional :: Bool,-    matchQueryPattern :: [Projection],-    matchQueryWhere :: (Maybe Expression)}-  deriving (Eq, Ord, Read, Show)--_MatchQuery = (Core.Name "hydra/pg/query.MatchQuery")--_MatchQuery_optional = (Core.Name "optional")--_MatchQuery_pattern = (Core.Name "pattern")--_MatchQuery_where = (Core.Name "where")--data Projection = -  Projection {-    projectionValue :: Expression,-    projectionAs :: (Maybe Variable)}-  deriving (Eq, Ord, Read, Show)--_Projection = (Core.Name "hydra/pg/query.Projection")--_Projection_value = (Core.Name "value")--_Projection_as = (Core.Name "as")--data Projections = -  Projections {-    projectionsAll :: Bool,-    projectionsExplicit :: [Projection]}-  deriving (Eq, Ord, Read, Show)--_Projections = (Core.Name "hydra/pg/query.Projections")--_Projections_all = (Core.Name "all")--_Projections_explicit = (Core.Name "explicit")--data PropertyPattern = -  PropertyPattern {-    propertyPatternKey :: Model.PropertyKey,-    propertyPatternValue :: PropertyValuePattern}-  deriving (Eq, Ord, Read, Show)--_PropertyPattern = (Core.Name "hydra/pg/query.PropertyPattern")--_PropertyPattern_key = (Core.Name "key")--_PropertyPattern_value = (Core.Name "value")--data PropertyProjection = -  PropertyProjection {-    propertyProjectionBase :: Expression,-    propertyProjectionKey :: Model.PropertyKey}-  deriving (Eq, Ord, Read, Show)--_PropertyProjection = (Core.Name "hydra/pg/query.PropertyProjection")--_PropertyProjection_base = (Core.Name "base")--_PropertyProjection_key = (Core.Name "key")--newtype PropertyValue = -  PropertyValue {-    unPropertyValue :: String}-  deriving (Eq, Ord, Read, Show)--_PropertyValue = (Core.Name "hydra/pg/query.PropertyValue")--data PropertyValuePattern = -  PropertyValuePatternVariable Model.PropertyKey |-  PropertyValuePatternValue String-  deriving (Eq, Ord, Read, Show)--_PropertyValuePattern = (Core.Name "hydra/pg/query.PropertyValuePattern")--_PropertyValuePattern_variable = (Core.Name "variable")--_PropertyValuePattern_value = (Core.Name "value")--data Query = -  QueryApplication ApplicationQuery |-  QueryAggregate AggregationQuery |-  QueryLetQuery LetQuery |-  QueryMatch MatchQuery |-  QuerySelect SelectQuery |-  QueryValue String-  deriving (Eq, Ord, Read, Show)--_Query = (Core.Name "hydra/pg/query.Query")--_Query_application = (Core.Name "application")--_Query_aggregate = (Core.Name "aggregate")--_Query_LetQuery = (Core.Name "LetQuery")--_Query_match = (Core.Name "match")--_Query_select = (Core.Name "select")--_Query_value = (Core.Name "value")--data SelectQuery = -  SelectQuery {-    selectQueryDistinct :: Bool,-    selectQueryProjection :: Projections}-  deriving (Eq, Ord, Read, Show)--_SelectQuery = (Core.Name "hydra/pg/query.SelectQuery")--_SelectQuery_distinct = (Core.Name "distinct")--_SelectQuery_projection = (Core.Name "projection")--data UnaryExpression = -  UnaryExpression {-    unaryExpressionOperator :: UnaryOperator,-    unaryExpressionOperand :: Expression}-  deriving (Eq, Ord, Read, Show)--_UnaryExpression = (Core.Name "hydra/pg/query.UnaryExpression")--_UnaryExpression_operator = (Core.Name "operator")--_UnaryExpression_operand = (Core.Name "operand")--data UnaryOperator = -  UnaryOperatorNegate -  deriving (Eq, Ord, Read, Show)--_UnaryOperator = (Core.Name "hydra/pg/query.UnaryOperator")--_UnaryOperator_negate = (Core.Name "negate")--newtype Variable = -  Variable {-    unVariable :: String}-  deriving (Eq, Ord, Read, Show)--_Variable = (Core.Name "hydra/pg/query.Variable")--data VertexPattern = -  VertexPattern {-    vertexPatternVariable :: (Maybe Variable),-    vertexPatternLabel :: (Maybe Model.VertexLabel),-    vertexPatternProperties :: [PropertyPattern],-    vertexPatternEdges :: [EdgeProjectionPattern]}-  deriving (Eq, Ord, Read, Show)--_VertexPattern = (Core.Name "hydra/pg/query.VertexPattern")--_VertexPattern_variable = (Core.Name "variable")--_VertexPattern_label = (Core.Name "label")--_VertexPattern_properties = (Core.Name "properties")--_VertexPattern_edges = (Core.Name "edges")
− src/gen-main/haskell/Hydra/Pg/Validation.hs 
@@ -1,143 +0,0 @@--- | Utilities for validating property graphs against property graph schemas--module Hydra.Pg.Validation where--import qualified Hydra.Lib.Equality as Equality-import qualified Hydra.Lib.Lists as Lists-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.Strings as Strings-import qualified Hydra.Pg.Model as Model-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--validateEdge :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe Model.VertexLabel) -> Model.EdgeType t -> Model.Edge v -> Maybe String)-validateEdge checkValue showValue labelForVertexId typ el =  -  let failWith = (edgeError showValue el) -      checkLabel =  -              let expected = (Model.edgeTypeLabel typ) -                  actual = (Model.edgeLabel el)-              in (verify (Equality.equalString (Model.unEdgeLabel actual) (Model.unEdgeLabel expected)) (failWith (prepend "Wrong label" (edgeLabelMismatch expected actual))))-      checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (Model.edgeTypeId typ) (Model.edgeId el)))-      checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (Model.edgeTypeProperties typ) (Model.edgeProperties el)))-      checkOut = ((\x -> case x of-              Nothing -> Nothing-              Just v329 -> ((\x -> case x of-                Nothing -> (Just (failWith (prepend "Out-vertex does not exist" (showValue (Model.edgeOut el)))))-                Just v330 -> (verify (Equality.equalString (Model.unVertexLabel v330) (Model.unVertexLabel (Model.edgeTypeOut typ))) (failWith (prepend "Wrong out-vertex label" (vertexLabelMismatch (Model.edgeTypeOut typ) v330))))) (v329 (Model.edgeOut el)))) labelForVertexId)-      checkIn = ((\x -> case x of-              Nothing -> Nothing-              Just v331 -> ((\x -> case x of-                Nothing -> (Just (failWith (prepend "In-vertex does not exist" (showValue (Model.edgeIn el)))))-                Just v332 -> (verify (Equality.equalString (Model.unVertexLabel v332) (Model.unVertexLabel (Model.edgeTypeIn typ))) (failWith (prepend "Wrong in-vertex label" (vertexLabelMismatch (Model.edgeTypeIn typ) v332))))) (v331 (Model.edgeIn el)))) labelForVertexId)-  in (checkAll [-    checkLabel,-    checkId,-    checkProperties,-    checkOut,-    checkIn])--validateElement :: ((t -> v -> Maybe String) -> (v -> String) -> Maybe (v -> Maybe Model.VertexLabel) -> Model.ElementType t -> Model.Element v -> Maybe String)-validateElement checkValue showValue labelForVertexId typ el = ((\x -> case x of-  Model.ElementTypeVertex v333 -> ((\x -> case x of-    Model.ElementEdge v334 -> (Just (prepend "Edge instead of vertex" (showValue (Model.edgeId v334))))-    Model.ElementVertex v335 -> (validateVertex checkValue showValue v333 v335)) el)-  Model.ElementTypeEdge v336 -> ((\x -> case x of-    Model.ElementVertex v337 -> (Just (prepend "Vertex instead of edge" (showValue (Model.vertexId v337))))-    Model.ElementEdge v338 -> (validateEdge checkValue showValue labelForVertexId v336 v338)) el)) typ)--validateGraph :: (Ord v) => ((t -> v -> Maybe String) -> (v -> String) -> Model.GraphSchema t -> Model.Graph v -> Maybe String)-validateGraph checkValue showValue schema graph =  -  let checkVertices =  -          let checkVertex = (\el -> (\x -> case x of-                  Nothing -> (Just (vertexError showValue el (prepend "Unexpected label" (Model.unVertexLabel (Model.vertexLabel el)))))-                  Just v339 -> (validateVertex checkValue showValue v339 el)) (Maps.lookup (Model.vertexLabel el) (Model.graphSchemaVertices schema)))-          in (checkAll (Lists.map checkVertex (Maps.values (Model.graphVertices graph)))) -      checkEdges =  -              let checkEdge = (\el -> (\x -> case x of-                      Nothing -> (Just (edgeError showValue el (prepend "Unexpected label" (Model.unEdgeLabel (Model.edgeLabel el)))))-                      Just v340 -> (validateEdge checkValue showValue labelForVertexId v340 el)) (Maps.lookup (Model.edgeLabel el) (Model.graphSchemaEdges schema))) -                  labelForVertexId = (Just (\i -> Optionals.map Model.vertexLabel (Maps.lookup i (Model.graphVertices graph))))-              in (checkAll (Lists.map checkEdge (Maps.values (Model.graphEdges graph))))-  in (checkAll [-    checkVertices,-    checkEdges])--validateProperties :: ((t -> v -> Maybe String) -> [Model.PropertyType t] -> Map Model.PropertyKey v -> Maybe String)-validateProperties checkValue types props =  -  let checkTypes = (checkAll (Lists.map checkType types)) -      checkType = (\t -> Logic.ifElse ((\x -> case x of-              Nothing -> (Just (prepend "Missing value for " (Model.unPropertyKey (Model.propertyTypeKey t))))-              Just _ -> Nothing) (Maps.lookup (Model.propertyTypeKey t) props)) Nothing (Model.propertyTypeRequired t))-      checkValues =  -              let m = (Maps.fromList (Lists.map (\p -> (Model.propertyTypeKey p, (Model.propertyTypeValue p))) types)) -                  checkPair = (\pair ->  -                          let key = (fst pair) -                              val = (snd pair)-                          in ((\x -> case x of-                            Nothing -> (Just (prepend "Unexpected key" (Model.unPropertyKey key)))-                            Just v342 -> (Optionals.map (prepend "Invalid value") (checkValue v342 val))) (Maps.lookup key m)))-              in (checkAll (Lists.map checkPair (Maps.toList props)))-  in (checkAll [-    checkTypes,-    checkValues])--validateVertex :: ((t -> v -> Maybe String) -> (v -> String) -> Model.VertexType t -> Model.Vertex v -> Maybe String)-validateVertex checkValue showValue typ el =  -  let failWith = (vertexError showValue el) -      checkLabel =  -              let expected = (Model.vertexTypeLabel typ) -                  actual = (Model.vertexLabel el)-              in (verify (Equality.equalString (Model.unVertexLabel actual) (Model.unVertexLabel expected)) (failWith (prepend "Wrong label" (vertexLabelMismatch expected actual))))-      checkId = (Optionals.map (\x -> failWith (prepend "Invalid id" x)) (checkValue (Model.vertexTypeId typ) (Model.vertexId el)))-      checkProperties = (Optionals.map (\x -> failWith (prepend "Invalid property" x)) (validateProperties checkValue (Model.vertexTypeProperties typ) (Model.vertexProperties el)))-  in (checkAll [-    checkLabel,-    checkId,-    checkProperties])--checkAll :: ([Maybe a] -> Maybe a)-checkAll checks =  -  let errors = (Optionals.cat checks)-  in (Lists.safeHead errors)--edgeError :: ((v -> String) -> Model.Edge v -> String -> String)-edgeError showValue e = (prepend (Strings.cat [-  "Invalid edge with id ",-  (showValue (Model.edgeId e))]))--edgeLabelMismatch :: (Model.EdgeLabel -> Model.EdgeLabel -> String)-edgeLabelMismatch expected actual = (Strings.cat [-  Strings.cat [-    Strings.cat [-      "expected ",-      (Model.unEdgeLabel expected)],-    ", found "],-  (Model.unEdgeLabel actual)])--prepend :: (String -> String -> String)-prepend prefix msg = (Strings.cat [-  Strings.cat [-    prefix,-    ": "],-  msg])--verify :: (Bool -> String -> Maybe String)-verify b err = (Logic.ifElse Nothing (Just err) b)--vertexError :: ((v -> String) -> Model.Vertex v -> String -> String)-vertexError showValue v = (prepend (Strings.cat [-  "Invalid vertex with id ",-  (showValue (Model.vertexId v))]))--vertexLabelMismatch :: (Model.VertexLabel -> Model.VertexLabel -> String)-vertexLabelMismatch expected actual = (Strings.cat [-  Strings.cat [-    Strings.cat [-      "expected ",-      (Model.unVertexLabel expected)],-    ", found "],-  (Model.unVertexLabel actual)])
src/gen-main/haskell/Hydra/Phantoms.hs view
@@ -3,39 +3,24 @@ module Hydra.Phantoms where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | An association of a field name (as in a case statement) with a phantom type-newtype TCase a = -  TCase {-    unTCase :: Core.Name}-  deriving (Eq, Ord, Read, Show)--_TCase = (Core.Name "hydra/phantoms.TCase")+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S --- | An association with a named term (element) with a phantom type-data TElement a = -  TElement {-    tElementName :: Core.Name,-    tElementTerm :: (TTerm a)}+-- | An association of a named term (element) with a phantom type+data TBinding a = +  TBinding {+    tBindingName :: Core.Name,+    tBindingTerm :: (TTerm a)}   deriving (Eq, Ord, Read, Show) -_TElement = (Core.Name "hydra/phantoms.TElement")--_TElement_name = (Core.Name "name")--_TElement_term = (Core.Name "term")+_TBinding = (Core.Name "hydra.phantoms.TBinding") --- | An association with a term-level field with a phantom type-newtype TField a = -  TField {-    unTField :: Core.Field}-  deriving (Eq, Ord, Read, Show)+_TBinding_name = (Core.Name "name") -_TField = (Core.Name "hydra/phantoms.TField")+_TBinding_term = (Core.Name "term")  -- | An association of a term with a phantom type newtype TTerm a = @@ -43,4 +28,4 @@     unTTerm :: Core.Term}   deriving (Eq, Ord, Read, Show) -_TTerm = (Core.Name "hydra/phantoms.TTerm")+_TTerm = (Core.Name "hydra.phantoms.TTerm")
− src/gen-main/haskell/Hydra/Printing.hs 
@@ -1,83 +0,0 @@--- | Utilities for use in transformations--module Hydra.Printing where--import qualified Hydra.Basics as Basics-import qualified Hydra.Core as Core-import qualified Hydra.Lib.Literals as Literals-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Mantle as Mantle-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Display a floating-point type as a string-describeFloatType :: (Core.FloatType -> String)-describeFloatType t = (Strings.cat [-  (\x -> describePrecision (Basics.floatTypePrecision x)) t,-  " floating-point numbers"])---- | Display an integer type as a string-describeIntegerType :: (Core.IntegerType -> String)-describeIntegerType t = (Strings.cat [-  (\x -> describePrecision (Basics.integerTypePrecision x)) t,-  " integers"])---- | Display a literal type as a string-describeLiteralType :: (Core.LiteralType -> String)-describeLiteralType x = case x of-  Core.LiteralTypeBinary -> "binary strings"-  Core.LiteralTypeBoolean -> "boolean values"-  Core.LiteralTypeFloat v289 -> (describeFloatType v289)-  Core.LiteralTypeInteger v290 -> (describeIntegerType v290)-  Core.LiteralTypeString -> "character strings"---- | Display numeric precision as a string-describePrecision :: (Mantle.Precision -> String)-describePrecision x = case x of-  Mantle.PrecisionArbitrary -> "arbitrary-precision"-  Mantle.PrecisionBits v293 -> (Strings.cat [-    Literals.showInt32 v293,-    "-bit"])---- | Display a type as a string-describeType :: (Core.Type -> String)-describeType x = case x of-  Core.TypeAnnotated v294 -> (Strings.cat [-    "annotated ",-    (describeType (Core.annotatedTypeSubject v294))])-  Core.TypeApplication _ -> "instances of an application type"-  Core.TypeLiteral v296 -> (describeLiteralType v296)-  Core.TypeFunction v297 -> (Strings.cat [-    Strings.cat [-      Strings.cat [-        "functions from ",-        (describeType (Core.functionTypeDomain v297))],-      " to "],-    (describeType (Core.functionTypeCodomain v297))])-  Core.TypeLambda _ -> "polymorphic terms"-  Core.TypeList v299 -> (Strings.cat [-    "lists of ",-    (describeType v299)])-  Core.TypeMap v300 -> (Strings.cat [-    Strings.cat [-      Strings.cat [-        "maps from ",-        (describeType (Core.mapTypeKeys v300))],-      " to "],-    (describeType (Core.mapTypeValues v300))])-  Core.TypeOptional v301 -> (Strings.cat [-    "optional ",-    (describeType v301)])-  Core.TypeProduct _ -> "tuples"-  Core.TypeRecord _ -> "records"-  Core.TypeSet v304 -> (Strings.cat [-    "sets of ",-    (describeType v304)])-  Core.TypeSum _ -> "variant tuples"-  Core.TypeUnion _ -> "unions"-  Core.TypeVariable _ -> "instances of a named type"-  Core.TypeWrap v308 -> (Strings.cat [-    "wrapper for ",-    (describeType (Core.wrappedTypeObject v308))])
src/gen-main/haskell/Hydra/Query.hs view
@@ -3,10 +3,11 @@ module Hydra.Query where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | One of several comparison operators data ComparisonConstraint = @@ -18,7 +19,7 @@   ComparisonConstraintGreaterThanOrEqual    deriving (Eq, Ord, Read, Show) -_ComparisonConstraint = (Core.Name "hydra/query.ComparisonConstraint")+_ComparisonConstraint = (Core.Name "hydra.query.ComparisonConstraint")  _ComparisonConstraint_equal = (Core.Name "equal") @@ -43,7 +44,7 @@     edgeIn :: (Maybe Core.Name)}   deriving (Eq, Ord, Read, Show) -_Edge = (Core.Name "hydra/query.Edge")+_Edge = (Core.Name "hydra.query.Edge")  _Edge_type = (Core.Name "type") @@ -60,7 +61,7 @@     graphPatternPatterns :: [Pattern]}   deriving (Eq, Ord, Read, Show) -_GraphPattern = (Core.Name "hydra/query.GraphPattern")+_GraphPattern = (Core.Name "hydra.query.GraphPattern")  _GraphPattern_graph = (Core.Name "graph") @@ -76,7 +77,7 @@   NodeWildcard    deriving (Eq, Ord, Read, Show) -_Node = (Core.Name "hydra/query.Node")+_Node = (Core.Name "hydra.query.Node")  _Node_term = (Core.Name "term") @@ -94,7 +95,7 @@   PathInverse Path   deriving (Eq, Ord, Read, Show) -_Path = (Core.Name "hydra/query.Path")+_Path = (Core.Name "hydra.query.Path")  _Path_step = (Core.Name "step") @@ -116,7 +117,7 @@   PatternGraph GraphPattern   deriving (Eq, Ord, Read, Show) -_Pattern = (Core.Name "hydra/query.Pattern")+_Pattern = (Core.Name "hydra.query.Pattern")  _Pattern_triple = (Core.Name "triple") @@ -137,7 +138,7 @@     queryPatterns :: [Pattern]}   deriving (Eq, Ord, Read, Show) -_Query = (Core.Name "hydra/query.Query")+_Query = (Core.Name "hydra.query.Query")  _Query_variables = (Core.Name "variables") @@ -150,7 +151,7 @@     rangeMax :: Int}   deriving (Eq, Ord, Read, Show) -_Range = (Core.Name "hydra/query.Range")+_Range = (Core.Name "hydra.query.Range")  _Range_min = (Core.Name "min") @@ -174,7 +175,7 @@   RegexQuantifierRange Range   deriving (Eq, Ord, Read, Show) -_RegexQuantifier = (Core.Name "hydra/query.RegexQuantifier")+_RegexQuantifier = (Core.Name "hydra.query.RegexQuantifier")  _RegexQuantifier_one = (Core.Name "one") @@ -197,7 +198,7 @@     regexSequenceQuantifier :: RegexQuantifier}   deriving (Eq, Ord, Read, Show) -_RegexSequence = (Core.Name "hydra/query.RegexSequence")+_RegexSequence = (Core.Name "hydra.query.RegexSequence")  _RegexSequence_path = (Core.Name "path") @@ -213,7 +214,7 @@   StepCompare ComparisonConstraint   deriving (Eq, Ord, Read, Show) -_Step = (Core.Name "hydra/query.Step")+_Step = (Core.Name "hydra.query.Step")  _Step_edge = (Core.Name "edge") @@ -229,7 +230,7 @@     triplePatternObject :: Node}   deriving (Eq, Ord, Read, Show) -_TriplePattern = (Core.Name "hydra/query.TriplePattern")+_TriplePattern = (Core.Name "hydra.query.TriplePattern")  _TriplePattern_subject = (Core.Name "subject") @@ -243,4 +244,4 @@     unVariable :: String}   deriving (Eq, Ord, Read, Show) -_Variable = (Core.Name "hydra/query.Variable")+_Variable = (Core.Name "hydra.query.Variable")
+ src/gen-main/haskell/Hydra/Reduction.hs view
@@ -0,0 +1,248 @@+-- | Functions for reducing terms and types, i.e. performing computations.++module Hydra.Reduction where++import qualified Hydra.Arity as Arity+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Extract.Core as Core_+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Math as Math+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Schemas as Schemas+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Alpha convert a variable in a term+alphaConvert :: (Core.Name -> Core.Name -> Core.Term -> Core.Term)+alphaConvert vold vnew term = (Rewriting.replaceFreeTermVariable vold (Core.TermVariable vnew) term)++betaReduceType :: (Core.Type -> Compute.Flow Graph.Graph Core.Type)+betaReduceType typ =  +  let mapExpr = (\recurse -> \t -> Flows.bind (recurse t) (\r -> (\x -> case x of+          Core.TypeApplication v1 -> (reduceApp v1)+          _ -> (Flows.pure r)) r)) +      reduceApp = (\app ->  +              let lhs = (Core.applicationTypeFunction app) +                  rhs = (Core.applicationTypeArgument app)+              in ((\x -> case x of+                Core.TypeAnnotated v1 -> (Flows.bind (reduceApp (Core.ApplicationType {+                  Core.applicationTypeFunction = (Core.annotatedTypeSubject v1),+                  Core.applicationTypeArgument = rhs})) (\a -> Flows.pure (Core.TypeAnnotated (Core.AnnotatedType {+                  Core.annotatedTypeSubject = a,+                  Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v1)}))))+                Core.TypeForall v1 -> (betaReduceType (Rewriting.replaceFreeTypeVariable (Core.forallTypeParameter v1) rhs (Core.forallTypeBody v1)))+                Core.TypeVariable v1 -> (Flows.bind (Schemas.requireType v1) (\t_ -> betaReduceType (Core.TypeApplication (Core.ApplicationType {+                  Core.applicationTypeFunction = t_,+                  Core.applicationTypeArgument = rhs}))))) lhs))+  in (Rewriting.rewriteTypeM mapExpr typ)++-- | Apply the special rules:+-- |     ((\x.e1) e2) == e1, where x does not appear free in e1+-- |   and+-- |      ((\x.e1) e2) = e1[x/e2]+-- | These are both limited forms of beta reduction which help to "clean up" a term without fully evaluating it.+contractTerm :: (Core.Term -> Core.Term)+contractTerm term =  +  let rewrite = (\recurse -> \t ->  +          let rec = (recurse t)+          in ((\x -> case x of+            Core.TermApplication v1 ->  +              let lhs = (Core.applicationFunction v1) +                  rhs = (Core.applicationArgument v1)+              in ((\x -> case x of+                Core.TermFunction v2 -> ((\x -> case x of+                  Core.FunctionLambda v3 ->  +                    let v = (Core.lambdaParameter v3) +                        body = (Core.lambdaBody v3)+                    in (Logic.ifElse (Rewriting.isFreeVariableInTerm v body) body (Rewriting.replaceFreeTermVariable v rhs body))+                  _ -> rec) v2)+                _ -> rec) (Rewriting.deannotateTerm lhs))+            _ -> rec) rec))+  in (Rewriting.rewriteTerm rewrite term)++countPrimitiveInvocations :: Bool+countPrimitiveInvocations = True++etaReduceTerm :: (Core.Term -> Core.Term)+etaReduceTerm term =  +  let noChange = term +      reduceLambda = (\l ->  +              let v = (Core.lambdaParameter l) +                  d = (Core.lambdaDomain l)+                  body = (Core.lambdaBody l)+              in ((\x -> case x of+                Core.TermAnnotated v1 -> (reduceLambda (Core.Lambda {+                  Core.lambdaParameter = v,+                  Core.lambdaDomain = d,+                  Core.lambdaBody = (Core.annotatedTermSubject v1)}))+                Core.TermApplication v1 ->  +                  let lhs = (Core.applicationFunction v1) +                      rhs = (Core.applicationArgument v1)+                  in ((\x -> case x of+                    Core.TermAnnotated v2 -> (reduceLambda (Core.Lambda {+                      Core.lambdaParameter = v,+                      Core.lambdaDomain = d,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = lhs,+                        Core.applicationArgument = (Core.annotatedTermSubject v2)}))}))+                    Core.TermVariable v2 -> (Logic.ifElse (Logic.and (Equality.equal (Core.unName v) (Core.unName v2)) (Logic.not (Rewriting.isFreeVariableInTerm v lhs))) (etaReduceTerm lhs) noChange)+                    _ -> noChange) (etaReduceTerm rhs))+                _ -> noChange) (etaReduceTerm body)))+  in ((\x -> case x of+    Core.TermAnnotated v1 -> (Core.TermAnnotated (Core.AnnotatedTerm {+      Core.annotatedTermSubject = (etaReduceTerm (Core.annotatedTermSubject v1)),+      Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v1)}))+    Core.TermFunction v1 -> ((\x -> case x of+      Core.FunctionLambda v2 -> (reduceLambda v2)+      _ -> noChange) v1)+    _ -> noChange) term)++-- | Recursively transform arbitrary terms like 'add 42' into terms like '\x.add 42 x', in which the implicit parameters of primitive functions and eliminations are made into explicit lambda parameters. Variable references are not expanded. This is useful for targets like Python with weaker support for currying than Hydra or Haskell. Note: this is a "trusty" function which assumes the graph is well-formed, i.e. no dangling references.+expandLambdas :: (Graph.Graph -> Core.Term -> Core.Term)+expandLambdas graph term =  +  let expand = (\args -> \arity -> \t ->  +          let apps = (Lists.foldl (\lhs -> \arg -> Core.TermApplication (Core.Application {+                  Core.applicationFunction = lhs,+                  Core.applicationArgument = arg})) t args) +              is = (Logic.ifElse (Equality.lte arity (Lists.length args)) [] (Math.range 1 (Math.sub arity (Lists.length args))))+              pad = (\indices -> \t -> Logic.ifElse (Lists.null indices) t (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name (Strings.cat2 "v" (Literals.showInt32 (Lists.head indices)))),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (pad (Lists.tail indices) (Core.TermApplication (Core.Application {+                        Core.applicationFunction = t,+                        Core.applicationArgument = (Core.TermVariable (Core.Name (Strings.cat2 "v" (Literals.showInt32 (Lists.head indices)))))})))}))))+          in (pad is apps)) +      rewrite = (\args -> \recurse -> \t ->  +              let afterRecursion = (\term -> expand args (expansionArity graph term) term)+              in ((\x -> case x of+                Core.TermApplication v1 ->  +                  let lhs = (Core.applicationFunction v1) +                      rhs = (Core.applicationArgument v1)+                      erhs = (rewrite [] recurse rhs)+                  in (rewrite (Lists.cons erhs args) recurse lhs)+                _ -> (afterRecursion (recurse t))) t))+  in (contractTerm (Rewriting.rewriteTerm (rewrite []) term))++-- | Calculate the arity for lambda expansion+expansionArity :: (Graph.Graph -> Core.Term -> Int)+expansionArity graph term = ((\x -> case x of+  Core.TermApplication v1 -> (Math.sub (expansionArity graph (Core.applicationFunction v1)) 1)+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionElimination _ -> 1+    Core.FunctionLambda _ -> 0+    Core.FunctionPrimitive v2 -> (Arity.primitiveArity (Optionals.fromJust (Lexical.lookupPrimitive graph v2)))) v1)+  Core.TermTypeLambda v1 -> (expansionArity graph (Core.typeLambdaBody v1))+  Core.TermTypeApplication v1 -> (expansionArity graph (Core.typedTermTerm v1))+  Core.TermVariable v1 -> (Optionals.maybe 0 (\ts -> Arity.typeArity (Core.typeSchemeType ts)) (Optionals.bind (Lexical.lookupElement graph v1) (\el -> Core.bindingType el)))+  _ -> 0) (Rewriting.deannotateTerm term))++-- | A term evaluation function which is alternatively lazy or eager+reduceTerm :: (Bool -> Core.Term -> Compute.Flow Graph.Graph Core.Term)+reduceTerm eager term =  +  let reduce = (\eager -> reduceTerm eager) +      doRecurse = (\eager -> \term -> Logic.and eager ((\x -> case x of+              Core.TermFunction v1 -> ((\x -> case x of+                Core.FunctionLambda _ -> False+                _ -> True) v1)+              _ -> True) term))+      reduceArg = (\eager -> \arg -> Logic.ifElse eager (Flows.pure arg) (reduce False arg))+      applyToArguments = (\fun -> \args -> Logic.ifElse (Lists.null args) fun (applyToArguments (Core.TermApplication (Core.Application {+              Core.applicationFunction = fun,+              Core.applicationArgument = (Lists.head args)})) (Lists.tail args)))+      replaceFreeTypeVariable = (\toReplace -> \replacement -> \term ->  +              let mapping = (\recurse -> \inner -> (\x -> case x of+                      Core.TermFunction v1 -> ((\x -> case x of+                        Core.FunctionLambda v2 -> (Logic.ifElse (Equality.equal (Core.lambdaParameter v2) toReplace) inner (recurse inner))+                        _ -> (recurse inner)) v1)+                      Core.TermVariable v1 -> (Logic.ifElse (Equality.equal v1 toReplace) replacement inner)+                      _ -> (recurse inner)) inner)+              in (Rewriting.rewriteTerm mapping term))+      applyElimination = (\elm -> \reducedArg -> (\x -> case x of+              Core.EliminationRecord v1 -> (Flows.bind (Core_.record (Core.projectionTypeName v1) (Rewriting.deannotateTerm reducedArg)) (\fields ->  +                let matchingFields = (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.projectionField v1)) fields)+                in (Logic.ifElse (Lists.null matchingFields) (Flows.fail (Strings.cat [+                  "no such field: ",+                  Core.unName (Core.projectionField v1),+                  " in ",+                  Core.unName (Core.projectionTypeName v1),+                  " record"])) (Flows.pure (Core.fieldTerm (Lists.head matchingFields))))))+              Core.EliminationUnion v1 -> (Flows.bind (Core_.injection (Core.caseStatementTypeName v1) reducedArg) (\field ->  +                let matchingFields = (Lists.filter (\f -> Equality.equal (Core.fieldName f) (Core.fieldName field)) (Core.caseStatementCases v1))+                in (Logic.ifElse (Lists.null matchingFields) (Optionals.maybe (Flows.fail (Strings.cat [+                  "no such field ",+                  Core.unName (Core.fieldName field),+                  " in ",+                  Core.unName (Core.caseStatementTypeName v1),+                  " case statement"])) Flows.pure (Core.caseStatementDefault v1)) (Flows.pure (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.fieldTerm (Lists.head matchingFields)),+                  Core.applicationArgument = (Core.fieldTerm field)}))))))+              Core.EliminationWrap v1 -> (Core_.wrap v1 reducedArg)) elm)+      applyIfNullary = (\eager -> \original -> \args ->  +              let stripped = (Rewriting.deannotateTerm original)+              in ((\x -> case x of+                Core.TermApplication v1 -> (applyIfNullary eager (Core.applicationFunction v1) (Lists.cons (Core.applicationArgument v1) args))+                Core.TermFunction v1 -> ((\x -> case x of+                  Core.FunctionElimination v2 -> (Logic.ifElse (Lists.null args) (Flows.pure original) ( +                    let arg = (Lists.head args) +                        remainingArgs = (Lists.tail args)+                    in (Flows.bind (reduceArg eager (Rewriting.deannotateTerm arg)) (\reducedArg -> Flows.bind (Flows.bind (applyElimination v2 reducedArg) (reduce eager)) (\reducedResult -> applyIfNullary eager reducedResult remainingArgs)))))+                  Core.FunctionLambda v2 -> (Logic.ifElse (Lists.null args) (Flows.pure original) ( +                    let param = (Core.lambdaParameter v2) +                        body = (Core.lambdaBody v2)+                        arg = (Lists.head args)+                        remainingArgs = (Lists.tail args)+                    in (Flows.bind (reduce eager (Rewriting.deannotateTerm arg)) (\reducedArg -> Flows.bind (reduce eager (replaceFreeTypeVariable param reducedArg body)) (\reducedResult -> applyIfNullary eager reducedResult remainingArgs)))))+                  Core.FunctionPrimitive v2 -> (Flows.bind (Lexical.requirePrimitive v2) (\prim ->  +                    let arity = (Arity.primitiveArity prim)+                    in (Logic.ifElse (Equality.gt arity (Lists.length args)) (Flows.pure (applyToArguments original args)) ( +                      let argList = (Lists.take arity args) +                          remainingArgs = (Lists.drop arity args)+                      in (Flows.bind (Flows.mapList (reduceArg eager) argList) (\reducedArgs -> Flows.bind (Flows.bind (Graph.primitiveImplementation prim reducedArgs) (reduce eager)) (\reducedResult -> applyIfNullary eager reducedResult remainingArgs)))))))) v1)+                Core.TermVariable _ -> (Flows.pure (applyToArguments original args))+                _ -> (Flows.pure (applyToArguments original args))) stripped))+      mapping = (\recurse -> \mid -> Flows.bind (Logic.ifElse (doRecurse eager mid) (recurse mid) (Flows.pure mid)) (\inner -> applyIfNullary eager inner []))+  in (Rewriting.rewriteTermM mapping term)++-- | Whether a term is closed, i.e. represents a complete program+termIsClosed :: (Core.Term -> Bool)+termIsClosed term = (Sets.null (Rewriting.freeVariablesInTerm term))++termIsValue :: (t0 -> Core.Term -> Bool)+termIsValue g term =  +  let forList = (\els -> Lists.foldl (\b -> \t -> Logic.and b (termIsValue g t)) True els) +      checkField = (\f -> termIsValue g (Core.fieldTerm f))+      checkFields = (\fields -> Lists.foldl (\b -> \f -> Logic.and b (checkField f)) True fields)+      functionIsValue = (\f -> (\x -> case x of+              Core.FunctionElimination v1 -> ((\x -> case x of+                Core.EliminationWrap _ -> True+                Core.EliminationRecord _ -> True+                Core.EliminationUnion v2 -> (Logic.and (checkFields (Core.caseStatementCases v2)) (Optionals.maybe True (termIsValue g) (Core.caseStatementDefault v2)))) v1)+              Core.FunctionLambda v1 -> (termIsValue g (Core.lambdaBody v1))+              Core.FunctionPrimitive _ -> True) f)+  in ((\x -> case x of+    Core.TermApplication _ -> False+    Core.TermLiteral _ -> True+    Core.TermFunction v1 -> (functionIsValue v1)+    Core.TermList v1 -> (forList v1)+    Core.TermMap v1 -> (Lists.foldl (\b -> \kv -> Logic.and b (Logic.and (termIsValue g (fst kv)) (termIsValue g (snd kv)))) True (Maps.toList v1))+    Core.TermOptional v1 -> (Optionals.maybe True (termIsValue g) v1)+    Core.TermRecord v1 -> (checkFields (Core.recordFields v1))+    Core.TermSet v1 -> (forList (Sets.toList v1))+    Core.TermUnion v1 -> (checkField (Core.injectionField v1))+    Core.TermUnit -> True+    Core.TermVariable _ -> False+    _ -> False) (Rewriting.deannotateTerm term))
+ src/gen-main/haskell/Hydra/Relational.hs view
@@ -0,0 +1,111 @@+-- | An interpretation of Codd's Relational Model, as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). Types ('domains') and values are parameterized so as to allow for application-specific implementations. No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.++module Hydra.Relational where++import qualified Hydra.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd+newtype ColumnName = +  ColumnName {+    unColumnName :: String}+  deriving (Eq, Ord, Read, Show)++_ColumnName = (Core.Name "hydra.relational.ColumnName")++-- | An abstract specification of the domain represented by a column in a relation; a role+data ColumnSchema t = +  ColumnSchema {+    -- | A unique name for the column+    columnSchemaName :: ColumnName,+    -- | The domain (type) of the column+    columnSchemaDomain :: t}+  deriving (Eq, Ord, Read, Show)++_ColumnSchema = (Core.Name "hydra.relational.ColumnSchema")++_ColumnSchema_name = (Core.Name "name")++_ColumnSchema_domain = (Core.Name "domain")++-- | A mapping from certain columns of a source relation to primary key columns of a target relation+data ForeignKey = +  ForeignKey {+    -- | The name of the target relation+    foreignKeyForeignRelation :: RelationName,+    -- | The mapping of source column names to target column names. The target column names must together make up the primary key of the target relation.+    foreignKeyKeys :: (M.Map ColumnName ColumnName)}+  deriving (Eq, Ord, Read, Show)++_ForeignKey = (Core.Name "hydra.relational.ForeignKey")++_ForeignKey_foreignRelation = (Core.Name "foreignRelation")++_ForeignKey_keys = (Core.Name "keys")++-- | A primary key of a relation, specified either as a single column, or as a list of columns+newtype PrimaryKey = +  PrimaryKey {+    unPrimaryKey :: [ColumnName]}+  deriving (Eq, Ord, Read, Show)++_PrimaryKey = (Core.Name "hydra.relational.PrimaryKey")++-- | A set of distinct n-tuples; a table+newtype Relation v = +  Relation {+    unRelation :: [Row v]}+  deriving (Eq, Ord, Read, Show)++_Relation = (Core.Name "hydra.relational.Relation")++-- | A unique relation (table) name+newtype RelationName = +  RelationName {+    unRelationName :: String}+  deriving (Eq, Ord, Read, Show)++_RelationName = (Core.Name "hydra.relational.RelationName")++-- | An abstract relation; the name and columns of a relation without its actual data+data RelationSchema t = +  RelationSchema {+    -- | A unique name for the relation+    relationSchemaName :: RelationName,+    -- | A list of column specifications+    relationSchemaColumns :: [ColumnSchema t],+    -- | Any number of primary keys for the relation, each of which must be valid for this relation+    relationSchemaPrimaryKeys :: [PrimaryKey],+    -- | Any number of foreign keys, each of which must be valid for both this relation and the target relation+    relationSchemaForeignKeys :: [ForeignKey]}+  deriving (Eq, Ord, Read, Show)++_RelationSchema = (Core.Name "hydra.relational.RelationSchema")++_RelationSchema_name = (Core.Name "name")++_RelationSchema_columns = (Core.Name "columns")++_RelationSchema_primaryKeys = (Core.Name "primaryKeys")++_RelationSchema_foreignKeys = (Core.Name "foreignKeys")++-- | A domain-unordered (string-indexed, rather than position-indexed) relation+newtype Relationship v = +  Relationship {+    unRelationship :: (S.Set (M.Map ColumnName v))}+  deriving (Eq, Ord, Read, Show)++_Relationship = (Core.Name "hydra.relational.Relationship")++-- | An n-tuple which is an element of a given relation+newtype Row v = +  Row {+    unRow :: [v]}+  deriving (Eq, Ord, Read, Show)++_Row = (Core.Name "hydra.relational.Row")
+ src/gen-main/haskell/Hydra/Rewriting.hs view
@@ -0,0 +1,916 @@+-- | Utilities for type and term rewriting and analysis.++module Hydra.Rewriting where++import qualified Hydra.Accessors as Accessors+import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+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.Math as Math+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.Names as Names+import qualified Hydra.Sorting as Sorting+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Strip type annotations from the top levels of a term+deannotateAndDetypeTerm :: (Core.Term -> Core.Term)+deannotateAndDetypeTerm t = ((\x -> case x of+  Core.TermAnnotated v1 -> (deannotateAndDetypeTerm (Core.annotatedTermSubject v1))+  Core.TermTypeApplication v1 -> (deannotateAndDetypeTerm (Core.typedTermTerm v1))+  Core.TermTypeLambda v1 -> (deannotateAndDetypeTerm (Core.typeLambdaBody v1))+  _ -> t) t)++-- | Strip all annotations (including System F type annotations) from the top levels of a term+deannotateTerm :: (Core.Term -> Core.Term)+deannotateTerm t = ((\x -> case x of+  Core.TermAnnotated v1 -> (deannotateTerm (Core.annotatedTermSubject v1))+  _ -> t) t)++-- | Strip all annotations from a term+deannotateType :: (Core.Type -> Core.Type)+deannotateType t = ((\x -> case x of+  Core.TypeAnnotated v1 -> (deannotateType (Core.annotatedTypeSubject v1))+  _ -> t) t)++-- | Strip any top-level type lambdas from a type, extracting the (possibly nested) type body+deannotateTypeParameters :: (Core.Type -> Core.Type)+deannotateTypeParameters t = ((\x -> case x of+  Core.TypeForall v1 -> (deannotateTypeParameters (Core.forallTypeBody v1))+  _ -> t) (deannotateType t))++-- | Recursively strip all annotations from a type+deannotateTypeRecursive :: (Core.Type -> Core.Type)+deannotateTypeRecursive typ =  +  let strip = (\recurse -> \typ ->  +          let rewritten = (recurse typ)+          in ((\x -> case x of+            Core.TypeAnnotated v1 -> (Core.annotatedTypeSubject v1)+            _ -> rewritten) rewritten))+  in (rewriteType strip typ)++-- | Recursively strip all annotations from a type scheme+deannotateTypeSchemeRecursive :: (Core.TypeScheme -> Core.TypeScheme)+deannotateTypeSchemeRecursive ts =  +  let vars = (Core.typeSchemeVariables ts) +      typ = (Core.typeSchemeType ts)+  in Core.TypeScheme {+    Core.typeSchemeVariables = vars,+    Core.typeSchemeType = (deannotateTypeRecursive typ)}++-- | A variation of expandLambdas which also attaches type annotations when padding function terms+expandTypedLambdas :: (Core.Term -> Core.Term)+expandTypedLambdas term =  +  let toNaryFunType = (\typ ->  +          let helper = (\t -> (\x -> case x of+                  Core.TypeFunction v1 ->  +                    let dom0 = (Core.functionTypeDomain v1) +                        cod0 = (Core.functionTypeCodomain v1)+                        recursive = (helper cod0)+                        doms = (fst recursive)+                        cod1 = (snd recursive)+                    in (Lists.cons dom0 doms, cod1)+                  _ -> ([], t)) t)+          in (helper (deannotateType typ))) +      padTerm = (\i -> \doms -> \cod -> \term -> Logic.ifElse (Lists.null doms) term ( +              let dom = (Lists.head doms) +                  var = (Core.Name (Strings.cat2 "v" (Literals.showInt32 i)))+                  tailDoms = (Lists.tail doms)+                  toFunctionType = (\doms -> \cod -> Lists.foldl (\c -> \d -> Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = d,+                          Core.functionTypeCodomain = c})) cod doms)+              in (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = var,+                Core.lambdaDomain = (Just dom),+                Core.lambdaBody = (padTerm (Math.add i 1) tailDoms cod (Core.TermApplication (Core.Application {+                  Core.applicationFunction = term,+                  Core.applicationArgument = (Core.TermVariable var)})))})))))+      expand = (\doms -> \cod -> \term -> (\x -> case x of+              Core.TermAnnotated v1 -> (Core.TermAnnotated (Core.AnnotatedTerm {+                Core.annotatedTermSubject = (expand doms cod (Core.annotatedTermSubject v1)),+                Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v1)}))+              Core.TermApplication v1 ->  +                let lhs = (Core.applicationFunction v1) +                    rhs = (Core.applicationArgument v1)+                in (rewriteTerm rewrite term)+              Core.TermFunction v1 -> ((\x -> case x of+                Core.FunctionLambda v2 -> (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                  Core.lambdaParameter = (Core.lambdaParameter v2),+                  Core.lambdaDomain = (Core.lambdaDomain v2),+                  Core.lambdaBody = (expand (Lists.tail doms) cod (Core.lambdaBody v2))})))+                _ -> (padTerm 1 doms cod term)) v1)+              Core.TermLet v1 ->  +                let expandBinding = (\b -> Core.Binding {+                        Core.bindingName = (Core.bindingName b),+                        Core.bindingTerm = (expandTypedLambdas (Core.bindingTerm b)),+                        Core.bindingType = (Core.bindingType b)})+                in (Core.TermLet (Core.Let {+                  Core.letBindings = (Lists.map expandBinding (Core.letBindings v1)),+                  Core.letEnvironment = (expand doms cod (Core.letEnvironment v1))}))+              _ -> (rewriteTerm rewrite term)) term)+      rewrite = (\recurse -> \term -> recurse term)+  in (rewriteTerm rewrite term)++-- | Flatten nested let expressions+flattenLetTerms :: (Core.Term -> Core.Term)+flattenLetTerms term =  +  let rewriteBinding = (\binding ->  +          let key0 = (Core.bindingName binding) +              val0 = (Core.bindingTerm binding)+              t = (Core.bindingType binding)+          in ((\x -> case x of+            Core.TermAnnotated v1 ->  +              let val1 = (Core.annotatedTermSubject v1) +                  ann = (Core.annotatedTermAnnotation v1)+                  recursive = (rewriteBinding (Core.Binding {+                          Core.bindingName = key0,+                          Core.bindingTerm = val1,+                          Core.bindingType = t}))+                  innerBinding = (fst recursive)+                  deps = (snd recursive)+                  val2 = (Core.bindingTerm innerBinding)+              in (Core.Binding {+                Core.bindingName = key0,+                Core.bindingTerm = (Core.TermAnnotated (Core.AnnotatedTerm {+                  Core.annotatedTermSubject = val2,+                  Core.annotatedTermAnnotation = ann})),+                Core.bindingType = t}, deps)+            Core.TermLet v1 ->  +              let bindings1 = (Core.letBindings v1) +                  body1 = (Core.letEnvironment v1)+                  prefix = (Strings.cat2 (Core.unName key0) "_")+                  qualify = (\n -> Core.Name (Strings.cat2 prefix (Core.unName n)))+                  toSubstPair = (\b -> (Core.bindingName b, (qualify (Core.bindingName b))))+                  subst = (Maps.fromList (Lists.map toSubstPair bindings1))+                  replaceVars = (substituteVariables subst)+                  newBody = (replaceVars body1)+                  newBinding = (\b -> Core.Binding {+                          Core.bindingName = (qualify (Core.bindingName b)),+                          Core.bindingTerm = (replaceVars (Core.bindingTerm b)),+                          Core.bindingType = (Core.bindingType b)})+              in (Core.Binding {+                Core.bindingName = key0,+                Core.bindingTerm = newBody,+                Core.bindingType = t}, (Lists.map newBinding bindings1))+            _ -> (Core.Binding {+              Core.bindingName = key0,+              Core.bindingTerm = val0,+              Core.bindingType = t}, [])) val0)) +      flatten = (\recurse -> \term ->  +              let rewritten = (recurse term)+              in ((\x -> case x of+                Core.TermLet v1 ->  +                  let bindings = (Core.letBindings v1) +                      body = (Core.letEnvironment v1)+                      forResult = (\hr -> Lists.cons (fst hr) (snd hr))+                      newBindings = (Lists.concat (Lists.map (\arg_ -> forResult (rewriteBinding arg_)) bindings))+                  in (Core.TermLet (Core.Let {+                    Core.letBindings = newBindings,+                    Core.letEnvironment = body}))+                _ -> rewritten) rewritten))+  in (rewriteTerm flatten term)++foldOverTerm :: (Coders.TraversalOrder -> (t0 -> Core.Term -> t0) -> t0 -> Core.Term -> t0)+foldOverTerm order fld b0 term = ((\x -> case x of+  Coders.TraversalOrderPre -> (Lists.foldl (foldOverTerm order fld) (fld b0 term) (subterms term))+  Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverTerm order fld) b0 (subterms term)) term)) order)++foldOverType :: (Coders.TraversalOrder -> (t0 -> Core.Type -> t0) -> t0 -> Core.Type -> t0)+foldOverType order fld b0 typ = ((\x -> case x of+  Coders.TraversalOrderPre -> (Lists.foldl (foldOverType order fld) (fld b0 typ) (subtypes typ))+  Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverType order fld) b0 (subtypes typ)) typ)) order)++-- | Find the free variables (i.e. variables not bound by a lambda or let) in a term+freeVariablesInTerm :: (Core.Term -> S.Set Core.Name)+freeVariablesInTerm term =  +  let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInTerm t)) Sets.empty (subterms term))+  in ((\x -> case x of+    Core.TermFunction v1 -> ((\x -> case x of+      Core.FunctionLambda v2 -> (Sets.delete (Core.lambdaParameter v2) (freeVariablesInTerm (Core.lambdaBody v2)))+      _ -> dfltVars) v1)+    Core.TermVariable v1 -> (Sets.singleton v1)+    _ -> dfltVars) term)++-- | Find the free variables (i.e. variables not bound by a lambda or let) in a type+freeVariablesInType :: (Core.Type -> S.Set Core.Name)+freeVariablesInType typ =  +  let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInType t)) Sets.empty (subtypes typ))+  in ((\x -> case x of+    Core.TypeForall v1 -> (Sets.delete (Core.forallTypeParameter v1) (freeVariablesInType (Core.forallTypeBody v1)))+    Core.TypeVariable v1 -> (Sets.singleton v1)+    _ -> dfltVars) typ)++-- | Find the free variables in a type in deterministic left-to-right order+freeVariablesInTypeOrdered :: (Core.Type -> [Core.Name])+freeVariablesInTypeOrdered typ =  +  let collectVars = (\boundVars -> \t -> (\x -> case x of+          Core.TypeVariable v1 -> (Logic.ifElse (Sets.member v1 boundVars) [] [+            v1])+          Core.TypeForall v1 -> (collectVars (Sets.insert (Core.forallTypeParameter v1) boundVars) (Core.forallTypeBody v1))+          _ -> (Lists.concat (Lists.map (collectVars boundVars) (subtypes t)))) t)+  in (Lists.nub (collectVars Sets.empty typ))++-- | Find free variables in a type scheme (simple version)+freeVariablesInTypeSchemeSimple :: (Core.TypeScheme -> S.Set Core.Name)+freeVariablesInTypeSchemeSimple ts =  +  let vars = (Core.typeSchemeVariables ts) +      t = (Core.typeSchemeType ts)+  in (Sets.difference (freeVariablesInTypeSimple t) (Sets.fromList vars))++-- | Find free variables in a type scheme+freeVariablesInTypeScheme :: (Core.TypeScheme -> S.Set Core.Name)+freeVariablesInTypeScheme ts =  +  let vars = (Core.typeSchemeVariables ts) +      t = (Core.typeSchemeType ts)+  in (Sets.difference (freeVariablesInType t) (Sets.fromList vars))++-- | Same as freeVariablesInType, but ignores the binding action of lambda types+freeVariablesInTypeSimple :: (Core.Type -> S.Set Core.Name)+freeVariablesInTypeSimple typ =  +  let helper = (\types -> \typ -> (\x -> case x of+          Core.TypeVariable v1 -> (Sets.insert v1 types)+          _ -> types) typ)+  in (foldOverType Coders.TraversalOrderPre helper Sets.empty typ)++inlineType :: (M.Map Core.Name Core.Type -> Core.Type -> Compute.Flow t0 Core.Type)+inlineType schema typ =  +  let f = (\recurse -> \typ -> Flows.bind (recurse typ) (\tr -> (\x -> case x of+          Core.TypeVariable v1 -> (Optionals.maybe (Flows.fail (Strings.cat2 "No such type in schema: " (Core.unName v1))) (inlineType schema) (Maps.lookup v1 schema))+          _ -> (Flows.pure tr)) tr))+  in (rewriteTypeM f typ)++-- | Check whether a variable is free (not bound) in a term+isFreeVariableInTerm :: (Core.Name -> Core.Term -> Bool)+isFreeVariableInTerm v term = (Logic.not (Sets.member v (freeVariablesInTerm term)))++-- | Check whether a term is a lambda, possibly nested within let and/or annotation terms+isLambda :: (Core.Term -> Bool)+isLambda term = ((\x -> case x of+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionLambda _ -> True+    _ -> False) v1)+  Core.TermLet v1 -> (isLambda (Core.letEnvironment v1))+  _ -> False) (deannotateTerm term))++-- | Apply a transformation to the first type beneath a chain of annotations+mapBeneathTypeAnnotations :: ((Core.Type -> Core.Type) -> Core.Type -> Core.Type)+mapBeneathTypeAnnotations f t = ((\x -> case x of+  Core.TypeAnnotated v1 -> (Core.TypeAnnotated (Core.AnnotatedType {+    Core.annotatedTypeSubject = (mapBeneathTypeAnnotations f (Core.annotatedTypeSubject v1)),+    Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v1)}))+  _ -> (f t)) t)++-- | Recursively replace the type variables of let bindings with the systematic type variables t0, t1, t2, ...+normalizeTypeVariablesInTerm :: (Core.Term -> Core.Term)+normalizeTypeVariablesInTerm term =  +  let substType = (\subst -> \typ ->  +          let rewrite = (\recurse -> \typ -> (\x -> case x of+                  Core.TypeVariable v1 -> (Core.TypeVariable (replaceName subst v1))+                  _ -> (recurse typ)) typ)+          in (rewriteType rewrite typ)) +      replaceName = (\subst -> \v -> Optionals.fromMaybe v (Maps.lookup v subst))+      rewriteWithSubst = (\substAndBound ->  +              let subst = (fst substAndBound) +                  boundVars = (snd substAndBound)+                  rewrite = (\recurse -> \term -> (\x -> case x of+                          Core.TermFunction v1 -> ((\x -> case x of+                            Core.FunctionElimination v2 -> ((\x -> case x of+                              Core.EliminationProduct v3 ->  +                                let arity = (Core.tupleProjectionArity v3) +                                    index = (Core.tupleProjectionIndex v3)+                                    domain = (Core.tupleProjectionDomain v3)+                                in (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                                  Core.tupleProjectionArity = arity,+                                  Core.tupleProjectionIndex = index,+                                  Core.tupleProjectionDomain = (Optionals.map (\types -> Lists.map (substType subst) types) domain)}))))+                              _ -> (recurse term)) v2)+                            Core.FunctionLambda v2 -> (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.lambdaParameter v2),+                              Core.lambdaDomain = (Optionals.map (substType subst) (Core.lambdaDomain v2)),+                              Core.lambdaBody = (rewriteWithSubst (subst, boundVars) (Core.lambdaBody v2))})))+                            _ -> (recurse term)) v1)+                          Core.TermLet v1 ->  +                            let bindings = (Core.letBindings v1) +                                env = (Core.letEnvironment v1)+                                rewriteBinding = (\b -> Optionals.maybe b (\ts ->  +                                        let vars = (Core.typeSchemeVariables ts) +                                            typ = (Core.typeSchemeType ts)+                                            varsLen = (Lists.length vars)+                                            boundVarsLen = (Sets.size boundVars)+                                            normalVariables = (Lists.map (\i -> Core.Name (Strings.cat2 "t" (Literals.showInt32 i))) (Math.range 0 (Math.add varsLen boundVarsLen)))+                                            newVars = (Lists.take (Lists.length vars) (Lists.filter (\n -> Logic.not (Sets.member n boundVars)) normalVariables))+                                            newSubst = (Maps.union (Maps.fromList (Lists.zip vars newVars)) subst)+                                            newValue = (rewriteWithSubst (newSubst, (Sets.union boundVars (Sets.fromList newVars))) (Core.bindingTerm b))+                                        in Core.Binding {+                                          Core.bindingName = (Core.bindingName b),+                                          Core.bindingTerm = newValue,+                                          Core.bindingType = (Just (Core.TypeScheme {+                                            Core.typeSchemeVariables = newVars,+                                            Core.typeSchemeType = (substType newSubst typ)}))}) (Core.bindingType b))+                            in (Core.TermLet (Core.Let {+                              Core.letBindings = (Lists.map rewriteBinding bindings),+                              Core.letEnvironment = (rewriteWithSubst (subst, boundVars) env)}))+                          Core.TermTypeApplication v1 -> (Core.TermTypeApplication (Core.TypedTerm {+                            Core.typedTermTerm = (rewriteWithSubst (subst, boundVars) (Core.typedTermTerm v1)),+                            Core.typedTermType = (substType subst (Core.typedTermType v1))}))+                          Core.TermTypeLambda v1 -> (Core.TermTypeLambda (Core.TypeLambda {+                            Core.typeLambdaParameter = (replaceName subst (Core.typeLambdaParameter v1)),+                            Core.typeLambdaBody = (rewriteWithSubst (subst, boundVars) (Core.typeLambdaBody v1))}))+                          _ -> (recurse term)) term)+              in (rewriteTerm rewrite))+  in (rewriteWithSubst (Maps.empty, Sets.empty) term)++-- | Recursively remove term annotations, including within subterms+removeTermAnnotations :: (Core.Term -> Core.Term)+removeTermAnnotations term =  +  let remove = (\recurse -> \term ->  +          let rewritten = (recurse term)+          in ((\x -> case x of+            Core.TermAnnotated v1 -> (Core.annotatedTermSubject v1)+            _ -> rewritten) term))+  in (rewriteTerm remove term)++-- | Recursively remove type annotations, including within subtypes+removeTypeAnnotations :: (Core.Type -> Core.Type)+removeTypeAnnotations typ =  +  let remove = (\recurse -> \typ ->  +          let rewritten = (recurse typ)+          in ((\x -> case x of+            Core.TypeAnnotated v1 -> (Core.annotatedTypeSubject v1)+            _ -> rewritten) rewritten))+  in (rewriteType remove typ)++-- | Strip type annotations from terms while preserving other annotations+removeTypesFromTerm :: (Core.Term -> Core.Term)+removeTypesFromTerm term =  +  let strip = (\recurse -> \term ->  +          let rewritten = (recurse term) +              stripBinding = (\b -> Core.Binding {+                      Core.bindingName = (Core.bindingName b),+                      Core.bindingTerm = (Core.bindingTerm b),+                      Core.bindingType = Nothing})+          in ((\x -> case x of+            Core.TermFunction v1 -> ((\x -> case x of+              Core.FunctionElimination v2 -> ((\x -> case x of+                Core.EliminationProduct v3 -> (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                  Core.tupleProjectionArity = (Core.tupleProjectionIndex v3),+                  Core.tupleProjectionIndex = (Core.tupleProjectionArity v3),+                  Core.tupleProjectionDomain = Nothing}))))+                _ -> (Core.TermFunction (Core.FunctionElimination v2))) v2)+              Core.FunctionLambda v2 -> (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = (Core.lambdaParameter v2),+                Core.lambdaDomain = Nothing,+                Core.lambdaBody = (Core.lambdaBody v2)})))+              _ -> (Core.TermFunction v1)) v1)+            Core.TermLet v1 -> (Core.TermLet (Core.Let {+              Core.letBindings = (Lists.map stripBinding (Core.letBindings v1)),+              Core.letEnvironment = (Core.letEnvironment v1)}))+            Core.TermTypeApplication v1 -> (Core.typedTermTerm v1)+            Core.TermTypeLambda v1 -> (Core.typeLambdaBody v1)+            _ -> rewritten) rewritten))+  in (rewriteTerm strip term)++-- | Replace a free variable in a term+replaceFreeTermVariable :: (Core.Name -> Core.Term -> Core.Term -> Core.Term)+replaceFreeTermVariable vold tnew term =  +  let rewrite = (\recurse -> \t -> (\x -> case x of+          Core.TermFunction v1 -> ((\x -> case x of+            Core.FunctionLambda v2 ->  +              let v = (Core.lambdaParameter v2)+              in (Logic.ifElse (Equality.equal v vold) t (recurse t))+            _ -> (recurse t)) v1)+          Core.TermVariable v1 -> (Logic.ifElse (Equality.equal v1 vold) tnew (Core.TermVariable v1))+          _ -> (recurse t)) t)+  in (rewriteTerm rewrite term)++-- | Replace free occurrences of a name in a type+replaceFreeTypeVariable :: (Core.Name -> Core.Type -> Core.Type -> Core.Type)+replaceFreeTypeVariable v rep typ =  +  let mapExpr = (\recurse -> \t -> (\x -> case x of+          Core.TypeForall v1 -> (Logic.ifElse (Equality.equal v (Core.forallTypeParameter v1)) t (Core.TypeForall (Core.ForallType {+            Core.forallTypeParameter = (Core.forallTypeParameter v1),+            Core.forallTypeBody = (recurse (Core.forallTypeBody v1))})))+          Core.TypeVariable v1 -> (Logic.ifElse (Equality.equal v v1) rep t)+          _ -> (recurse t)) t)+  in (rewriteType mapExpr typ)++rewrite :: ((t0 -> t1) -> (t1 -> t0) -> t0)+rewrite fsub f =  +  let recurse = (f (fsub recurse))+  in recurse++rewriteTerm :: (((Core.Term -> Core.Term) -> Core.Term -> Core.Term) -> Core.Term -> Core.Term)+rewriteTerm f =  +  let fsub = (\recurse -> \term ->  +          let forElimination = (\elm -> (\x -> case x of+                  Core.EliminationProduct v1 -> (Core.EliminationProduct v1)+                  Core.EliminationRecord v1 -> (Core.EliminationRecord v1)+                  Core.EliminationUnion v1 -> (Core.EliminationUnion (Core.CaseStatement {+                    Core.caseStatementTypeName = (Core.caseStatementTypeName v1),+                    Core.caseStatementDefault = (Optionals.map recurse (Core.caseStatementDefault v1)),+                    Core.caseStatementCases = (Lists.map forField (Core.caseStatementCases v1))}))+                  Core.EliminationWrap v1 -> (Core.EliminationWrap v1)) elm) +              forField = (\f -> Core.Field {+                      Core.fieldName = (Core.fieldName f),+                      Core.fieldTerm = (recurse (Core.fieldTerm f))})+              forFunction = (\fun -> (\x -> case x of+                      Core.FunctionElimination v1 -> (Core.FunctionElimination (forElimination v1))+                      Core.FunctionLambda v1 -> (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.lambdaParameter v1),+                        Core.lambdaDomain = (Core.lambdaDomain v1),+                        Core.lambdaBody = (recurse (Core.lambdaBody v1))}))+                      Core.FunctionPrimitive v1 -> (Core.FunctionPrimitive v1)) fun)+              forLet = (\lt ->  +                      let mapBinding = (\b -> Core.Binding {+                              Core.bindingName = (Core.bindingName b),+                              Core.bindingTerm = (recurse (Core.bindingTerm b)),+                              Core.bindingType = (Core.bindingType b)})+                      in Core.Let {+                        Core.letBindings = (Lists.map mapBinding (Core.letBindings lt)),+                        Core.letEnvironment = (recurse (Core.letEnvironment lt))})+              forMap = (\m ->  +                      let forPair = (\p -> (recurse (fst p), (recurse (snd p))))+                      in (Maps.fromList (Lists.map forPair (Maps.toList m))))+          in ((\x -> case x of+            Core.TermAnnotated v1 -> (Core.TermAnnotated (Core.AnnotatedTerm {+              Core.annotatedTermSubject = (recurse (Core.annotatedTermSubject v1)),+              Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v1)}))+            Core.TermApplication v1 -> (Core.TermApplication (Core.Application {+              Core.applicationFunction = (recurse (Core.applicationFunction v1)),+              Core.applicationArgument = (recurse (Core.applicationArgument v1))}))+            Core.TermFunction v1 -> (Core.TermFunction (forFunction v1))+            Core.TermLet v1 -> (Core.TermLet (forLet v1))+            Core.TermList v1 -> (Core.TermList (Lists.map recurse v1))+            Core.TermLiteral v1 -> (Core.TermLiteral v1)+            Core.TermMap v1 -> (Core.TermMap (forMap v1))+            Core.TermWrap v1 -> (Core.TermWrap (Core.WrappedTerm {+              Core.wrappedTermTypeName = (Core.wrappedTermTypeName v1),+              Core.wrappedTermObject = (recurse (Core.wrappedTermObject v1))}))+            Core.TermOptional v1 -> (Core.TermOptional (Optionals.map recurse v1))+            Core.TermProduct v1 -> (Core.TermProduct (Lists.map recurse v1))+            Core.TermRecord v1 -> (Core.TermRecord (Core.Record {+              Core.recordTypeName = (Core.recordTypeName v1),+              Core.recordFields = (Lists.map forField (Core.recordFields v1))}))+            Core.TermSet v1 -> (Core.TermSet (Sets.fromList (Lists.map recurse (Sets.toList v1))))+            Core.TermSum v1 -> (Core.TermSum (Core.Sum {+              Core.sumIndex = (Core.sumIndex v1),+              Core.sumSize = (Core.sumSize v1),+              Core.sumTerm = (recurse (Core.sumTerm v1))}))+            Core.TermTypeApplication v1 -> (Core.TermTypeApplication (Core.TypedTerm {+              Core.typedTermTerm = (recurse (Core.typedTermTerm v1)),+              Core.typedTermType = (Core.typedTermType v1)}))+            Core.TermTypeLambda v1 -> (Core.TermTypeLambda (Core.TypeLambda {+              Core.typeLambdaParameter = (Core.typeLambdaParameter v1),+              Core.typeLambdaBody = (recurse (Core.typeLambdaBody v1))}))+            Core.TermUnion v1 -> (Core.TermUnion (Core.Injection {+              Core.injectionTypeName = (Core.injectionTypeName v1),+              Core.injectionField = (forField (Core.injectionField v1))}))+            Core.TermUnit -> Core.TermUnit+            Core.TermVariable v1 -> (Core.TermVariable v1)) term))+  in (rewrite fsub f)++rewriteTermM :: (((Core.Term -> Compute.Flow t0 Core.Term) -> Core.Term -> Compute.Flow t0 Core.Term) -> Core.Term -> Compute.Flow t0 Core.Term)+rewriteTermM f =  +  let fsub = (\recurse -> \term ->  +          let forField = (\f -> Flows.map (\t -> Core.Field {+                  Core.fieldName = (Core.fieldName f),+                  Core.fieldTerm = t}) (recurse (Core.fieldTerm f))) +              forPair = (\kv ->  +                      let k = (fst kv) +                          v = (snd kv)+                      in (Flows.bind (recurse k) (\km -> Flows.bind (recurse v) (\vm -> Flows.pure (km, vm)))))+              mapBinding = (\binding ->  +                      let k = (Core.bindingName binding) +                          v = (Core.bindingTerm binding)+                          t = (Core.bindingType binding)+                      in (Flows.bind (recurse v) (\v_ -> Flows.pure (Core.Binding {+                        Core.bindingName = k,+                        Core.bindingTerm = v_,+                        Core.bindingType = t}))))+          in ((\x -> case x of+            Core.TermAnnotated v1 -> (Flows.bind (recurse (Core.annotatedTermSubject v1)) (\ex -> Flows.pure (Core.TermAnnotated (Core.AnnotatedTerm {+              Core.annotatedTermSubject = ex,+              Core.annotatedTermAnnotation = (Core.annotatedTermAnnotation v1)}))))+            Core.TermApplication v1 -> (Flows.bind (recurse (Core.applicationFunction v1)) (\lhs -> Flows.bind (recurse (Core.applicationArgument v1)) (\rhs -> Flows.pure (Core.TermApplication (Core.Application {+              Core.applicationFunction = lhs,+              Core.applicationArgument = rhs})))))+            Core.TermFunction v1 -> (Flows.bind ((\x -> case x of+              Core.FunctionElimination v2 -> ((\x -> case x of+                Core.EliminationProduct v3 -> (Flows.pure (Core.FunctionElimination (Core.EliminationProduct v3)))+                Core.EliminationRecord v3 -> (Flows.pure (Core.FunctionElimination (Core.EliminationRecord v3)))+                Core.EliminationUnion v3 ->  +                  let n = (Core.caseStatementTypeName v3) +                      def = (Core.caseStatementDefault v3)+                      cases = (Core.caseStatementCases v3)+                  in (Flows.bind (Optionals.maybe (Flows.pure Nothing) (\t -> Flows.map Optionals.pure (recurse t)) def) (\rdef -> Flows.map (\rcases -> Core.FunctionElimination (Core.EliminationUnion (Core.CaseStatement {+                    Core.caseStatementTypeName = n,+                    Core.caseStatementDefault = rdef,+                    Core.caseStatementCases = rcases}))) (Flows.mapList forField cases)))+                Core.EliminationWrap v3 -> (Flows.pure (Core.FunctionElimination (Core.EliminationWrap v3)))) v2)+              Core.FunctionLambda v2 ->  +                let v = (Core.lambdaParameter v2) +                    d = (Core.lambdaDomain v2)+                    body = (Core.lambdaBody v2)+                in (Flows.bind (recurse body) (\rbody -> Flows.pure (Core.FunctionLambda (Core.Lambda {+                  Core.lambdaParameter = v,+                  Core.lambdaDomain = d,+                  Core.lambdaBody = rbody}))))+              Core.FunctionPrimitive v2 -> (Flows.pure (Core.FunctionPrimitive v2))) v1) (\rfun -> Flows.pure (Core.TermFunction rfun)))+            Core.TermLet v1 ->  +              let bindings = (Core.letBindings v1) +                  env = (Core.letEnvironment v1)+              in (Flows.bind (Flows.mapList mapBinding bindings) (\rbindings -> Flows.bind (recurse env) (\renv -> Flows.pure (Core.TermLet (Core.Let {+                Core.letBindings = rbindings,+                Core.letEnvironment = renv})))))+            Core.TermList v1 -> (Flows.bind (Flows.mapList recurse v1) (\rels -> Flows.pure (Core.TermList rels)))+            Core.TermLiteral v1 -> (Flows.pure (Core.TermLiteral v1))+            Core.TermMap v1 -> (Flows.bind (Flows.mapList forPair (Maps.toList v1)) (\pairs -> Flows.pure (Core.TermMap (Maps.fromList pairs))))+            Core.TermOptional v1 -> (Flows.bind (Flows.mapOptional recurse v1) (\rm -> Flows.pure (Core.TermOptional rm)))+            Core.TermProduct v1 -> (Flows.map (\rtuple -> Core.TermProduct rtuple) (Flows.mapList recurse v1))+            Core.TermRecord v1 ->  +              let n = (Core.recordTypeName v1) +                  fields = (Core.recordFields v1)+              in (Flows.map (\rfields -> Core.TermRecord (Core.Record {+                Core.recordTypeName = n,+                Core.recordFields = rfields})) (Flows.mapList forField fields))+            Core.TermSet v1 -> (Flows.bind (Flows.mapList recurse (Sets.toList v1)) (\rlist -> Flows.pure (Core.TermSet (Sets.fromList rlist))))+            Core.TermSum v1 ->  +              let i = (Core.sumIndex v1) +                  s = (Core.sumSize v1)+                  trm = (Core.sumTerm v1)+              in (Flows.bind (recurse trm) (\rtrm -> Flows.pure (Core.TermSum (Core.Sum {+                Core.sumIndex = i,+                Core.sumSize = s,+                Core.sumTerm = rtrm}))))+            Core.TermTypeApplication v1 -> (Flows.bind (recurse (Core.typedTermTerm v1)) (\t -> Flows.pure (Core.TermTypeApplication (Core.TypedTerm {+              Core.typedTermTerm = t,+              Core.typedTermType = (Core.typedTermType v1)}))))+            Core.TermTypeLambda v1 ->  +              let v = (Core.typeLambdaParameter v1) +                  body = (Core.typeLambdaBody v1)+              in (Flows.bind (recurse body) (\rbody -> Flows.pure (Core.TermTypeLambda (Core.TypeLambda {+                Core.typeLambdaParameter = v,+                Core.typeLambdaBody = rbody}))))+            Core.TermUnion v1 ->  +              let n = (Core.injectionTypeName v1) +                  field = (Core.injectionField v1)+              in (Flows.map (\rfield -> Core.TermUnion (Core.Injection {+                Core.injectionTypeName = n,+                Core.injectionField = rfield})) (forField field))+            Core.TermUnit -> (Flows.pure Core.TermUnit)+            Core.TermVariable v1 -> (Flows.pure (Core.TermVariable v1))+            Core.TermWrap v1 ->  +              let name = (Core.wrappedTermTypeName v1) +                  t = (Core.wrappedTermObject v1)+              in (Flows.bind (recurse t) (\rt -> Flows.pure (Core.TermWrap (Core.WrappedTerm {+                Core.wrappedTermTypeName = name,+                Core.wrappedTermObject = rt}))))) term))+  in (rewrite fsub f)++rewriteType :: (((Core.Type -> Core.Type) -> Core.Type -> Core.Type) -> Core.Type -> Core.Type)+rewriteType f =  +  let fsub = (\recurse -> \typ ->  +          let forField = (\f -> Core.FieldType {+                  Core.fieldTypeName = (Core.fieldTypeName f),+                  Core.fieldTypeType = (recurse (Core.fieldTypeType f))})+          in ((\x -> case x of+            Core.TypeAnnotated v1 -> (Core.TypeAnnotated (Core.AnnotatedType {+              Core.annotatedTypeSubject = (recurse (Core.annotatedTypeSubject v1)),+              Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v1)}))+            Core.TypeApplication v1 -> (Core.TypeApplication (Core.ApplicationType {+              Core.applicationTypeFunction = (recurse (Core.applicationTypeFunction v1)),+              Core.applicationTypeArgument = (recurse (Core.applicationTypeArgument v1))}))+            Core.TypeFunction v1 -> (Core.TypeFunction (Core.FunctionType {+              Core.functionTypeDomain = (recurse (Core.functionTypeDomain v1)),+              Core.functionTypeCodomain = (recurse (Core.functionTypeCodomain v1))}))+            Core.TypeForall v1 -> (Core.TypeForall (Core.ForallType {+              Core.forallTypeParameter = (Core.forallTypeParameter v1),+              Core.forallTypeBody = (recurse (Core.forallTypeBody v1))}))+            Core.TypeList v1 -> (Core.TypeList (recurse v1))+            Core.TypeLiteral v1 -> (Core.TypeLiteral v1)+            Core.TypeMap v1 -> (Core.TypeMap (Core.MapType {+              Core.mapTypeKeys = (recurse (Core.mapTypeKeys v1)),+              Core.mapTypeValues = (recurse (Core.mapTypeValues v1))}))+            Core.TypeOptional v1 -> (Core.TypeOptional (recurse v1))+            Core.TypeProduct v1 -> (Core.TypeProduct (Lists.map recurse v1))+            Core.TypeRecord v1 -> (Core.TypeRecord (Core.RowType {+              Core.rowTypeTypeName = (Core.rowTypeTypeName v1),+              Core.rowTypeFields = (Lists.map forField (Core.rowTypeFields v1))}))+            Core.TypeSet v1 -> (Core.TypeSet (recurse v1))+            Core.TypeSum v1 -> (Core.TypeSum (Lists.map recurse v1))+            Core.TypeUnion v1 -> (Core.TypeUnion (Core.RowType {+              Core.rowTypeTypeName = (Core.rowTypeTypeName v1),+              Core.rowTypeFields = (Lists.map forField (Core.rowTypeFields v1))}))+            Core.TypeUnit -> Core.TypeUnit+            Core.TypeVariable v1 -> (Core.TypeVariable v1)+            Core.TypeWrap v1 -> (Core.TypeWrap (Core.WrappedType {+              Core.wrappedTypeTypeName = (Core.wrappedTypeTypeName v1),+              Core.wrappedTypeObject = (recurse (Core.wrappedTypeObject v1))}))) typ))+  in (rewrite fsub f)++rewriteTypeM :: (((Core.Type -> Compute.Flow t0 Core.Type) -> Core.Type -> Compute.Flow t0 Core.Type) -> Core.Type -> Compute.Flow t0 Core.Type)+rewriteTypeM =  +  let fsub = (\recurse -> \typ -> (\x -> case x of+          Core.TypeAnnotated v1 -> (Flows.bind (recurse (Core.annotatedTypeSubject v1)) (\t -> Flows.pure (Core.TypeAnnotated (Core.AnnotatedType {+            Core.annotatedTypeSubject = t,+            Core.annotatedTypeAnnotation = (Core.annotatedTypeAnnotation v1)}))))+          Core.TypeApplication v1 -> (Flows.bind (recurse (Core.applicationTypeFunction v1)) (\lhs -> Flows.bind (recurse (Core.applicationTypeArgument v1)) (\rhs -> Flows.pure (Core.TypeApplication (Core.ApplicationType {+            Core.applicationTypeFunction = lhs,+            Core.applicationTypeArgument = rhs})))))+          Core.TypeFunction v1 -> (Flows.bind (recurse (Core.functionTypeDomain v1)) (\dom -> Flows.bind (recurse (Core.functionTypeCodomain v1)) (\cod -> Flows.pure (Core.TypeFunction (Core.FunctionType {+            Core.functionTypeDomain = dom,+            Core.functionTypeCodomain = cod})))))+          Core.TypeForall v1 -> (Flows.bind (recurse (Core.forallTypeBody v1)) (\b -> Flows.pure (Core.TypeForall (Core.ForallType {+            Core.forallTypeParameter = (Core.forallTypeParameter v1),+            Core.forallTypeBody = b}))))+          Core.TypeList v1 -> (Flows.bind (recurse v1) (\rt -> Flows.pure (Core.TypeList rt)))+          Core.TypeLiteral v1 -> (Flows.pure (Core.TypeLiteral v1))+          Core.TypeMap v1 -> (Flows.bind (recurse (Core.mapTypeKeys v1)) (\kt -> Flows.bind (recurse (Core.mapTypeValues v1)) (\vt -> Flows.pure (Core.TypeMap (Core.MapType {+            Core.mapTypeKeys = kt,+            Core.mapTypeValues = vt})))))+          Core.TypeOptional v1 -> (Flows.bind (recurse v1) (\rt -> Flows.pure (Core.TypeOptional rt)))+          Core.TypeProduct v1 -> (Flows.bind (Flows.mapList recurse v1) (\rtypes -> Flows.pure (Core.TypeProduct rtypes)))+          Core.TypeRecord v1 ->  +            let name = (Core.rowTypeTypeName v1) +                fields = (Core.rowTypeFields v1)+                forField = (\f -> Flows.bind (recurse (Core.fieldTypeType f)) (\t -> Flows.pure (Core.FieldType {+                        Core.fieldTypeName = (Core.fieldTypeName f),+                        Core.fieldTypeType = t})))+            in (Flows.bind (Flows.mapList forField fields) (\rfields -> Flows.pure (Core.TypeRecord (Core.RowType {+              Core.rowTypeTypeName = name,+              Core.rowTypeFields = rfields}))))+          Core.TypeSet v1 -> (Flows.bind (recurse v1) (\rt -> Flows.pure (Core.TypeSet rt)))+          Core.TypeSum v1 -> (Flows.bind (Flows.mapList recurse v1) (\rtypes -> Flows.pure (Core.TypeSum rtypes)))+          Core.TypeUnion v1 ->  +            let name = (Core.rowTypeTypeName v1) +                fields = (Core.rowTypeFields v1)+                forField = (\f -> Flows.bind (recurse (Core.fieldTypeType f)) (\t -> Flows.pure (Core.FieldType {+                        Core.fieldTypeName = (Core.fieldTypeName f),+                        Core.fieldTypeType = t})))+            in (Flows.bind (Flows.mapList forField fields) (\rfields -> Flows.pure (Core.TypeUnion (Core.RowType {+              Core.rowTypeTypeName = name,+              Core.rowTypeFields = rfields}))))+          Core.TypeUnit -> (Flows.pure Core.TypeUnit)+          Core.TypeVariable v1 -> (Flows.pure (Core.TypeVariable v1))+          Core.TypeWrap v1 -> (Flows.bind (recurse (Core.wrappedTypeObject v1)) (\t -> Flows.pure (Core.TypeWrap (Core.WrappedType {+            Core.wrappedTypeTypeName = (Core.wrappedTypeTypeName v1),+            Core.wrappedTypeObject = t}))))) typ)+  in (\f -> rewrite fsub f)++-- | Simplify terms by applying beta reduction where possible+simplifyTerm :: (Core.Term -> Core.Term)+simplifyTerm term =  +  let simplify = (\recurse -> \term ->  +          let stripped = (deannotateTerm term)+          in (recurse ((\x -> case x of+            Core.TermApplication v1 ->  +              let lhs = (Core.applicationFunction v1) +                  rhs = (Core.applicationArgument v1)+                  strippedLhs = (deannotateTerm lhs)+              in ((\x -> case x of+                Core.TermFunction v2 -> ((\x -> case x of+                  Core.FunctionLambda v3 ->  +                    let var = (Core.lambdaParameter v3) +                        body = (Core.lambdaBody v3)+                    in (Logic.ifElse (Sets.member var (freeVariablesInTerm body)) ( +                      let strippedRhs = (deannotateTerm rhs)+                      in ((\x -> case x of+                        Core.TermVariable v4 -> (simplifyTerm (substituteVariable var v4 body))+                        _ -> term) strippedRhs)) (simplifyTerm body))+                  _ -> term) v2)+                _ -> term) strippedLhs)+            _ -> term) stripped)))+  in (rewriteTerm simplify term)++-- | Substitute type variables in a type+substituteTypeVariables :: (M.Map Core.Name Core.Name -> Core.Type -> Core.Type)+substituteTypeVariables subst typ =  +  let replace = (\recurse -> \typ -> (\x -> case x of+          Core.TypeVariable v1 -> (Core.TypeVariable (Optionals.fromMaybe v1 (Maps.lookup v1 subst)))+          _ -> (recurse typ)) typ)+  in (rewriteType replace typ)++-- | Substitute one variable for another in a term+substituteVariable :: (Core.Name -> Core.Name -> Core.Term -> Core.Term)+substituteVariable from to term =  +  let replace = (\recurse -> \term -> (\x -> case x of+          Core.TermVariable v1 -> (Core.TermVariable (Logic.ifElse (Equality.equal v1 from) to v1))+          Core.TermFunction v1 -> ((\x -> case x of+            Core.FunctionLambda v2 -> (Logic.ifElse (Equality.equal (Core.lambdaParameter v2) from) term (recurse term))+            _ -> (recurse term)) v1)+          _ -> (recurse term)) term)+  in (rewriteTerm replace term)++-- | Substitute multiple variables in a term+substituteVariables :: (M.Map Core.Name Core.Name -> Core.Term -> Core.Term)+substituteVariables subst term =  +  let replace = (\recurse -> \term -> (\x -> case x of+          Core.TermVariable v1 -> (Core.TermVariable (Optionals.fromMaybe v1 (Maps.lookup v1 subst)))+          Core.TermFunction v1 -> ((\x -> case x of+            Core.FunctionLambda v2 -> (Optionals.maybe (recurse term) (\_ -> term) (Maps.lookup (Core.lambdaParameter v2) subst))+            _ -> (recurse term)) v1)+          _ -> (recurse term)) term)+  in (rewriteTerm replace term)++-- | Find the children of a given term+subterms :: (Core.Term -> [Core.Term])+subterms x = case x of+  Core.TermAnnotated v1 -> [+    Core.annotatedTermSubject v1]+  Core.TermApplication v1 -> [+    Core.applicationFunction v1,+    (Core.applicationArgument v1)]+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionElimination v2 -> ((\x -> case x of+      Core.EliminationUnion v3 -> (Lists.concat2 (Optionals.maybe [] (\t -> [+        t]) (Core.caseStatementDefault v3)) (Lists.map Core.fieldTerm (Core.caseStatementCases v3)))+      _ -> []) v2)+    Core.FunctionLambda v2 -> [+      Core.lambdaBody v2]+    _ -> []) v1)+  Core.TermLet v1 -> (Lists.cons (Core.letEnvironment v1) (Lists.map Core.bindingTerm (Core.letBindings v1)))+  Core.TermList v1 -> v1+  Core.TermLiteral _ -> []+  Core.TermMap v1 -> (Lists.concat (Lists.map (\p -> [+    fst p,+    (snd p)]) (Maps.toList v1)))+  Core.TermOptional v1 -> (Optionals.maybe [] (\t -> [+    t]) v1)+  Core.TermProduct v1 -> v1+  Core.TermRecord v1 -> (Lists.map Core.fieldTerm (Core.recordFields v1))+  Core.TermSet v1 -> (Sets.toList v1)+  Core.TermSum v1 -> [+    Core.sumTerm v1]+  Core.TermTypeApplication v1 -> [+    Core.typedTermTerm v1]+  Core.TermTypeLambda v1 -> [+    Core.typeLambdaBody v1]+  Core.TermUnion v1 -> [+    Core.fieldTerm (Core.injectionField v1)]+  Core.TermUnit -> []+  Core.TermVariable _ -> []+  Core.TermWrap v1 -> [+    Core.wrappedTermObject v1]++-- | Find the children of a given term+subtermsWithAccessors :: (Core.Term -> [(Accessors.TermAccessor, Core.Term)])+subtermsWithAccessors x = case x of+  Core.TermAnnotated v1 -> [+    (Accessors.TermAccessorAnnotatedSubject, (Core.annotatedTermSubject v1))]+  Core.TermApplication v1 -> [+    (Accessors.TermAccessorApplicationFunction, (Core.applicationFunction v1)),+    (Accessors.TermAccessorApplicationArgument, (Core.applicationArgument v1))]+  Core.TermFunction v1 -> ((\x -> case x of+    Core.FunctionElimination v2 -> ((\x -> case x of+      Core.EliminationUnion v3 -> (Lists.concat2 (Optionals.maybe [] (\t -> [+        (Accessors.TermAccessorUnionCasesDefault, t)]) (Core.caseStatementDefault v3)) (Lists.map (\f -> (Accessors.TermAccessorUnionCasesBranch (Core.fieldName f), (Core.fieldTerm f))) (Core.caseStatementCases v3)))+      _ -> []) v2)+    Core.FunctionLambda v2 -> [+      (Accessors.TermAccessorLambdaBody, (Core.lambdaBody v2))]+    _ -> []) v1)+  Core.TermLet v1 -> (Lists.cons (Accessors.TermAccessorLetEnvironment, (Core.letEnvironment v1)) (Lists.map (\b -> (Accessors.TermAccessorLetBinding (Core.bindingName b), (Core.bindingTerm b))) (Core.letBindings v1)))+  Core.TermList v1 -> (Lists.map (\e -> (Accessors.TermAccessorListElement 0, e)) v1)+  Core.TermLiteral _ -> []+  Core.TermMap v1 -> (Lists.concat (Lists.map (\p -> [+    (Accessors.TermAccessorMapKey 0, (fst p)),+    (Accessors.TermAccessorMapValue 0, (snd p))]) (Maps.toList v1)))+  Core.TermOptional v1 -> (Optionals.maybe [] (\t -> [+    (Accessors.TermAccessorOptionalTerm, t)]) v1)+  Core.TermProduct v1 -> (Lists.map (\e -> (Accessors.TermAccessorProductTerm 0, e)) v1)+  Core.TermRecord v1 -> (Lists.map (\f -> (Accessors.TermAccessorRecordField (Core.fieldName f), (Core.fieldTerm f))) (Core.recordFields v1))+  Core.TermSet v1 -> (Lists.map (\e -> (Accessors.TermAccessorListElement 0, e)) (Sets.toList v1))+  Core.TermSum v1 -> [+    (Accessors.TermAccessorSumTerm, (Core.sumTerm v1))]+  Core.TermTypeApplication v1 -> [+    (Accessors.TermAccessorTypeApplicationTerm, (Core.typedTermTerm v1))]+  Core.TermTypeLambda v1 -> [+    (Accessors.TermAccessorTypeLambdaBody, (Core.typeLambdaBody v1))]+  Core.TermUnion v1 -> [+    (Accessors.TermAccessorInjectionTerm, (Core.fieldTerm (Core.injectionField v1)))]+  Core.TermUnit -> []+  Core.TermVariable _ -> []+  Core.TermWrap v1 -> [+    (Accessors.TermAccessorWrappedTerm, (Core.wrappedTermObject v1))]++-- | Find the children of a given type expression+subtypes :: (Core.Type -> [Core.Type])+subtypes x = case x of+  Core.TypeAnnotated v1 -> [+    Core.annotatedTypeSubject v1]+  Core.TypeApplication v1 -> [+    Core.applicationTypeFunction v1,+    (Core.applicationTypeArgument v1)]+  Core.TypeFunction v1 -> [+    Core.functionTypeDomain v1,+    (Core.functionTypeCodomain v1)]+  Core.TypeForall v1 -> [+    Core.forallTypeBody v1]+  Core.TypeList v1 -> [+    v1]+  Core.TypeLiteral _ -> []+  Core.TypeMap v1 -> [+    Core.mapTypeKeys v1,+    (Core.mapTypeValues v1)]+  Core.TypeOptional v1 -> [+    v1]+  Core.TypeProduct v1 -> v1+  Core.TypeRecord v1 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v1))+  Core.TypeSet v1 -> [+    v1]+  Core.TypeSum v1 -> v1+  Core.TypeUnion v1 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v1))+  Core.TypeUnit -> []+  Core.TypeVariable _ -> []+  Core.TypeWrap v1 -> [+    Core.wrappedTypeObject v1]++-- | Note: does not distinguish between bound and free variables; use freeVariablesInTerm for that+termDependencyNames :: (Bool -> Bool -> Bool -> Core.Term -> S.Set Core.Name)+termDependencyNames binds withPrims withNoms =  +  let addNames = (\names -> \term ->  +          let nominal = (\name -> Logic.ifElse withNoms (Sets.insert name names) names) +              prim = (\name -> Logic.ifElse withPrims (Sets.insert name names) names)+              var = (\name -> Logic.ifElse binds (Sets.insert name names) names)+          in ((\x -> case x of+            Core.TermFunction v1 -> ((\x -> case x of+              Core.FunctionPrimitive v2 -> (prim v2)+              Core.FunctionElimination v2 -> ((\x -> case x of+                Core.EliminationRecord v3 -> (nominal (Core.projectionTypeName v3))+                Core.EliminationUnion v3 -> (nominal (Core.caseStatementTypeName v3))+                Core.EliminationWrap v3 -> (nominal v3)+                _ -> names) v2)+              _ -> names) v1)+            Core.TermRecord v1 -> (nominal (Core.recordTypeName v1))+            Core.TermUnion v1 -> (nominal (Core.injectionTypeName v1))+            Core.TermVariable v1 -> (var v1)+            Core.TermWrap v1 -> (nominal (Core.wrappedTermTypeName v1))+            _ -> names) term))+  in (foldOverTerm Coders.TraversalOrderPre addNames Sets.empty)++-- | Generate short names from a list of fully qualified names+toShortNames :: ([Core.Name] -> M.Map Core.Name Core.Name)+toShortNames original =  +  let groupNamesByLocal = (\names -> Lists.foldl addName Maps.empty names) +      addName = (\acc -> \name ->  +              let local = (Names.localNameOf name) +                  group = (Optionals.fromMaybe Sets.empty (Maps.lookup local acc))+              in (Maps.insert local (Sets.insert name group) acc))+      groups = (groupNamesByLocal original)+      renameGroup = (\localNames ->  +              let local = (fst localNames) +                  names = (snd localNames)+                  rangeFrom = (\start -> Lists.cons start (rangeFrom (Math.add start 1)))+                  rename = (\name -> \i -> (name, (Core.Name (Logic.ifElse (Equality.gt i 1) (Strings.cat2 local (Literals.showInt32 i)) local))))+              in (Lists.zipWith rename (Sets.toList names) (rangeFrom 1)))+  in (Maps.fromList (Lists.concat (Lists.map renameGroup (Maps.toList groups))))++-- | Topological sort of connected components, in terms of dependencies between variable/term binding pairs+topologicalSortBindingMap :: (M.Map Core.Name Core.Term -> [[(Core.Name, Core.Term)]])+topologicalSortBindingMap bindingMap =  +  let bindings = (Maps.toList bindingMap) +      keys = (Sets.fromList (Lists.map fst bindings))+      hasTypeAnnotation = (\term -> (\x -> case x of+              Core.TermAnnotated v1 -> (hasTypeAnnotation (Core.annotatedTermSubject v1))+              _ -> False) term)+      depsOf = (\nameAndTerm ->  +              let name = (fst nameAndTerm) +                  term = (snd nameAndTerm)+              in (name, (Logic.ifElse (hasTypeAnnotation term) [] (Sets.toList (Sets.intersection keys (freeVariablesInTerm term))))))+      toPair = (\name -> (name, (Optionals.fromMaybe (Core.TermLiteral (Core.LiteralString "Impossible!")) (Maps.lookup name bindingMap))))+  in (Lists.map (Lists.map toPair) (Sorting.topologicalSortComponents (Lists.map depsOf bindings)))++-- | Topological sort of elements based on their dependencies+topologicalSortBindings :: ([Core.Binding] -> Mantle.Either [[Core.Name]] [Core.Name])+topologicalSortBindings els =  +  let adjlist = (\e -> (Core.bindingName e, (Sets.toList (termDependencyNames False True True (Core.bindingTerm e)))))+  in (Sorting.topologicalSort (Lists.map adjlist els))++typeDependencyNames :: (Bool -> Core.Type -> S.Set Core.Name)+typeDependencyNames withSchema typ = (Logic.ifElse withSchema (Sets.union (freeVariablesInType typ) (typeNamesInType typ)) (freeVariablesInType typ))++typeNamesInType :: (Core.Type -> S.Set Core.Name)+typeNamesInType = (foldOverType Coders.TraversalOrderPre addNames Sets.empty) +  where +    addNames = (\names -> \typ -> (\x -> case x of+      Core.TypeRecord v1 ->  +        let tname = (Core.rowTypeTypeName v1)+        in (Sets.insert tname names)+      Core.TypeUnion v1 ->  +        let tname = (Core.rowTypeTypeName v1)+        in (Sets.insert tname names)+      Core.TypeWrap v1 ->  +        let tname = (Core.wrappedTypeTypeName v1)+        in (Sets.insert tname names)+      _ -> names) typ)
+ src/gen-main/haskell/Hydra/Schemas.hs view
@@ -0,0 +1,316 @@+-- | Various functions for dereferencing and decoding schema types.++module Hydra.Schemas 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.Decode.Core as Core_+import qualified Hydra.Encode.Core as Core__+import qualified Hydra.Graph as Graph+import qualified Hydra.Lexical as Lexical+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Monads as Monads+import qualified Hydra.Names as Names+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core___+import qualified Hydra.Sorting as Sorting+import qualified Hydra.Typing as Typing+import qualified Hydra.Variants as Variants+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Get dependency namespaces from definitions+definitionDependencyNamespaces :: ([Module.Definition] -> S.Set Module.Namespace)+definitionDependencyNamespaces defs =  +  let defNames = (\def -> (\x -> case x of+          Module.DefinitionType v1 -> (Rewriting.typeDependencyNames True (Module.typeDefinitionType v1))+          Module.DefinitionTerm v1 -> (Rewriting.termDependencyNames True True True (Module.termDefinitionTerm v1))) def) +      allNames = (Sets.unions (Lists.map defNames defs))+  in (Sets.fromList (Optionals.cat (Lists.map Names.namespaceOf (Sets.toList allNames))))++-- | Find dependency namespaces in all of a set of terms+dependencyNamespaces :: (Bool -> Bool -> Bool -> Bool -> [Core.Binding] -> Compute.Flow Graph.Graph (S.Set Module.Namespace))+dependencyNamespaces binds withPrims withNoms withSchema els =  +  let depNames = (\el ->  +          let term = (Core.bindingTerm el) +              dataNames = (Rewriting.termDependencyNames binds withPrims withNoms term)+              schemaNames = (Logic.ifElse withSchema (Optionals.maybe Sets.empty (\ts -> Rewriting.typeDependencyNames True (Core.typeSchemeType ts)) (Core.bindingType el)) Sets.empty)+          in (Logic.ifElse (Core__.isEncodedType (Rewriting.deannotateTerm term)) (Flows.bind (Core_.type_ term) (\typ -> Flows.pure (Sets.unions [+            dataNames,+            schemaNames,+            (Rewriting.typeDependencyNames True typ)]))) (Flows.pure (Sets.unions [+            dataNames,+            schemaNames]))))+  in (Flows.bind (Flows.mapList depNames els) (\namesList -> Flows.pure (Sets.fromList (Optionals.cat (Lists.map Names.namespaceOf (Sets.toList (Sets.delete Constants.placeholderName (Sets.unions namesList))))))))++-- | Dereference a type name to get the actual type+dereferenceType :: (Core.Name -> Compute.Flow Graph.Graph (Maybe Core.Type))+dereferenceType name = (Flows.bind (Lexical.dereferenceElement name) (\mel -> Optionals.maybe (Flows.pure Nothing) (\el -> Flows.map Optionals.pure (Core_.type_ (Core.bindingTerm el))) mel))++elementAsTypedTerm :: (Core.Binding -> Compute.Flow t0 Core.TypedTerm)+elementAsTypedTerm el = (Optionals.maybe (Flows.fail "missing element type") (\ts -> Flows.pure (Core.TypedTerm {+  Core.typedTermTerm = (Core.bindingTerm el),+  Core.typedTermType = (Core.typeSchemeType ts)})) (Core.bindingType el))++-- | Get elements with their dependencies+elementsWithDependencies :: ([Core.Binding] -> Compute.Flow Graph.Graph [Core.Binding])+elementsWithDependencies original =  +  let depNames = (\el -> Sets.toList (Rewriting.termDependencyNames True False False (Core.bindingTerm el))) +      allDepNames = (Lists.nub (Lists.concat2 (Lists.map Core.bindingName original) (Lists.concat (Lists.map depNames original))))+  in (Flows.mapList Lexical.requireElement allDepNames)++-- | Extend a type context by descending into a System F lambda body+extendTypeContextForLambda :: (Typing.TypeContext -> Core.Lambda -> Typing.TypeContext)+extendTypeContextForLambda tcontext lam =  +  let var = (Core.lambdaParameter lam)+  in  +    let dom = (Optionals.fromJust (Core.lambdaDomain lam))+    in Typing.TypeContext {+      Typing.typeContextTypes = (Maps.insert var dom (Typing.typeContextTypes tcontext)),+      Typing.typeContextVariables = (Typing.typeContextVariables tcontext),+      Typing.typeContextInferenceContext = (Typing.typeContextInferenceContext tcontext)}++-- | Extend a type context by descending into a let body+extendTypeContextForLet :: (Typing.TypeContext -> Core.Let -> Typing.TypeContext)+extendTypeContextForLet tcontext letrec =  +  let bindings = (Core.letBindings letrec)+  in Typing.TypeContext {+    Typing.typeContextTypes = (Maps.union (Typing.typeContextTypes tcontext) (Maps.fromList (Lists.map (\b -> (Core.bindingName b, (typeSchemeToFType (Optionals.fromJust (Core.bindingType b))))) bindings))),+    Typing.typeContextVariables = (Typing.typeContextVariables tcontext),+    Typing.typeContextInferenceContext = (Typing.typeContextInferenceContext tcontext)}++-- | Extend a type context by descending into a System F type lambda body+extendTypeContextForTypeLambda :: (Typing.TypeContext -> Core.TypeLambda -> Typing.TypeContext)+extendTypeContextForTypeLambda tcontext tlam =  +  let name = (Core.typeLambdaParameter tlam)+  in Typing.TypeContext {+    Typing.typeContextTypes = (Typing.typeContextTypes tcontext),+    Typing.typeContextVariables = (Sets.insert name (Typing.typeContextVariables tcontext)),+    Typing.typeContextInferenceContext = (Typing.typeContextInferenceContext tcontext)}++fieldMap :: ([Core.Field] -> M.Map Core.Name Core.Term)+fieldMap fields = (Maps.fromList (Lists.map toPair fields)) +  where +    toPair = (\f -> (Core.fieldName f, (Core.fieldTerm f)))++fieldTypeMap :: ([Core.FieldType] -> M.Map Core.Name Core.Type)+fieldTypeMap fields = (Maps.fromList (Lists.map toPair fields)) +  where +    toPair = (\f -> (Core.fieldTypeName f, (Core.fieldTypeType f)))++findFieldType :: (Core.Name -> [Core.FieldType] -> Compute.Flow t0 Core.Type)+findFieldType fname fields =  +  let matchingFields = (Lists.filter (\ft -> Equality.equal (Core.unName (Core.fieldTypeName ft)) (Core.unName fname)) fields)+  in (Logic.ifElse (Lists.null matchingFields) (Flows.fail (Strings.cat2 "No such field: " (Core.unName fname))) (Logic.ifElse (Equality.equal (Lists.length matchingFields) 1) (Flows.pure (Core.fieldTypeType (Lists.head matchingFields))) (Flows.fail (Strings.cat2 "Multiple fields named " (Core.unName fname)))))++-- | Get field types from a record or union type+fieldTypes :: (Core.Type -> Compute.Flow Graph.Graph (M.Map Core.Name Core.Type))+fieldTypes t =  +  let toMap = (\fields -> Maps.fromList (Lists.map (\ft -> (Core.fieldTypeName ft, (Core.fieldTypeType ft))) fields))+  in ((\x -> case x of+    Core.TypeForall v1 -> (fieldTypes (Core.forallTypeBody v1))+    Core.TypeRecord v1 -> (Flows.pure (toMap (Core.rowTypeFields v1)))+    Core.TypeUnion v1 -> (Flows.pure (toMap (Core.rowTypeFields v1)))+    Core.TypeVariable v1 -> (Monads.withTrace (Strings.cat2 "field types of " (Core.unName v1)) (Flows.bind (Lexical.requireElement v1) (\el -> Flows.bind (Core_.type_ (Core.bindingTerm el)) fieldTypes)))+    _ -> (Monads.unexpected "record or union type" (Core___.type_ t))) (Rewriting.deannotateType t))++-- | Convert a forall type to a type scheme+fTypeToTypeScheme :: (Core.Type -> Core.TypeScheme)+fTypeToTypeScheme typ = (gatherForall [] typ) +  where +    gatherForall = (\vars -> \typ -> (\x -> case x of+      Core.TypeForall v1 -> (gatherForall (Lists.cons (Core.forallTypeParameter v1) vars) (Core.forallTypeBody v1))+      _ -> Core.TypeScheme {+        Core.typeSchemeVariables = (Lists.reverse vars),+        Core.typeSchemeType = typ}) (Rewriting.deannotateType typ))++-- | Fully strip a type of forall quantifiers+fullyStripType :: (Core.Type -> Core.Type)+fullyStripType typ = ((\x -> case x of+  Core.TypeForall v1 -> (fullyStripType (Core.forallTypeBody v1))+  _ -> typ) (Rewriting.deannotateType typ))++-- | Convert a graph to a term, taking advantage of the built-in duality between graphs and terms+graphAsTerm :: (Graph.Graph -> Core.Term)+graphAsTerm g =  +  let toBinding = (\el ->  +          let name = (Core.bindingName el)+          in  +            let term = (Core.bindingTerm el)+            in  +              let mts = (Core.bindingType el)+              in Core.Binding {+                Core.bindingName = name,+                Core.bindingTerm = term,+                Core.bindingType = mts})+  in (Core.TermLet (Core.Let {+    Core.letBindings = (Lists.map toBinding (Maps.elems (Graph.graphElements g))),+    Core.letEnvironment = (Graph.graphBody g)}))++-- | Decode a schema graph which encodes a set of named types+graphAsTypes :: (Graph.Graph -> Compute.Flow Graph.Graph (M.Map Core.Name Core.Type))+graphAsTypes sg =  +  let els = (Maps.elems (Graph.graphElements sg))+  in  +    let toPair = (\el -> Flows.bind (Core_.type_ (Core.bindingTerm el)) (\typ -> Flows.pure (Core.bindingName el, typ)))+    in (Flows.bind (Flows.mapList toPair els) (\pairs -> Flows.pure (Maps.fromList pairs)))++-- | Check if a row type represents an enum (all fields are unit-typed)+isEnumRowType :: (Core.RowType -> Bool)+isEnumRowType rt = (Lists.foldl Logic.and True (Lists.map (\f -> Core__.isUnitType (Core.fieldTypeType f)) (Core.rowTypeFields rt)))++-- | Check if a type is an enum type+isEnumType :: (Core.Type -> Bool)+isEnumType typ = ((\x -> case x of+  Core.TypeUnion v1 -> (isEnumRowType v1)+  _ -> False) (Rewriting.deannotateType typ))++-- | Check if an element is serializable (no function types in dependencies)+isSerializable :: (Core.Binding -> Compute.Flow Graph.Graph Bool)+isSerializable el =  +  let variants = (\typ -> Lists.map Variants.typeVariant (Rewriting.foldOverType Coders.TraversalOrderPre (\m -> \t -> Lists.cons t m) [] typ))+  in (Flows.map (\deps ->  +    let allVariants = (Sets.fromList (Lists.concat (Lists.map variants (Maps.elems deps))))+    in (Logic.not (Sets.member Mantle.TypeVariantFunction allVariants))) (typeDependencies False Equality.identity (Core.bindingName el)))++-- | Find dependency namespaces in all elements of a module, excluding the module's own namespace+moduleDependencyNamespaces :: (Bool -> Bool -> Bool -> Bool -> Module.Module -> Compute.Flow Graph.Graph (S.Set Module.Namespace))+moduleDependencyNamespaces binds withPrims withNoms withSchema mod = (Flows.bind (dependencyNamespaces binds withPrims withNoms withSchema (Module.moduleElements mod)) (\deps -> Flows.pure (Sets.delete (Module.moduleNamespace mod) deps)))++namespacesForDefinitions :: ((Module.Namespace -> t0) -> Module.Namespace -> [Module.Definition] -> Module.Namespaces t0)+namespacesForDefinitions encodeNamespace focusNs defs =  +  let nss = (Sets.delete focusNs (definitionDependencyNamespaces defs)) +      toPair = (\ns -> (ns, (encodeNamespace ns)))+  in Module.Namespaces {+    Module.namespacesFocus = (toPair focusNs),+    Module.namespacesMapping = (Maps.fromList (Lists.map toPair (Sets.toList nss)))}++-- | Require a name to resolve to a record type+requireRecordType :: (Core.Name -> Compute.Flow Graph.Graph Core.RowType)+requireRecordType = (requireRowType "record type" (\t -> (\x -> case x of+  Core.TypeRecord v1 -> (Just v1)+  _ -> Nothing) t))++requireRowType :: (String -> (Core.Type -> Maybe t0) -> Core.Name -> Compute.Flow Graph.Graph t0)+requireRowType label getter name =  +  let rawType = (\t -> (\x -> case x of+          Core.TypeAnnotated v1 -> (rawType (Core.annotatedTypeSubject v1))+          Core.TypeForall v1 -> (rawType (Core.forallTypeBody v1))+          _ -> t) t)+  in (Flows.bind (requireType name) (\t -> Optionals.maybe (Flows.fail (Strings.cat [+    Core.unName name,+    " does not resolve to a ",+    label,+    " type: ",+    (Core___.type_ t)])) Flows.pure (getter (rawType t))))++-- | Require a type by name+requireType :: (Core.Name -> Compute.Flow Graph.Graph Core.Type)+requireType name = (Monads.withTrace (Strings.cat2 "require type " (Core.unName name)) (Flows.bind (Lexical.withSchemaContext (Lexical.requireElement name)) (\el -> Core_.type_ (Core.bindingTerm el))))++-- | Require a name to resolve to a union type+requireUnionType :: (Core.Name -> Compute.Flow Graph.Graph Core.RowType)+requireUnionType = (requireRowType "union" (\t -> (\x -> case x of+  Core.TypeUnion v1 -> (Just v1)+  _ -> Nothing) t))++-- | Resolve a type, dereferencing type variables+resolveType :: (Core.Type -> Compute.Flow Graph.Graph (Maybe Core.Type))+resolveType typ = ((\x -> case x of+  Core.TypeVariable v1 -> (Lexical.withSchemaContext (Flows.bind (Lexical.resolveTerm v1) (\mterm -> Optionals.maybe (Flows.pure Nothing) (\t -> Flows.map Optionals.pure (Core_.type_ t)) mterm)))+  _ -> (Flows.pure (Just typ))) (Rewriting.deannotateType typ))++schemaGraphToTypingEnvironment :: (Graph.Graph -> Compute.Flow t0 (M.Map Core.Name Core.TypeScheme))+schemaGraphToTypingEnvironment g =  +  let toTypeScheme = (\vars -> \typ -> (\x -> case x of+          Core.TypeForall v1 -> (toTypeScheme (Lists.cons (Core.forallTypeParameter v1) vars) (Core.forallTypeBody v1))+          _ -> Core.TypeScheme {+            Core.typeSchemeVariables = (Lists.reverse vars),+            Core.typeSchemeType = typ}) (Rewriting.deannotateType typ))+  in  +    let toPair = (\el -> Flows.map (\mts -> Optionals.map (\ts -> (Core.bindingName el, ts)) mts) (Optionals.maybe (Flows.bind (Core_.type_ (Core.bindingTerm el)) (\typ ->  +            let ts = (fTypeToTypeScheme typ)+            in (Flows.pure (Just ts)))) (\ts -> Logic.ifElse (Equality.equal ts (Core.TypeScheme {+            Core.typeSchemeVariables = [],+            Core.typeSchemeType = (Core.TypeVariable (Core.Name "hydra.core.TypeScheme"))})) (Flows.map Optionals.pure (Core_.typeScheme (Core.bindingTerm el))) (Logic.ifElse (Equality.equal ts (Core.TypeScheme {+            Core.typeSchemeVariables = [],+            Core.typeSchemeType = (Core.TypeVariable (Core.Name "hydra.core.Type"))})) (Flows.map (\decoded -> Just (toTypeScheme [] decoded)) (Core_.type_ (Core.bindingTerm el))) ((\x -> case x of+            Core.TermRecord v1 -> (Logic.ifElse (Equality.equal (Core.recordTypeName v1) (Core.Name "hydra.core.TypeScheme")) (Flows.map Optionals.pure (Core_.typeScheme (Core.bindingTerm el))) (Flows.pure Nothing))+            Core.TermUnion v1 -> (Logic.ifElse (Equality.equal (Core.injectionTypeName v1) (Core.Name "hydra.core.Type")) (Flows.map (\decoded -> Just (toTypeScheme [] decoded)) (Core_.type_ (Core.bindingTerm el))) (Flows.pure Nothing))+            _ -> (Flows.pure Nothing)) (Rewriting.deannotateTerm (Core.bindingTerm el))))) (Core.bindingType el)))+    in (Monads.withState g (Flows.bind (Flows.mapList toPair (Maps.elems (Graph.graphElements g))) (\mpairs -> Flows.pure (Maps.fromList (Optionals.cat mpairs)))))++-- | Find the equivalent graph representation of a term+termAsGraph :: (Core.Term -> M.Map Core.Name Core.Binding)+termAsGraph term = ((\x -> case x of+  Core.TermLet v1 ->  +    let bindings = (Core.letBindings v1)+    in  +      let fromBinding = (\b ->  +              let name = (Core.bindingName b)+              in  +                let term = (Core.bindingTerm b)+                in  +                  let ts = (Core.bindingType b)+                  in (name, Core.Binding {+                    Core.bindingName = name,+                    Core.bindingTerm = term,+                    Core.bindingType = ts}))+      in (Maps.fromList (Lists.map fromBinding bindings))+  _ -> Maps.empty) (Rewriting.deannotateTerm term))++-- | Topologically sort type definitions by dependencies+topologicalSortTypeDefinitions :: ([Module.TypeDefinition] -> [[Module.TypeDefinition]])+topologicalSortTypeDefinitions defs =  +  let toPair = (\def -> (Module.typeDefinitionName def, (Sets.toList (Rewriting.typeDependencyNames False (Module.typeDefinitionType def))))) +      nameToDef = (Maps.fromList (Lists.map (\d -> (Module.typeDefinitionName d, d)) defs))+      sorted = (Sorting.topologicalSortComponents (Lists.map toPair defs))+  in (Lists.map (\names -> Optionals.cat (Lists.map (\n -> Maps.lookup n nameToDef) names)) sorted)++-- | Get all type dependencies for a given type name+typeDependencies :: (Bool -> (Core.Type -> Core.Type) -> Core.Name -> Compute.Flow Graph.Graph (M.Map Core.Name Core.Type))+typeDependencies withSchema transform name =  +  let requireType = (\name -> Monads.withTrace (Strings.cat2 "type dependencies of " (Core.unName name)) (Flows.bind (Lexical.requireElement name) (\el -> Core_.type_ (Core.bindingTerm el)))) +      toPair = (\name -> Flows.bind (requireType name) (\typ -> Flows.pure (name, (transform typ))))+      deps = (\seeds -> \names -> Logic.ifElse (Sets.null seeds) (Flows.pure names) (Flows.bind (Flows.mapList toPair (Sets.toList seeds)) (\pairs ->  +              let newNames = (Maps.union names (Maps.fromList pairs)) +                  refs = (Lists.foldl Sets.union Sets.empty (Lists.map (\pair -> Rewriting.typeDependencyNames withSchema (snd pair)) pairs))+                  visited = (Sets.fromList (Maps.keys names))+                  newSeeds = (Sets.difference refs visited)+              in (deps newSeeds newNames))))+  in (deps (Sets.singleton name) Maps.empty)++-- | Convert a type scheme to a forall type+typeSchemeToFType :: (Core.TypeScheme -> Core.Type)+typeSchemeToFType ts =  +  let vars = (Core.typeSchemeVariables ts)+  in  +    let body = (Core.typeSchemeType ts)+    in (Lists.foldl (\t -> \v -> Core.TypeForall (Core.ForallType {+      Core.forallTypeParameter = v,+      Core.forallTypeBody = t})) body (Lists.reverse vars))++-- | Encode a map of named types to a map of elements+typesToElements :: (M.Map Core.Name Core.Type -> M.Map Core.Name Core.Binding)+typesToElements typeMap =  +  let toElement = (\pair ->  +          let name = (fst pair)+          in (name, Core.Binding {+            Core.bindingName = name,+            Core.bindingTerm = (Core__.type_ (snd pair)),+            Core.bindingType = Nothing}))+  in (Maps.fromList (Lists.map toElement (Maps.toList typeMap)))
+ src/gen-main/haskell/Hydra/Serialization.hs view
@@ -0,0 +1,467 @@+-- | Utilities for constructing generic program code ASTs, used for the serialization phase of source code generation.++module Hydra.Serialization where++import qualified Hydra.Ast as Ast+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.Math as Math+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++angleBraces :: Ast.Brackets+angleBraces = Ast.Brackets {+  Ast.bracketsOpen = (sym "<"),+  Ast.bracketsClose = (sym ">")}++angleBracesList :: (Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+angleBracesList style els = (Logic.ifElse (Lists.null els) (cst "<>") (brackets angleBraces style (commaSep style els)))++-- | Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression.+bracesListAdaptive :: ([Ast.Expr] -> Ast.Expr)+bracesListAdaptive els =  +  let inlineList = (curlyBracesList Nothing inlineStyle els)+  in (Logic.ifElse (Equality.gt (expressionLength inlineList) 70) (curlyBracesList Nothing halfBlockStyle els) inlineList)++bracketList :: (Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+bracketList style els = (Logic.ifElse (Lists.null els) (cst "[]") (brackets squareBrackets style (commaSep style els)))++-- | Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression.+bracketListAdaptive :: ([Ast.Expr] -> Ast.Expr)+bracketListAdaptive els =  +  let inlineList = (bracketList inlineStyle els)+  in (Logic.ifElse (Equality.gt (expressionLength inlineList) 70) (bracketList halfBlockStyle els) inlineList)++brackets :: (Ast.Brackets -> Ast.BlockStyle -> Ast.Expr -> Ast.Expr)+brackets br style e = (Ast.ExprBrackets (Ast.BracketExpr {+  Ast.bracketExprBrackets = br,+  Ast.bracketExprEnclosed = e,+  Ast.bracketExprStyle = style}))++commaSep :: (Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+commaSep = (symbolSep ",")++curlyBlock :: (Ast.BlockStyle -> Ast.Expr -> Ast.Expr)+curlyBlock style e = (curlyBracesList Nothing style [+  e])++curlyBraces :: Ast.Brackets+curlyBraces = Ast.Brackets {+  Ast.bracketsOpen = (sym "{"),+  Ast.bracketsClose = (sym "}")}++curlyBracesList :: (Maybe String -> Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+curlyBracesList msymb style els = (Logic.ifElse (Lists.null els) (cst "{}") (brackets curlyBraces style (symbolSep (Optionals.fromMaybe "," msymb) style els)))++cst :: (String -> Ast.Expr)+cst s = (Ast.ExprConst (sym s))++customIndent :: (String -> String -> String)+customIndent idt s = (Strings.cat (Lists.intersperse "\n" (Lists.map (\line -> Strings.cat [+  idt,+  line]) (Strings.lines s))))++customIndentBlock :: (String -> [Ast.Expr] -> Ast.Expr)+customIndentBlock idt els = (Logic.ifElse (Lists.null els) (cst "") (Logic.ifElse (Equality.equal (Lists.length els) 1) (Lists.head els) ( +  let head = (Lists.head els) +      rest = (Lists.tail els)+      idtOp = Ast.Op {+              Ast.opSymbol = (sym ""),+              Ast.opPadding = Ast.Padding {+                Ast.paddingLeft = Ast.WsSpace,+                Ast.paddingRight = (Ast.WsBreakAndIndent idt)},+              Ast.opPrecedence = (Ast.Precedence 0),+              Ast.opAssociativity = Ast.AssociativityNone}+  in (ifx idtOp head (newlineSep rest)))))++dotSep :: ([Ast.Expr] -> Ast.Expr)+dotSep = (sep (Ast.Op {+  Ast.opSymbol = (sym "."),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsNone,+    Ast.paddingRight = Ast.WsNone},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}))++doubleNewlineSep :: ([Ast.Expr] -> Ast.Expr)+doubleNewlineSep = (sep (Ast.Op {+  Ast.opSymbol = (sym ""),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsBreak,+    Ast.paddingRight = Ast.WsBreak},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}))++doubleSpace :: String+doubleSpace = "  "++-- | Find the approximate length (number of characters, including spaces and newlines) of an expression without actually printing it.+expressionLength :: (Ast.Expr -> Int)+expressionLength e =  +  let symbolLength = (\s -> Strings.length (Ast.unSymbol s)) +      wsLength = (\ws -> (\x -> case x of+              Ast.WsNone -> 0+              Ast.WsSpace -> 1+              Ast.WsBreak -> 1+              Ast.WsBreakAndIndent v1 -> (Math.add 1 (Strings.length v1))+              Ast.WsDoubleBreak -> 2) ws)+      blockStyleLength = (\style ->  +              let mindentLen = (Optionals.maybe 0 Strings.length (Ast.blockStyleIndent style)) +                  nlBeforeLen = (Logic.ifElse (Ast.blockStyleNewlineBeforeContent style) 1 0)+                  nlAfterLen = (Logic.ifElse (Ast.blockStyleNewlineAfterContent style) 1 0)+              in (Math.add mindentLen (Math.add nlBeforeLen nlAfterLen)))+      bracketsLength = (\brackets -> Math.add (symbolLength (Ast.bracketsOpen brackets)) (symbolLength (Ast.bracketsClose brackets)))+      bracketExprLength = (\be -> Math.add (bracketsLength (Ast.bracketExprBrackets be)) (Math.add (expressionLength (Ast.bracketExprEnclosed be)) (blockStyleLength (Ast.bracketExprStyle be))))+      indentedExpressionLength = (\ie ->  +              let baseLen = (expressionLength (Ast.indentedExpressionExpr ie)) +                  indentLen = ((\x -> case x of+                          Ast.IndentStyleAllLines v1 -> (Strings.length v1)+                          Ast.IndentStyleSubsequentLines v1 -> (Strings.length v1)) (Ast.indentedExpressionStyle ie))+              in (Math.add baseLen indentLen))+      opLength = (\op ->  +              let symLen = (symbolLength (Ast.opSymbol op)) +                  padding = (Ast.opPadding op)+                  leftLen = (wsLength (Ast.paddingLeft padding))+                  rightLen = (wsLength (Ast.paddingRight padding))+              in (Math.add symLen (Math.add leftLen rightLen)))+      opExprLength = (\oe ->  +              let opLen = (opLength (Ast.opExprOp oe)) +                  leftLen = (expressionLength (Ast.opExprLhs oe))+                  rightLen = (expressionLength (Ast.opExprRhs oe))+              in (Math.add opLen (Math.add leftLen rightLen)))+  in ((\x -> case x of+    Ast.ExprConst v1 -> (symbolLength v1)+    Ast.ExprIndent v1 -> (indentedExpressionLength v1)+    Ast.ExprOp v1 -> (opExprLength v1)+    Ast.ExprBrackets v1 -> (bracketExprLength v1)) e)++fullBlockStyle :: Ast.BlockStyle+fullBlockStyle = Ast.BlockStyle {+  Ast.blockStyleIndent = (Just doubleSpace),+  Ast.blockStyleNewlineBeforeContent = True,+  Ast.blockStyleNewlineAfterContent = True}++halfBlockStyle :: Ast.BlockStyle+halfBlockStyle = Ast.BlockStyle {+  Ast.blockStyleIndent = (Just doubleSpace),+  Ast.blockStyleNewlineBeforeContent = True,+  Ast.blockStyleNewlineAfterContent = False}++ifx :: (Ast.Op -> Ast.Expr -> Ast.Expr -> Ast.Expr)+ifx op lhs rhs = (Ast.ExprOp (Ast.OpExpr {+  Ast.opExprOp = op,+  Ast.opExprLhs = lhs,+  Ast.opExprRhs = rhs}))++indent :: (String -> String)+indent = (customIndent doubleSpace)++indentBlock :: ([Ast.Expr] -> Ast.Expr)+indentBlock = (customIndentBlock doubleSpace)++indentSubsequentLines :: (String -> Ast.Expr -> Ast.Expr)+indentSubsequentLines idt e = (Ast.ExprIndent (Ast.IndentedExpression {+  Ast.indentedExpressionStyle = (Ast.IndentStyleSubsequentLines idt),+  Ast.indentedExpressionExpr = e}))++infixWs :: (String -> Ast.Expr -> Ast.Expr -> Ast.Expr)+infixWs op l r = (spaceSep [+  l,+  cst op,+  r])++infixWsList :: (String -> [Ast.Expr] -> Ast.Expr)+infixWsList op opers =  +  let opExpr = (cst op) +      foldFun = (\e -> \r -> Logic.ifElse (Lists.null e) [+              r] (Lists.cons r (Lists.cons opExpr e)))+  in (spaceSep (Lists.foldl foldFun [] (Lists.reverse opers)))++inlineStyle :: Ast.BlockStyle+inlineStyle = Ast.BlockStyle {+  Ast.blockStyleIndent = Nothing,+  Ast.blockStyleNewlineBeforeContent = False,+  Ast.blockStyleNewlineAfterContent = False}++newlineSep :: ([Ast.Expr] -> Ast.Expr)+newlineSep = (sep (Ast.Op {+  Ast.opSymbol = (sym ""),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsNone,+    Ast.paddingRight = Ast.WsBreak},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}))++noPadding :: Ast.Padding+noPadding = Ast.Padding {+  Ast.paddingLeft = Ast.WsNone,+  Ast.paddingRight = Ast.WsNone}++noSep :: ([Ast.Expr] -> Ast.Expr)+noSep = (sep (Ast.Op {+  Ast.opSymbol = (sym ""),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsNone,+    Ast.paddingRight = Ast.WsNone},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}))++num :: (Int -> Ast.Expr)+num i = (cst (Literals.showInt32 i))++op :: (String -> Int -> Ast.Associativity -> Ast.Op)+op s p assoc = Ast.Op {+  Ast.opSymbol = (sym s),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsSpace,+    Ast.paddingRight = Ast.WsSpace},+  Ast.opPrecedence = (Ast.Precedence p),+  Ast.opAssociativity = assoc}++orOp :: (Bool -> Ast.Op)+orOp newlines = Ast.Op {+  Ast.opSymbol = (sym "|"),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsSpace,+    Ast.paddingRight = (Logic.ifElse newlines Ast.WsBreak Ast.WsSpace)},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}++orSep :: (Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+orSep style l = (Logic.ifElse (Lists.null l) (cst "") (Logic.ifElse (Equality.equal (Lists.length l) 1) (Lists.head l) ( +  let h = (Lists.head l) +      r = (Lists.tail l)+      newlines = (Ast.blockStyleNewlineBeforeContent style)+  in (ifx (orOp newlines) h (orSep style r)))))++parenList :: (Bool -> [Ast.Expr] -> Ast.Expr)+parenList newlines els = (Logic.ifElse (Lists.null els) (cst "()") ( +  let style = (Logic.ifElse (Logic.and newlines (Equality.gt (Lists.length els) 1)) halfBlockStyle inlineStyle)+  in (brackets parentheses style (commaSep style els))))++parens :: (Ast.Expr -> Ast.Expr)+parens = (brackets parentheses inlineStyle)++parentheses :: Ast.Brackets+parentheses = Ast.Brackets {+  Ast.bracketsOpen = (sym "("),+  Ast.bracketsClose = (sym ")")}++parenthesize :: (Ast.Expr -> Ast.Expr)+parenthesize exp =  +  let assocLeft = (\a -> (\x -> case x of+          Ast.AssociativityRight -> False+          _ -> True) a) +      assocRight = (\a -> (\x -> case x of+              Ast.AssociativityLeft -> False+              _ -> True) a)+  in ((\x -> case x of+    Ast.ExprBrackets v1 -> (Ast.ExprBrackets (Ast.BracketExpr {+      Ast.bracketExprBrackets = (Ast.bracketExprBrackets v1),+      Ast.bracketExprEnclosed = (parenthesize (Ast.bracketExprEnclosed v1)),+      Ast.bracketExprStyle = (Ast.bracketExprStyle v1)}))+    Ast.ExprConst _ -> exp+    Ast.ExprIndent v1 -> (Ast.ExprIndent (Ast.IndentedExpression {+      Ast.indentedExpressionStyle = (Ast.indentedExpressionStyle v1),+      Ast.indentedExpressionExpr = (parenthesize (Ast.indentedExpressionExpr v1))}))+    Ast.ExprOp v1 ->  +      let op = (Ast.opExprOp v1) +          prec = (Ast.unPrecedence (Ast.opPrecedence op))+          assoc = (Ast.opAssociativity op)+          lhs = (Ast.opExprLhs v1)+          rhs = (Ast.opExprRhs v1)+          lhs_ = (parenthesize lhs)+          rhs_ = (parenthesize rhs)+          lhs2 = ((\x -> case x of+                  Ast.ExprOp v2 ->  +                    let lop = (Ast.opExprOp v2) +                        lprec = (Ast.unPrecedence (Ast.opPrecedence lop))+                        lassoc = (Ast.opAssociativity lop)+                        comparison = (Equality.compare prec lprec)+                    in ((\x -> case x of+                      Mantle.ComparisonLessThan -> lhs_+                      Mantle.ComparisonGreaterThan -> (parens lhs_)+                      Mantle.ComparisonEqualTo -> (Logic.ifElse (Logic.and (assocLeft assoc) (assocLeft lassoc)) lhs_ (parens lhs_))) comparison)+                  _ -> lhs_) lhs_)+          rhs2 = ((\x -> case x of+                  Ast.ExprOp v2 ->  +                    let rop = (Ast.opExprOp v2) +                        rprec = (Ast.unPrecedence (Ast.opPrecedence rop))+                        rassoc = (Ast.opAssociativity rop)+                        comparison = (Equality.compare prec rprec)+                    in ((\x -> case x of+                      Mantle.ComparisonLessThan -> rhs_+                      Mantle.ComparisonGreaterThan -> (parens rhs_)+                      Mantle.ComparisonEqualTo -> (Logic.ifElse (Logic.and (assocRight assoc) (assocRight rassoc)) rhs_ (parens rhs_))) comparison)+                  _ -> rhs_) rhs_)+      in (Ast.ExprOp (Ast.OpExpr {+        Ast.opExprOp = op,+        Ast.opExprLhs = lhs2,+        Ast.opExprRhs = rhs2}))) exp)++prefix :: (String -> Ast.Expr -> Ast.Expr)+prefix p expr =  +  let preOp = Ast.Op {+          Ast.opSymbol = (sym p),+          Ast.opPadding = Ast.Padding {+            Ast.paddingLeft = Ast.WsNone,+            Ast.paddingRight = Ast.WsNone},+          Ast.opPrecedence = (Ast.Precedence 0),+          Ast.opAssociativity = Ast.AssociativityNone}+  in (ifx preOp (cst "") expr)++printExpr :: (Ast.Expr -> String)+printExpr e =  +  let pad = (\ws -> (\x -> case x of+          Ast.WsNone -> ""+          Ast.WsSpace -> " "+          Ast.WsBreak -> "\n"+          Ast.WsBreakAndIndent _ -> "\n"+          Ast.WsDoubleBreak -> "\n\n") ws) +      idt = (\ws -> \s -> (\x -> case x of+              Ast.WsBreakAndIndent v1 -> (customIndent v1 s)+              _ -> s) ws)+  in ((\x -> case x of+    Ast.ExprConst v1 -> (Ast.unSymbol v1)+    Ast.ExprIndent v1 ->  +      let style = (Ast.indentedExpressionStyle v1) +          expr = (Ast.indentedExpressionExpr v1)+          lns = (Strings.lines (printExpr expr))+      in (Strings.intercalate "\n" ((\x -> case x of+        Ast.IndentStyleAllLines v2 -> (Lists.map (\line -> Strings.cat [+          v2,+          line]) lns)+        Ast.IndentStyleSubsequentLines v2 -> (Logic.ifElse (Equality.equal (Lists.length lns) 1) lns (Lists.cons (Lists.head lns) (Lists.map (\line -> Strings.cat [+          v2,+          line]) (Lists.tail lns))))) style))+    Ast.ExprOp v1 ->  +      let op = (Ast.opExprOp v1) +          sym = (Ast.unSymbol (Ast.opSymbol op))+          padding = (Ast.opPadding op)+          padl = (Ast.paddingLeft padding)+          padr = (Ast.paddingRight padding)+          l = (Ast.opExprLhs v1)+          r = (Ast.opExprRhs v1)+          lhs = (idt padl (printExpr l))+          rhs = (idt padr (printExpr r))+      in (Strings.cat [+        Strings.cat [+          Strings.cat [+            Strings.cat [+              lhs,+              (pad padl)],+            sym],+          (pad padr)],+        rhs])+    Ast.ExprBrackets v1 ->  +      let brackets = (Ast.bracketExprBrackets v1) +          l = (Ast.unSymbol (Ast.bracketsOpen brackets))+          r = (Ast.unSymbol (Ast.bracketsClose brackets))+          e = (Ast.bracketExprEnclosed v1)+          style = (Ast.bracketExprStyle v1)+          body = (printExpr e)+          doIndent = (Ast.blockStyleIndent style)+          nlBefore = (Ast.blockStyleNewlineBeforeContent style)+          nlAfter = (Ast.blockStyleNewlineAfterContent style)+          ibody = (Optionals.maybe body (\idt -> customIndent idt body) doIndent)+          pre = (Logic.ifElse nlBefore "\n" "")+          suf = (Logic.ifElse nlAfter "\n" "")+      in (Strings.cat [+        Strings.cat [+          Strings.cat [+            Strings.cat [+              l,+              pre],+            ibody],+          suf],+        r])) e)++semicolonSep :: ([Ast.Expr] -> Ast.Expr)+semicolonSep = (symbolSep ";" inlineStyle)++sep :: (Ast.Op -> [Ast.Expr] -> Ast.Expr)+sep op els = (Logic.ifElse (Lists.null els) (cst "") (Logic.ifElse (Equality.equal (Lists.length els) 1) (Lists.head els) ( +  let h = (Lists.head els) +      r = (Lists.tail els)+  in (ifx op h (sep op r)))))++spaceSep :: ([Ast.Expr] -> Ast.Expr)+spaceSep = (sep (Ast.Op {+  Ast.opSymbol = (sym ""),+  Ast.opPadding = Ast.Padding {+    Ast.paddingLeft = Ast.WsSpace,+    Ast.paddingRight = Ast.WsNone},+  Ast.opPrecedence = (Ast.Precedence 0),+  Ast.opAssociativity = Ast.AssociativityNone}))++squareBrackets :: Ast.Brackets+squareBrackets = Ast.Brackets {+  Ast.bracketsOpen = (sym "["),+  Ast.bracketsClose = (sym "]")}++sym :: (String -> Ast.Symbol)+sym s = (Ast.Symbol s)++symbolSep :: (String -> Ast.BlockStyle -> [Ast.Expr] -> Ast.Expr)+symbolSep symb style l = (Logic.ifElse (Lists.null l) (cst "") (Logic.ifElse (Equality.equal (Lists.length l) 1) (Lists.head l) ( +  let h = (Lists.head l) +      r = (Lists.tail l)+      breakCount = (Lists.length (Lists.filter (\x_ -> x_) [+              Ast.blockStyleNewlineBeforeContent style,+              (Ast.blockStyleNewlineAfterContent style)]))+      break = (Logic.ifElse (Equality.equal breakCount 0) Ast.WsSpace (Logic.ifElse (Equality.equal breakCount 1) Ast.WsBreak Ast.WsDoubleBreak))+      commaOp = Ast.Op {+              Ast.opSymbol = (sym symb),+              Ast.opPadding = Ast.Padding {+                Ast.paddingLeft = Ast.WsNone,+                Ast.paddingRight = break},+              Ast.opPrecedence = (Ast.Precedence 0),+              Ast.opAssociativity = Ast.AssociativityNone}+  in (ifx commaOp h (symbolSep symb style r)))))++tabIndent :: (Ast.Expr -> Ast.Expr)+tabIndent e = (Ast.ExprIndent (Ast.IndentedExpression {+  Ast.indentedExpressionStyle = (Ast.IndentStyleAllLines "    "),+  Ast.indentedExpressionExpr = e}))++tabIndentDoubleSpace :: ([Ast.Expr] -> Ast.Expr)+tabIndentDoubleSpace exprs = (tabIndent (doubleNewlineSep exprs))++tabIndentSingleSpace :: ([Ast.Expr] -> Ast.Expr)+tabIndentSingleSpace exprs = (tabIndent (newlineSep exprs))++unsupportedType :: (String -> Ast.Expr)+unsupportedType label = (cst (Strings.cat [+  Strings.cat [+    "[",+    label],+  "]"]))++unsupportedVariant :: (String -> String -> Ast.Expr)+unsupportedVariant label obj = (cst (Strings.cat [+  Strings.cat [+    Strings.cat [+      Strings.cat [+        "[unsupported ",+        label],+      ": "],+    (Literals.showString obj)],+  "]"]))++withComma :: (Ast.Expr -> Ast.Expr)+withComma e = (noSep [+  e,+  (cst ",")])++withSemi :: (Ast.Expr -> Ast.Expr)+withSemi e = (noSep [+  e,+  (cst ";")])
+ src/gen-main/haskell/Hydra/Show/Accessors.hs view
@@ -0,0 +1,107 @@+-- | Utilities for working with term accessors.++module Hydra.Show.Accessors where++import qualified Hydra.Accessors as Accessors+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+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.Module as Module+import qualified Hydra.Names as Names+import qualified Hydra.Rewriting as Rewriting+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Convert a term accessor to a string representation+termAccessor :: (Accessors.TermAccessor -> Maybe String)+termAccessor accessor =  +  let idx = (\i -> Nothing) +      idxSuff = (\suffix -> \i -> Optionals.map (\s -> Strings.cat2 s suffix) (idx i))+  in ((\x -> case x of+    Accessors.TermAccessorAnnotatedSubject -> Nothing+    Accessors.TermAccessorApplicationFunction -> (Just "fun")+    Accessors.TermAccessorApplicationArgument -> (Just "arg")+    Accessors.TermAccessorLambdaBody -> (Just "body")+    Accessors.TermAccessorUnionCasesDefault -> (Just "default")+    Accessors.TermAccessorUnionCasesBranch v1 -> (Just (Strings.cat2 "." (Core.unName v1)))+    Accessors.TermAccessorLetEnvironment -> (Just "in")+    Accessors.TermAccessorLetBinding v1 -> (Just (Strings.cat2 (Core.unName v1) "="))+    Accessors.TermAccessorListElement v1 -> (idx v1)+    Accessors.TermAccessorMapKey v1 -> (idxSuff ".key" v1)+    Accessors.TermAccessorMapValue v1 -> (idxSuff ".value" v1)+    Accessors.TermAccessorOptionalTerm -> (Just "just")+    Accessors.TermAccessorProductTerm v1 -> (idx v1)+    Accessors.TermAccessorRecordField v1 -> (Just (Strings.cat2 "." (Core.unName v1)))+    Accessors.TermAccessorSetElement v1 -> (idx v1)+    Accessors.TermAccessorSumTerm -> Nothing+    Accessors.TermAccessorTypeLambdaBody -> Nothing+    Accessors.TermAccessorTypeApplicationTerm -> Nothing+    Accessors.TermAccessorInjectionTerm -> Nothing+    Accessors.TermAccessorWrappedTerm -> Nothing) accessor)++-- | Build an accessor graph from a term+termToAccessorGraph :: (M.Map Module.Namespace String -> Core.Term -> Accessors.AccessorGraph)+termToAccessorGraph namespaces term =  +  let dontCareAccessor = Accessors.TermAccessorAnnotatedSubject +      helper = (\ids -> \mroot -> \path -> \state -> \accessorTerm ->  +              let accessor = (fst accessorTerm) +                  currentTerm = (snd accessorTerm)+                  nodesEdges = (fst state)+                  visited = (snd state)+                  nodes = (fst nodesEdges)+                  edges = (snd nodesEdges)+                  nextPath = (Lists.cons accessor path)+              in ((\x -> case x of+                Core.TermLet v1 ->  +                  let bindings = (Core.letBindings v1) +                      env = (Core.letEnvironment v1)+                      bindingNames = (Lists.map Core.bindingName bindings)+                      addBindingName = (\nodesVisitedIds -> \name ->  +                              let currentNodesVisited = (fst nodesVisitedIds) +                                  currentIds = (snd nodesVisitedIds)+                                  currentNodes = (fst currentNodesVisited)+                                  currentVisited = (snd currentNodesVisited)+                                  rawLabel = (Names.compactName namespaces name)+                                  uniqueLabel = (Names.uniqueLabel currentVisited rawLabel)+                                  node = Accessors.AccessorNode {+                                          Accessors.accessorNodeName = name,+                                          Accessors.accessorNodeLabel = rawLabel,+                                          Accessors.accessorNodeId = uniqueLabel}+                                  newVisited = (Sets.insert uniqueLabel currentVisited)+                                  newNodes = (Lists.cons node currentNodes)+                                  newIds = (Maps.insert name node currentIds)+                              in ((newNodes, newVisited), newIds))+                      nodesVisitedIds1 = (Lists.foldl addBindingName (([], visited), ids) bindingNames)+                      nodes1 = (fst (fst nodesVisitedIds1))+                      visited1 = (snd (fst nodesVisitedIds1))+                      ids1 = (snd nodesVisitedIds1)+                      addBindingTerm = (\currentState -> \nodeBinding ->  +                              let root = (fst nodeBinding) +                                  binding = (snd nodeBinding)+                                  term1 = (Core.bindingTerm binding)+                              in (helper ids1 (Just root) [] currentState (dontCareAccessor, term1)))+                      nodeBindingPairs = (Lists.zip nodes1 bindings)+                      stateAfterBindings = (Lists.foldl addBindingTerm ((Lists.concat2 nodes1 nodes, edges), visited1) nodeBindingPairs)+                  in (helper ids1 mroot nextPath stateAfterBindings (Accessors.TermAccessorLetEnvironment, env))+                Core.TermVariable v1 -> (Optionals.maybe state (\root -> Optionals.maybe state (\node ->  +                  let edge = Accessors.AccessorEdge {+                          Accessors.accessorEdgeSource = root,+                          Accessors.accessorEdgePath = (Accessors.AccessorPath (Lists.reverse nextPath)),+                          Accessors.accessorEdgeTarget = node} +                      newEdges = (Lists.cons edge edges)+                  in ((nodes, newEdges), visited)) (Maps.lookup v1 ids)) mroot)+                _ -> (Lists.foldl (helper ids mroot nextPath) state (Rewriting.subtermsWithAccessors currentTerm))) currentTerm))+      initialState = (([], []), Sets.empty)+      result = (helper Maps.empty Nothing [] initialState (dontCareAccessor, term))+      finalNodesEdges = (fst result)+      finalNodes = (fst finalNodesEdges)+      finalEdges = (snd finalNodesEdges)+  in Accessors.AccessorGraph {+    Accessors.accessorGraphNodes = finalNodes,+    Accessors.accessorGraphEdges = finalEdges}
+ src/gen-main/haskell/Hydra/Show/Core.hs view
@@ -0,0 +1,431 @@+-- | String representations of hydra.core types++module Hydra.Show.Core where++import qualified Hydra.Core as Core+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 Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++readTerm :: (t0 -> Maybe t1)+readTerm _ = Nothing++-- | Show a binding as a string+binding :: (Core.Binding -> String)+binding el =  +  let name = (Core.unName (Core.bindingName el)) +      t = (Core.bindingTerm el)+      typeStr = (Optionals.maybe "" (\ts -> Strings.cat2 " : " (typeScheme ts)) (Core.bindingType el))+  in (Strings.cat [+    name,+    " = ",+    term t,+    typeStr])++-- | Show an elimination as a string+elimination :: (Core.Elimination -> String)+elimination elm = ((\x -> case x of+  Core.EliminationProduct v1 ->  +    let arity = (Core.tupleProjectionArity v1) +        index = (Core.tupleProjectionIndex v1)+        domain = (Core.tupleProjectionDomain v1)+    in (Strings.cat [+      "[",+      Literals.showInt32 index,+      "/",+      Literals.showInt32 arity,+      "]"])+  Core.EliminationRecord v1 ->  +    let tname = (Core.unName (Core.projectionTypeName v1)) +        fname = (Core.unName (Core.projectionField v1))+    in (Strings.cat [+      "project(",+      tname,+      "){",+      fname,+      "}"])+  Core.EliminationUnion v1 ->  +    let tname = (Core.unName (Core.caseStatementTypeName v1)) +        mdef = (Core.caseStatementDefault v1)+        cases = (Core.caseStatementCases v1)+        defaultField = (Optionals.maybe [] (\d -> [+                Core.Field {+                  Core.fieldName = (Core.Name "[default]"),+                  Core.fieldTerm = d}]) mdef)+        allFields = (Lists.concat [+                cases,+                defaultField])+    in (Strings.cat [+      "case(",+      tname,+      ")",+      (fields allFields)])+  Core.EliminationWrap v1 -> (Strings.cat [+    "unwrap(",+    Core.unName v1,+    ")"])) elm)++-- | Show a list of fields as a string+fields :: ([Core.Field] -> String)+fields flds =  +  let showField = (\field ->  +          let fname = (Core.unName (Core.fieldName field)) +              fterm = (Core.fieldTerm field)+          in (Strings.cat2 fname (Strings.cat2 "=" (term fterm)))) +      fieldStrs = (Lists.map showField flds)+  in (Strings.cat [+    "{",+    Strings.intercalate ", " fieldStrs,+    "}"])++-- | Show a float value as a string+float :: (Core.FloatValue -> String)+float fv = ((\x -> case x of+  Core.FloatValueBigfloat v1 -> (Strings.cat [+    Literals.showBigfloat v1,+    ":bigfloat"])+  Core.FloatValueFloat32 v1 -> (Strings.cat [+    Literals.showFloat32 v1,+    ":float32"])+  Core.FloatValueFloat64 v1 -> (Strings.cat [+    Literals.showFloat64 v1,+    ":float64"])) fv)++-- | Show a float type as a string+floatType :: (Core.FloatType -> String)+floatType ft = ((\x -> case x of+  Core.FloatTypeBigfloat -> "bigfloat"+  Core.FloatTypeFloat32 -> "float32"+  Core.FloatTypeFloat64 -> "float64") ft)++-- | Show a function as a string+function :: (Core.Function -> String)+function f = ((\x -> case x of+  Core.FunctionElimination v1 -> (elimination v1)+  Core.FunctionLambda v1 -> (lambda v1)+  Core.FunctionPrimitive v1 -> (Strings.cat2 (Core.unName v1) "!")) f)++-- | Show an injection as a string+injection :: (Core.Injection -> String)+injection inj =  +  let tname = (Core.injectionTypeName inj)+  in  +    let f = (Core.injectionField inj)+    in (Strings.cat [+      "inject(",+      Core.unName tname,+      ")",+      (fields [+        f])])++-- | Show an integer value as a string+integer :: (Core.IntegerValue -> String)+integer iv = ((\x -> case x of+  Core.IntegerValueBigint v1 -> (Strings.cat [+    Literals.showBigint v1,+    ":bigint"])+  Core.IntegerValueInt8 v1 -> (Strings.cat [+    Literals.showInt8 v1,+    ":int8"])+  Core.IntegerValueInt16 v1 -> (Strings.cat [+    Literals.showInt16 v1,+    ":int16"])+  Core.IntegerValueInt32 v1 -> (Strings.cat [+    Literals.showInt32 v1,+    ":int32"])+  Core.IntegerValueInt64 v1 -> (Strings.cat [+    Literals.showInt64 v1,+    ":int64"])+  Core.IntegerValueUint8 v1 -> (Strings.cat [+    Literals.showUint8 v1,+    ":uint8"])+  Core.IntegerValueUint16 v1 -> (Strings.cat [+    Literals.showUint16 v1,+    ":uint16"])+  Core.IntegerValueUint32 v1 -> (Strings.cat [+    Literals.showUint32 v1,+    ":uint32"])+  Core.IntegerValueUint64 v1 -> (Strings.cat [+    Literals.showUint64 v1,+    ":uint64"])) iv)++-- | Show an integer type as a string+integerType :: (Core.IntegerType -> String)+integerType it = ((\x -> case x of+  Core.IntegerTypeBigint -> "bigint"+  Core.IntegerTypeInt8 -> "int8"+  Core.IntegerTypeInt16 -> "int16"+  Core.IntegerTypeInt32 -> "int32"+  Core.IntegerTypeInt64 -> "int64"+  Core.IntegerTypeUint8 -> "uint8"+  Core.IntegerTypeUint16 -> "uint16"+  Core.IntegerTypeUint32 -> "uint32"+  Core.IntegerTypeUint64 -> "uint64") it)++-- | Show a lambda as a string+lambda :: (Core.Lambda -> String)+lambda l =  +  let v = (Core.unName (Core.lambdaParameter l)) +      mt = (Core.lambdaDomain l)+      body = (Core.lambdaBody l)+      typeStr = (Optionals.maybe "" (\t -> Strings.cat2 ":" (type_ t)) mt)+  in (Strings.cat [+    "\955",+    v,+    typeStr,+    ".",+    (term body)])++list :: ((t0 -> String) -> [t0] -> String)+list f xs =  +  let elementStrs = (Lists.map f xs)+  in (Strings.cat [+    "[",+    Strings.intercalate ", " elementStrs,+    "]"])++-- | Show a literal as a string+literal :: (Core.Literal -> String)+literal l = ((\x -> case x of+  Core.LiteralBinary _ -> "[binary]"+  Core.LiteralBoolean v1 -> (Logic.ifElse v1 "true" "false")+  Core.LiteralFloat v1 -> (float v1)+  Core.LiteralInteger v1 -> (integer v1)+  Core.LiteralString v1 -> (Literals.showString v1)) l)++-- | Show a literal type as a string+literalType :: (Core.LiteralType -> String)+literalType lt = ((\x -> case x of+  Core.LiteralTypeBinary -> "binary"+  Core.LiteralTypeBoolean -> "boolean"+  Core.LiteralTypeFloat v1 -> (floatType v1)+  Core.LiteralTypeInteger v1 -> (integerType v1)+  Core.LiteralTypeString -> "string") lt)++-- | Show a term as a string+term :: (Core.Term -> String)+term t =  +  let gatherTerms = (\prev -> \app ->  +          let lhs = (Core.applicationFunction app) +              rhs = (Core.applicationArgument app)+          in ((\x -> case x of+            Core.TermApplication v1 -> (gatherTerms (Lists.cons rhs prev) v1)+            _ -> (Lists.cons lhs (Lists.cons rhs prev))) lhs))+  in ((\x -> case x of+    Core.TermAnnotated v1 -> (term (Core.annotatedTermSubject v1))+    Core.TermApplication v1 ->  +      let terms = (gatherTerms [] v1) +          termStrs = (Lists.map term terms)+      in (Strings.cat [+        "(",+        Strings.intercalate " @ " termStrs,+        ")"])+    Core.TermFunction v1 -> (function v1)+    Core.TermLet v1 ->  +      let bindings = (Core.letBindings v1) +          env = (Core.letEnvironment v1)+          bindingStrs = (Lists.map binding bindings)+      in (Strings.cat [+        "let ",+        Strings.intercalate ", " bindingStrs,+        " in ",+        (term env)])+    Core.TermList v1 ->  +      let termStrs = (Lists.map term v1)+      in (Strings.cat [+        "[",+        Strings.intercalate ", " termStrs,+        "]"])+    Core.TermLiteral v1 -> (literal v1)+    Core.TermMap v1 ->  +      let entry = (\p -> Strings.cat [+              term (fst p),+              "=",+              (term (snd p))])+      in (Strings.cat [+        "{",+        Strings.intercalate ", " (Lists.map entry (Maps.toList v1)),+        "}"])+    Core.TermOptional v1 -> (Optionals.maybe "nothing" (\t -> Strings.cat [+      "just(",+      term t,+      ")"]) v1)+    Core.TermProduct v1 ->  +      let termStrs = (Lists.map term v1)+      in (Strings.cat [+        "(",+        Strings.intercalate ", " termStrs,+        ")"])+    Core.TermRecord v1 ->  +      let tname = (Core.unName (Core.recordTypeName v1)) +          flds = (Core.recordFields v1)+      in (Strings.cat [+        "record(",+        tname,+        ")",+        (fields flds)])+    Core.TermSet v1 -> (Strings.cat [+      "{",+      Strings.intercalate ", " (Lists.map term (Sets.toList v1)),+      "}"])+    Core.TermSum v1 ->  +      let index = (Core.sumIndex v1) +          size = (Core.sumSize v1)+          t2 = (Core.sumTerm v1)+      in (Strings.cat [+        "(",+        Literals.showInt32 index,+        "/",+        Literals.showInt32 size,+        "=",+        term t2,+        ")"])+    Core.TermTypeLambda v1 ->  +      let param = (Core.unName (Core.typeLambdaParameter v1)) +          body = (Core.typeLambdaBody v1)+      in (Strings.cat [+        "\923",+        param,+        ".",+        (term body)])+    Core.TermTypeApplication v1 ->  +      let t2 = (Core.typedTermTerm v1) +          typ = (Core.typedTermType v1)+      in (Strings.cat [+        term t2,+        "\10216",+        type_ typ,+        "\10217"])+    Core.TermUnion v1 -> (injection v1)+    Core.TermUnit -> "unit"+    Core.TermVariable v1 -> (Core.unName v1)+    Core.TermWrap v1 ->  +      let tname = (Core.unName (Core.wrappedTermTypeName v1)) +          term1 = (Core.wrappedTermObject v1)+      in (Strings.cat [+        "wrap(",+        tname,+        "){",+        term term1,+        "}"])) t)++-- | Show a type as a string+type_ :: (Core.Type -> String)+type_ typ =  +  let showFieldType = (\ft ->  +          let fname = (Core.unName (Core.fieldTypeName ft)) +              ftyp = (Core.fieldTypeType ft)+          in (Strings.cat [+            fname,+            ":",+            (type_ ftyp)])) +      showRowType = (\rt ->  +              let flds = (Core.rowTypeFields rt) +                  fieldStrs = (Lists.map showFieldType flds)+              in (Strings.cat [+                "{",+                Strings.intercalate ", " fieldStrs,+                "}"]))+      gatherTypes = (\prev -> \app ->  +              let lhs = (Core.applicationTypeFunction app) +                  rhs = (Core.applicationTypeArgument app)+              in ((\x -> case x of+                Core.TypeApplication v1 -> (gatherTypes (Lists.cons rhs prev) v1)+                _ -> (Lists.cons lhs (Lists.cons rhs prev))) lhs))+      gatherFunctionTypes = (\prev -> \t -> (\x -> case x of+              Core.TypeFunction v1 ->  +                let dom = (Core.functionTypeDomain v1) +                    cod = (Core.functionTypeCodomain v1)+                in (gatherFunctionTypes (Lists.cons dom prev) cod)+              _ -> (Lists.reverse (Lists.cons t prev))) t)+  in ((\x -> case x of+    Core.TypeAnnotated v1 -> (type_ (Core.annotatedTypeSubject v1))+    Core.TypeApplication v1 ->  +      let types = (gatherTypes [] v1) +          typeStrs = (Lists.map type_ types)+      in (Strings.cat [+        "(",+        Strings.intercalate " @ " typeStrs,+        ")"])+    Core.TypeForall v1 ->  +      let var = (Core.unName (Core.forallTypeParameter v1)) +          body = (Core.forallTypeBody v1)+      in (Strings.cat [+        "(\8704",+        var,+        ".",+        type_ body,+        ")"])+    Core.TypeFunction _ ->  +      let types = (gatherFunctionTypes [] typ) +          typeStrs = (Lists.map type_ types)+      in (Strings.cat [+        "(",+        Strings.intercalate " \8594 " typeStrs,+        ")"])+    Core.TypeList v1 -> (Strings.cat [+      "list<",+      type_ v1,+      ">"])+    Core.TypeLiteral v1 -> (literalType v1)+    Core.TypeMap v1 ->  +      let keyTyp = (Core.mapTypeKeys v1) +          valTyp = (Core.mapTypeValues v1)+      in (Strings.cat [+        "map<",+        type_ keyTyp,+        ", ",+        type_ valTyp,+        ">"])+    Core.TypeOptional v1 -> (Strings.cat [+      "optional<",+      type_ v1,+      ">"])+    Core.TypeProduct v1 ->  +      let typeStrs = (Lists.map type_ v1)+      in (Strings.intercalate "\215" typeStrs)+    Core.TypeRecord v1 -> (Strings.cat2 "record" (showRowType v1))+    Core.TypeSet v1 -> (Strings.cat [+      "set<",+      type_ v1,+      ">"])+    Core.TypeSum v1 ->  +      let typeStrs = (Lists.map type_ v1)+      in (Strings.intercalate "+" typeStrs)+    Core.TypeUnion v1 -> (Strings.cat2 "union" (showRowType v1))+    Core.TypeUnit -> "unit"+    Core.TypeVariable v1 -> (Core.unName v1)+    Core.TypeWrap v1 ->  +      let tname = (Core.unName (Core.wrappedTypeTypeName v1)) +          typ1 = (Core.wrappedTypeObject v1)+      in (Strings.cat [+        "wrap[",+        tname,+        "](",+        type_ typ1,+        ")"])) typ)++-- | Show a type scheme as a string+typeScheme :: (Core.TypeScheme -> String)+typeScheme ts =  +  let vars = (Core.typeSchemeVariables ts) +      body = (Core.typeSchemeType ts)+      varNames = (Lists.map Core.unName vars)+      fa = (Logic.ifElse (Lists.null vars) "" (Strings.cat [+              "\8704[",+              Strings.intercalate "," varNames,+              "]."]))+  in (Strings.cat [+    "(",+    fa,+    type_ body,+    ")"])
+ src/gen-main/haskell/Hydra/Show/Graph.hs view
@@ -0,0 +1,24 @@+-- | String representations of hydra.graph types++module Hydra.Show.Graph where++import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Show.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Show a graph as a string+graph :: (Graph.Graph -> String)+graph graph =  +  let elements = (Maps.elems (Graph.graphElements graph)) +      elementStrs = (Lists.map Core.binding elements)+  in (Strings.cat [+    "{",+    Strings.intercalate ", " elementStrs,+    "}"])
+ src/gen-main/haskell/Hydra/Show/Mantle.hs view
@@ -0,0 +1,52 @@+-- | String representations of hydra.mantle types++module Hydra.Show.Mantle where++import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Show a term variant as a string+termVariant :: (Mantle.TermVariant -> String)+termVariant x = case x of+  Mantle.TermVariantAnnotated -> "annotated"+  Mantle.TermVariantApplication -> "application"+  Mantle.TermVariantFunction -> "function"+  Mantle.TermVariantLet -> "let"+  Mantle.TermVariantList -> "list"+  Mantle.TermVariantLiteral -> "literal"+  Mantle.TermVariantMap -> "map"+  Mantle.TermVariantOptional -> "optional"+  Mantle.TermVariantProduct -> "product"+  Mantle.TermVariantRecord -> "record"+  Mantle.TermVariantSet -> "set"+  Mantle.TermVariantSum -> "sum"+  Mantle.TermVariantTypeLambda -> "typeLambda"+  Mantle.TermVariantTypeApplication -> "typeApplication"+  Mantle.TermVariantUnion -> "union"+  Mantle.TermVariantUnit -> "unit"+  Mantle.TermVariantVariable -> "variable"+  Mantle.TermVariantWrap -> "wrap"++-- | Show a type variant as a string+typeVariant :: (Mantle.TypeVariant -> String)+typeVariant x = case x of+  Mantle.TypeVariantAnnotated -> "annotated"+  Mantle.TypeVariantApplication -> "application"+  Mantle.TypeVariantForall -> "forall"+  Mantle.TypeVariantFunction -> "function"+  Mantle.TypeVariantList -> "list"+  Mantle.TypeVariantLiteral -> "literal"+  Mantle.TypeVariantMap -> "map"+  Mantle.TypeVariantOptional -> "optional"+  Mantle.TypeVariantProduct -> "product"+  Mantle.TypeVariantRecord -> "record"+  Mantle.TypeVariantSet -> "set"+  Mantle.TypeVariantSum -> "sum"+  Mantle.TypeVariantUnion -> "union"+  Mantle.TypeVariantUnit -> "unit"+  Mantle.TypeVariantVariable -> "variable"+  Mantle.TypeVariantWrap -> "wrap"
+ src/gen-main/haskell/Hydra/Show/Typing.hs view
@@ -0,0 +1,43 @@+-- | String representations of hydra.typing types++module Hydra.Show.Typing where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Strings as Strings+import qualified Hydra.Show.Core as Core_+import qualified Hydra.Typing as Typing+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Show a type constraint as a string+typeConstraint :: (Typing.TypeConstraint -> String)+typeConstraint tc =  +  let ltyp = (Typing.typeConstraintLeft tc) +      rtyp = (Typing.typeConstraintRight tc)+  in (Strings.cat [+    Core_.type_ ltyp,+    "\8801",+    (Core_.type_ rtyp)])++-- | Show a type substitution as a string+typeSubst :: (Typing.TypeSubst -> String)+typeSubst ts =  +  let subst = (Typing.unTypeSubst ts) +      pairs = (Maps.toList subst)+      showPair = (\pair ->  +              let name = (Core.unName (fst pair)) +                  typ = (snd pair)+              in (Strings.cat [+                name,+                "\8614",+                (Core_.type_ typ)]))+      pairStrs = (Lists.map showPair pairs)+  in (Strings.cat [+    "{",+    Strings.intercalate "," pairStrs,+    "}"])
+ src/gen-main/haskell/Hydra/Sorting.hs view
@@ -0,0 +1,56 @@+-- | Utilities for sorting.++module Hydra.Sorting where++import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Logic as Logic+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Tarjan as Tarjan+import qualified Hydra.Topology as Topology+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++createOrderingIsomorphism :: (Ord t0) => ([t0] -> [t0] -> Topology.OrderingIsomorphism t1)+createOrderingIsomorphism sourceOrd targetOrd =  +  let sourceToTargetMapping = (\els ->  +          let mp = (Maps.fromList (Lists.zip sourceOrd els))+          in (Optionals.cat (Lists.map (\n -> Maps.lookup n mp) targetOrd)))+  in  +    let targetToSourceMapping = (\els ->  +            let mp = (Maps.fromList (Lists.zip targetOrd els))+            in (Optionals.cat (Lists.map (\n -> Maps.lookup n mp) sourceOrd)))+    in Topology.OrderingIsomorphism {+      Topology.orderingIsomorphismEncode = sourceToTargetMapping,+      Topology.orderingIsomorphismDecode = targetToSourceMapping}++topologicalSort :: (Ord t0) => ([(t0, [t0])] -> Mantle.Either [[t0]] [t0])+topologicalSort pairs =  +  let sccs = (topologicalSortComponents pairs)+  in  +    let isCycle = (\scc -> Logic.not (Lists.null (Lists.tail scc)))+    in  +      let withCycles = (Lists.filter isCycle sccs)+      in (Logic.ifElse (Lists.null withCycles) (Mantle.EitherRight (Lists.concat sccs)) (Mantle.EitherLeft withCycles))++topologicalSortComponents :: (Ord t0) => ([(t0, [t0])] -> [[t0]])+topologicalSortComponents pairs =  +  let graphResult = (Tarjan.adjacencyListsToGraph pairs)+  in  +    let g = (fst graphResult)+    in  +      let getKey = (snd graphResult)+      in (Lists.map (\comp -> Lists.map getKey comp) (Tarjan.stronglyConnectedComponents g))++topologicalSortNodes :: (Ord t1) => ((t0 -> t1) -> (t0 -> [t1]) -> [t0] -> [[t0]])+topologicalSortNodes getKey getAdj nodes =  +  let nodesByKey = (Maps.fromList (Lists.map (\n -> (getKey n, n)) nodes))+  in  +    let pairs = (Lists.map (\n -> (getKey n, (getAdj n))) nodes)+    in  +      let comps = (topologicalSortComponents pairs)+      in (Lists.map (\c -> Optionals.cat (Lists.map (\k -> Maps.lookup k nodesByKey) c)) comps)
− src/gen-main/haskell/Hydra/Strip.hs 
@@ -1,34 +0,0 @@--- | Several functions for stripping annotations from types and terms.--module Hydra.Strip where--import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Strip all annotations from a term, including first-class type annotations-fullyStripTerm :: (Core.Term -> Core.Term)-fullyStripTerm t = ((\x -> case x of-  Core.TermAnnotated v309 -> (fullyStripTerm (Core.annotatedTermSubject v309))-  Core.TermTyped v310 -> (fullyStripTerm (Core.typedTermTerm v310))-  _ -> t) t)---- | Strip all annotations from a term-stripTerm :: (Core.Term -> Core.Term)-stripTerm t = ((\x -> case x of-  Core.TermAnnotated v311 -> (stripTerm (Core.annotatedTermSubject v311))-  _ -> t) t)---- | Strip all annotations from a term-stripType :: (Core.Type -> Core.Type)-stripType t = ((\x -> case x of-  Core.TypeAnnotated v312 -> (stripType (Core.annotatedTypeSubject v312))-  _ -> t) t)---- | Strip any top-level type lambdas from a type, extracting the (possibly nested) type body-stripTypeParameters :: (Core.Type -> Core.Type)-stripTypeParameters t = ((\x -> case x of-  Core.TypeLambda v313 -> (stripTypeParameters (Core.lambdaTypeBody v313))-  _ -> t) (stripType t))
+ src/gen-main/haskell/Hydra/Substitution.hs view
@@ -0,0 +1,137 @@+-- | Variable substitution in type and term expressions.++module Hydra.Substitution where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+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.Rewriting as Rewriting+import qualified Hydra.Typing as Typing+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++composeTypeSubst :: (Typing.TypeSubst -> Typing.TypeSubst -> Typing.TypeSubst)+composeTypeSubst s1 s2 =  +  let isExtra = (\k -> \v -> Optionals.isNothing (Maps.lookup k (Typing.unTypeSubst s1))) +      withExtra = (Maps.filterWithKey isExtra (Typing.unTypeSubst s2))+  in (Typing.TypeSubst (Maps.union withExtra (Maps.map (substInType s2) (Typing.unTypeSubst s1))))++composeTypeSubstList :: ([Typing.TypeSubst] -> Typing.TypeSubst)+composeTypeSubstList = (Lists.foldl composeTypeSubst idTypeSubst)++idTypeSubst :: Typing.TypeSubst+idTypeSubst = (Typing.TypeSubst Maps.empty)++singletonTypeSubst :: (Core.Name -> Core.Type -> Typing.TypeSubst)+singletonTypeSubst v t = (Typing.TypeSubst (Maps.singleton v t))++substituteInConstraint :: (Typing.TypeSubst -> Typing.TypeConstraint -> Typing.TypeConstraint)+substituteInConstraint subst c = Typing.TypeConstraint {+  Typing.typeConstraintLeft = (substInType subst (Typing.typeConstraintLeft c)),+  Typing.typeConstraintRight = (substInType subst (Typing.typeConstraintRight c)),+  Typing.typeConstraintComment = (Typing.typeConstraintComment c)}++substituteInConstraints :: (Typing.TypeSubst -> [Typing.TypeConstraint] -> [Typing.TypeConstraint])+substituteInConstraints subst cs = (Lists.map (substituteInConstraint subst) cs)++substInContext :: (Typing.TypeSubst -> Typing.InferenceContext -> Typing.InferenceContext)+substInContext subst cx = Typing.InferenceContext {+  Typing.inferenceContextSchemaTypes = (Typing.inferenceContextSchemaTypes cx),+  Typing.inferenceContextPrimitiveTypes = (Typing.inferenceContextPrimitiveTypes cx),+  Typing.inferenceContextDataTypes = (Maps.map (substInTypeScheme subst) (Typing.inferenceContextDataTypes cx)),+  Typing.inferenceContextDebug = (Typing.inferenceContextDebug cx)}++substituteInTerm :: (Typing.TermSubst -> Core.Term -> Core.Term)+substituteInTerm subst =  +  let s = (Typing.unTermSubst subst) +      rewrite = (\recurse -> \term ->  +              let withLambda = (\l ->  +                      let v = (Core.lambdaParameter l) +                          subst2 = (Typing.TermSubst (Maps.remove v s))+                      in (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = v,+                        Core.lambdaDomain = (Core.lambdaDomain l),+                        Core.lambdaBody = (substituteInTerm subst2 (Core.lambdaBody l))})))) +                  withLet = (\lt ->  +                          let bindings = (Core.letBindings lt) +                              names = (Sets.fromList (Lists.map Core.bindingName bindings))+                              subst2 = (Typing.TermSubst (Maps.filterWithKey (\k -> \v -> Logic.not (Sets.member k names)) s))+                              rewriteBinding = (\b -> Core.Binding {+                                      Core.bindingName = (Core.bindingName b),+                                      Core.bindingTerm = (substituteInTerm subst2 (Core.bindingTerm b)),+                                      Core.bindingType = (Core.bindingType b)})+                          in (Core.TermLet (Core.Let {+                            Core.letBindings = (Lists.map rewriteBinding bindings),+                            Core.letEnvironment = (substituteInTerm subst2 (Core.letEnvironment lt))})))+              in ((\x -> case x of+                Core.TermFunction v1 -> ((\x -> case x of+                  Core.FunctionLambda v2 -> (withLambda v2)+                  _ -> (recurse term)) v1)+                Core.TermLet v1 -> (withLet v1)+                Core.TermVariable v1 -> (Optionals.maybe (recurse term) (\sterm -> sterm) (Maps.lookup v1 s))+                _ -> (recurse term)) term))+  in (Rewriting.rewriteTerm rewrite)++substInType :: (Typing.TypeSubst -> Core.Type -> Core.Type)+substInType subst =  +  let rewrite = (\recurse -> \typ -> (\x -> case x of+          Core.TypeForall v1 -> (Optionals.maybe (recurse typ) (\styp -> Core.TypeForall (Core.ForallType {+            Core.forallTypeParameter = (Core.forallTypeParameter v1),+            Core.forallTypeBody = (substInType (removeVar (Core.forallTypeParameter v1)) (Core.forallTypeBody v1))})) (Maps.lookup (Core.forallTypeParameter v1) (Typing.unTypeSubst subst)))+          Core.TypeVariable v1 -> (Optionals.maybe typ (\styp -> styp) (Maps.lookup v1 (Typing.unTypeSubst subst)))+          _ -> (recurse typ)) typ) +      removeVar = (\v -> Typing.TypeSubst (Maps.remove v (Typing.unTypeSubst subst)))+  in (Rewriting.rewriteType rewrite)++substInTypeScheme :: (Typing.TypeSubst -> Core.TypeScheme -> Core.TypeScheme)+substInTypeScheme subst ts = Core.TypeScheme {+  Core.typeSchemeVariables = (Core.typeSchemeVariables ts),+  Core.typeSchemeType = (substInType subst (Core.typeSchemeType ts))}++substTypesInTerm :: (Typing.TypeSubst -> Core.Term -> Core.Term)+substTypesInTerm subst =  +  let rewrite = (\recurse -> \term ->  +          let forElimination = (\elm -> (\x -> case x of+                  Core.EliminationProduct v1 -> (forTupleProjection v1)+                  _ -> (recurse term)) elm) +              forFunction = (\f -> (\x -> case x of+                      Core.FunctionElimination v1 -> (forElimination v1)+                      Core.FunctionLambda v1 -> (forLambda v1)+                      _ -> (recurse term)) f)+              forLambda = (\l -> recurse (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.lambdaParameter l),+                      Core.lambdaDomain = (Optionals.map (substInType subst) (Core.lambdaDomain l)),+                      Core.lambdaBody = (Core.lambdaBody l)}))))+              forLet = (\l ->  +                      let rewriteBinding = (\b -> Core.Binding {+                              Core.bindingName = (Core.bindingName b),+                              Core.bindingTerm = (Core.bindingTerm b),+                              Core.bindingType = (Optionals.map (substInTypeScheme subst) (Core.bindingType b))})+                      in (recurse (Core.TermLet (Core.Let {+                        Core.letBindings = (Lists.map rewriteBinding (Core.letBindings l)),+                        Core.letEnvironment = (Core.letEnvironment l)}))))+              forTupleProjection = (\tp -> recurse (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                      Core.tupleProjectionArity = (Core.tupleProjectionArity tp),+                      Core.tupleProjectionIndex = (Core.tupleProjectionIndex tp),+                      Core.tupleProjectionDomain = (Optionals.map (\types -> Lists.map (substInType subst) types) (Core.tupleProjectionDomain tp))})))))+              forTypeLambda = (\ta ->  +                      let param = (Core.typeLambdaParameter ta) +                          subst2 = (Typing.TypeSubst (Maps.remove param (Typing.unTypeSubst subst)))+                      in (Core.TermTypeLambda (Core.TypeLambda {+                        Core.typeLambdaParameter = param,+                        Core.typeLambdaBody = (substTypesInTerm subst2 (Core.typeLambdaBody ta))})))+          in ((\x -> case x of+            Core.TermFunction v1 -> (forFunction v1)+            Core.TermLet v1 -> (forLet v1)+            Core.TermTypeLambda v1 -> (forTypeLambda v1)+            Core.TermTypeApplication v1 -> (recurse (Core.TermTypeApplication (Core.TypedTerm {+              Core.typedTermTerm = (Core.typedTermTerm v1),+              Core.typedTermType = (substInType subst (Core.typedTermType v1))})))+            _ -> (recurse term)) term))+  in (Rewriting.rewriteTerm rewrite)
+ src/gen-main/haskell/Hydra/Tabular.hs view
@@ -0,0 +1,41 @@+-- | A simple, untyped tabular data model, suitable for CSVs and TSVs++module Hydra.Tabular where++import qualified Hydra.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | A data row, containing optional-valued cells; one per column+newtype DataRow v = +  DataRow {+    unDataRow :: [Maybe v]}+  deriving (Eq, Ord, Read, Show)++_DataRow = (Core.Name "hydra.tabular.DataRow")++-- | A header row, containing column names (but no types or data)+newtype HeaderRow = +  HeaderRow {+    unHeaderRow :: [String]}+  deriving (Eq, Ord, Read, Show)++_HeaderRow = (Core.Name "hydra.tabular.HeaderRow")++-- | A simple table as in a CSV file, having an optional header row and any number of data rows+data Table v = +  Table {+    -- | The optional header row of the table. If present, the header must have the same number of cells as each data row.+    tableHeader :: (Maybe HeaderRow),+    -- | The data rows of the table. Each row must have the same number of cells.+    tableData :: [DataRow v]}+  deriving (Eq, Ord, Read, Show)++_Table = (Core.Name "hydra.tabular.Table")++_Table_header = (Core.Name "header")++_Table_data = (Core.Name "data")
+ src/gen-main/haskell/Hydra/Tarjan.hs view
@@ -0,0 +1,127 @@+-- | This implementation of Tarjan's algorithm was originally based on GraphSCC by Iavor S. Diatchki: https://hackage.haskell.org/package/GraphSCC.++module Hydra.Tarjan where++import qualified Hydra.Compute as Compute+import qualified Hydra.Constants as Constants+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Lib.Logic as Logic+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Lib.Math as Math+import qualified Hydra.Lib.Optionals as Optionals+import qualified Hydra.Lib.Sets as Sets+import qualified Hydra.Monads as Monads+import qualified Hydra.Topology as Topology+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++adjacencyListsToGraph :: (Ord t0) => ([(t0, [t0])] -> (M.Map Int [Int], (Int -> t0)))+adjacencyListsToGraph edges0 =  +  let sortedEdges = (Lists.sortOn fst edges0) +      indexedEdges = (Lists.zip (Math.range 0 (Lists.length sortedEdges)) sortedEdges)+      keyToVertex = (Maps.fromList (Lists.map (\vkNeighbors ->  +              let v = (fst vkNeighbors) +                  kNeighbors = (snd vkNeighbors)+                  k = (fst kNeighbors)+              in (k, v)) indexedEdges))+      vertexMap = (Maps.fromList (Lists.map (\vkNeighbors ->  +              let v = (fst vkNeighbors) +                  kNeighbors = (snd vkNeighbors)+                  k = (fst kNeighbors)+              in (v, k)) indexedEdges))+      graph = (Maps.fromList (Lists.map (\vkNeighbors ->  +              let v = (fst vkNeighbors) +                  kNeighbors = (snd vkNeighbors)+                  neighbors = (snd kNeighbors)+              in (v, (Optionals.mapMaybe (\k -> Maps.lookup k keyToVertex) neighbors))) indexedEdges))+      vertexToKey = (\v -> Optionals.fromJust (Maps.lookup v vertexMap))+  in (graph, vertexToKey)++-- | Compute the strongly connected components of the given graph. The components are returned in reverse topological order+stronglyConnectedComponents :: (M.Map Int [Int] -> [[Int]])+stronglyConnectedComponents graph =  +  let verts = (Maps.keys graph) +      processVertex = (\v -> Flows.bind (Flows.map (\st -> Maps.member v (Topology.tarjanStateIndices st)) Monads.getState) (\visited -> Logic.ifElse (Logic.not visited) (strongConnect graph v) (Flows.pure ())))+      finalState = (Monads.exec (Flows.mapList processVertex verts) initialState)+  in (Lists.reverse (Lists.map Lists.sort (Topology.tarjanStateSccs finalState)))++-- | Initial state for Tarjan's algorithm+initialState :: Topology.TarjanState+initialState = Topology.TarjanState {+  Topology.tarjanStateCounter = 0,+  Topology.tarjanStateIndices = Maps.empty,+  Topology.tarjanStateLowLinks = Maps.empty,+  Topology.tarjanStateStack = [],+  Topology.tarjanStateOnStack = Sets.empty,+  Topology.tarjanStateSccs = []}++-- | Pop vertices off the stack until the given vertex is reached, collecting the current strongly connected component+popStackUntil :: (Int -> Compute.Flow Topology.TarjanState [Int])+popStackUntil v =  +  let go = (\acc -> Flows.bind Monads.getState (\st -> Logic.ifElse (Lists.null (Topology.tarjanStateStack st)) (Flows.fail "popStackUntil: empty stack") ( +          let x = (Lists.head (Topology.tarjanStateStack st)) +              xs = (Lists.tail (Topology.tarjanStateStack st))+              newSt = Topology.TarjanState {+                      Topology.tarjanStateCounter = (Topology.tarjanStateCounter st),+                      Topology.tarjanStateIndices = (Topology.tarjanStateIndices st),+                      Topology.tarjanStateLowLinks = (Topology.tarjanStateLowLinks st),+                      Topology.tarjanStateStack = xs,+                      Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack st),+                      Topology.tarjanStateSccs = (Topology.tarjanStateSccs st)}+              newSt2 = Topology.TarjanState {+                      Topology.tarjanStateCounter = (Topology.tarjanStateCounter newSt),+                      Topology.tarjanStateIndices = (Topology.tarjanStateIndices newSt),+                      Topology.tarjanStateLowLinks = (Topology.tarjanStateLowLinks newSt),+                      Topology.tarjanStateStack = (Topology.tarjanStateStack newSt),+                      Topology.tarjanStateOnStack = (Sets.delete x (Topology.tarjanStateOnStack st)),+                      Topology.tarjanStateSccs = (Topology.tarjanStateSccs newSt)}+              acc_ = (Lists.cons x acc)+          in (Flows.bind (Monads.putState newSt2) (\_ -> Logic.ifElse (Equality.equal x v) (Flows.pure (Lists.reverse acc_)) (go acc_))))))+  in (go [])++-- | Visit a vertex and recursively explore its successors+strongConnect :: (M.Map Int [Int] -> Int -> Compute.Flow Topology.TarjanState ())+strongConnect graph v = (Flows.bind Monads.getState (\st ->  +  let i = (Topology.tarjanStateCounter st) +      newSt = Topology.TarjanState {+              Topology.tarjanStateCounter = (Math.add i 1),+              Topology.tarjanStateIndices = (Maps.insert v i (Topology.tarjanStateIndices st)),+              Topology.tarjanStateLowLinks = (Maps.insert v i (Topology.tarjanStateLowLinks st)),+              Topology.tarjanStateStack = (Lists.cons v (Topology.tarjanStateStack st)),+              Topology.tarjanStateOnStack = (Sets.insert v (Topology.tarjanStateOnStack st)),+              Topology.tarjanStateSccs = (Topology.tarjanStateSccs st)}+      neighbors = (Maps.findWithDefault [] v graph)+      processNeighbor = (\w -> Flows.bind Monads.getState (\st_ -> Logic.ifElse (Logic.not (Maps.member w (Topology.tarjanStateIndices st_))) (Flows.bind (strongConnect graph w) (\_ -> Flows.bind Monads.getState (\stAfter ->  +              let low_v = (Maps.findWithDefault Constants.maxInt32 v (Topology.tarjanStateLowLinks stAfter)) +                  low_w = (Maps.findWithDefault Constants.maxInt32 w (Topology.tarjanStateLowLinks stAfter))+              in (Flows.bind (Monads.modify (\s -> Topology.TarjanState {+                Topology.tarjanStateCounter = (Topology.tarjanStateCounter s),+                Topology.tarjanStateIndices = (Topology.tarjanStateIndices s),+                Topology.tarjanStateLowLinks = (Maps.insert v (Equality.min low_v low_w) (Topology.tarjanStateLowLinks s)),+                Topology.tarjanStateStack = (Topology.tarjanStateStack s),+                Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack s),+                Topology.tarjanStateSccs = (Topology.tarjanStateSccs s)})) (\_ -> Flows.pure ()))))) (Logic.ifElse (Sets.member w (Topology.tarjanStateOnStack st_)) ( +              let low_v = (Maps.findWithDefault Constants.maxInt32 v (Topology.tarjanStateLowLinks st_)) +                  idx_w = (Maps.findWithDefault Constants.maxInt32 w (Topology.tarjanStateIndices st_))+              in (Flows.bind (Monads.modify (\s -> Topology.TarjanState {+                Topology.tarjanStateCounter = (Topology.tarjanStateCounter s),+                Topology.tarjanStateIndices = (Topology.tarjanStateIndices s),+                Topology.tarjanStateLowLinks = (Maps.insert v (Equality.min low_v idx_w) (Topology.tarjanStateLowLinks s)),+                Topology.tarjanStateStack = (Topology.tarjanStateStack s),+                Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack s),+                Topology.tarjanStateSccs = (Topology.tarjanStateSccs s)})) (\_ -> Flows.pure ()))) (Flows.pure ()))))+  in (Flows.bind (Monads.putState newSt) (\_ -> Flows.bind (Flows.mapList processNeighbor neighbors) (\_ -> Flows.bind Monads.getState (\stFinal ->  +    let low_v = (Maps.findWithDefault Constants.maxInt32 v (Topology.tarjanStateLowLinks stFinal)) +        idx_v = (Maps.findWithDefault Constants.maxInt32 v (Topology.tarjanStateIndices stFinal))+    in (Logic.ifElse (Equality.equal low_v idx_v) (Flows.bind (popStackUntil v) (\comp -> Flows.bind (Monads.modify (\s -> Topology.TarjanState {+      Topology.tarjanStateCounter = (Topology.tarjanStateCounter s),+      Topology.tarjanStateIndices = (Topology.tarjanStateIndices s),+      Topology.tarjanStateLowLinks = (Topology.tarjanStateLowLinks s),+      Topology.tarjanStateStack = (Topology.tarjanStateStack s),+      Topology.tarjanStateOnStack = (Topology.tarjanStateOnStack s),+      Topology.tarjanStateSccs = (Lists.cons comp (Topology.tarjanStateSccs s))})) (\_ -> Flows.pure ()))) (Flows.pure ()))))))))
+ src/gen-main/haskell/Hydra/Templates.hs view
@@ -0,0 +1,83 @@+-- | A utility which instantiates a nonrecursive type with default values++module Hydra.Templates where++import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Decode.Core as Core_+import qualified Hydra.Graph as Graph+import qualified Hydra.Lib.Flows as Flows+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.Show.Core as Core__+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Create a graph schema from a graph which contains nothing but encoded type definitions+graphToSchema :: (Graph.Graph -> Compute.Flow Graph.Graph (M.Map Core.Name Core.Type))+graphToSchema g =  +  let toPair = (\nameAndEl ->  +          let name = (fst nameAndEl) +              el = (snd nameAndEl)+          in (Flows.bind (Core_.type_ (Core.bindingTerm el)) (\t -> Flows.pure (name, t))))+  in (Flows.bind (Flows.mapList toPair (Maps.toList (Graph.graphElements g))) (\pairs -> Flows.pure (Maps.fromList pairs)))++instantiateTemplate :: (Bool -> M.Map Core.Name Core.Type -> Core.Type -> Compute.Flow t0 Core.Term)+instantiateTemplate minimal schema t =  +  let inst = (instantiateTemplate minimal schema) +      noPoly = (Flows.fail "Polymorphic and function types are not currently supported")+  in ((\x -> case x of+    Core.TypeAnnotated v1 -> (inst (Core.annotatedTypeSubject v1))+    Core.TypeApplication _ -> noPoly+    Core.TypeFunction _ -> noPoly+    Core.TypeForall _ -> noPoly+    Core.TypeList v1 -> (Logic.ifElse minimal (Flows.pure (Core.TermList [])) (Flows.bind (inst v1) (\e -> Flows.pure (Core.TermList [+      e]))))+    Core.TypeLiteral v1 -> (Flows.pure (Core.TermLiteral ((\x -> case x of+      Core.LiteralTypeBinary -> (Core.LiteralString "")+      Core.LiteralTypeBoolean -> (Core.LiteralBoolean False)+      Core.LiteralTypeInteger v2 -> (Core.LiteralInteger ((\x -> case x of+        Core.IntegerTypeBigint -> (Core.IntegerValueBigint 0)+        Core.IntegerTypeInt8 -> (Core.IntegerValueInt8 0)+        Core.IntegerTypeInt16 -> (Core.IntegerValueInt16 0)+        Core.IntegerTypeInt32 -> (Core.IntegerValueInt32 0)+        Core.IntegerTypeInt64 -> (Core.IntegerValueInt64 0)+        Core.IntegerTypeUint8 -> (Core.IntegerValueUint8 0)+        Core.IntegerTypeUint16 -> (Core.IntegerValueUint16 0)+        Core.IntegerTypeUint32 -> (Core.IntegerValueUint32 0)+        Core.IntegerTypeUint64 -> (Core.IntegerValueUint64 0)) v2))+      Core.LiteralTypeFloat v2 -> (Core.LiteralFloat ((\x -> case x of+        Core.FloatTypeBigfloat -> (Core.FloatValueBigfloat 0.0)+        Core.FloatTypeFloat32 -> (Core.FloatValueFloat32 0.0)+        Core.FloatTypeFloat64 -> (Core.FloatValueFloat64 0.0)) v2))+      Core.LiteralTypeString -> (Core.LiteralString "")) v1)))+    Core.TypeMap v1 ->  +      let kt = (Core.mapTypeKeys v1) +          vt = (Core.mapTypeValues v1)+      in (Logic.ifElse minimal (Flows.pure (Core.TermMap Maps.empty)) (Flows.bind (inst kt) (\ke -> Flows.bind (inst vt) (\ve -> Flows.pure (Core.TermMap (Maps.singleton ke ve))))))+    Core.TypeOptional v1 -> (Logic.ifElse minimal (Flows.pure (Core.TermOptional Nothing)) (Flows.bind (inst v1) (\e -> Flows.pure (Core.TermOptional (Just e)))))+    Core.TypeProduct v1 -> (Flows.bind (Flows.mapList inst v1) (\es -> Flows.pure (Core.TermProduct es)))+    Core.TypeRecord v1 ->  +      let tname = (Core.rowTypeTypeName v1) +          fields = (Core.rowTypeFields v1)+          toField = (\ft -> Flows.bind (inst (Core.fieldTypeType ft)) (\e -> Flows.pure (Core.Field {+                  Core.fieldName = (Core.fieldTypeName ft),+                  Core.fieldTerm = e})))+      in (Flows.bind (Flows.mapList toField fields) (\dfields -> Flows.pure (Core.TermRecord (Core.Record {+        Core.recordTypeName = tname,+        Core.recordFields = dfields}))))+    Core.TypeSet v1 -> (Logic.ifElse minimal (Flows.pure (Core.TermSet Sets.empty)) (Flows.bind (inst v1) (\e -> Flows.pure (Core.TermSet (Sets.fromList [+      e])))))+    Core.TypeVariable v1 -> (Optionals.maybe (Flows.fail (Strings.cat2 "Type variable " (Strings.cat2 (Core__.term (Core.TermVariable v1)) " not found in schema"))) inst (Maps.lookup v1 schema))+    Core.TypeWrap v1 ->  +      let tname = (Core.wrappedTypeTypeName v1) +          t_ = (Core.wrappedTypeObject v1)+      in (Flows.bind (inst t_) (\e -> Flows.pure (Core.TermWrap (Core.WrappedTerm {+        Core.wrappedTermTypeName = tname,+        Core.wrappedTermObject = e}))))) t)
src/gen-main/haskell/Hydra/Testing.hs view
@@ -3,10 +3,12 @@ module Hydra.Testing where  import qualified Hydra.Core as Core-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | One of two evaluation styles: eager or lazy data EvaluationStyle = @@ -14,41 +16,124 @@   EvaluationStyleLazy    deriving (Eq, Ord, Read, Show) -_EvaluationStyle = (Core.Name "hydra/testing.EvaluationStyle")+_EvaluationStyle = (Core.Name "hydra.testing.EvaluationStyle")  _EvaluationStyle_eager = (Core.Name "eager")  _EvaluationStyle_lazy = (Core.Name "lazy") +-- | A test case which checks that strings are converted between different case conventions correctly+data CaseConversionTestCase = +  CaseConversionTestCase {+    caseConversionTestCaseFromConvention :: Mantle.CaseConvention,+    caseConversionTestCaseToConvention :: Mantle.CaseConvention,+    caseConversionTestCaseFromString :: String,+    caseConversionTestCaseToString :: String}+  deriving (Eq, Ord, Read, Show)++_CaseConversionTestCase = (Core.Name "hydra.testing.CaseConversionTestCase")++_CaseConversionTestCase_fromConvention = (Core.Name "fromConvention")++_CaseConversionTestCase_toConvention = (Core.Name "toConvention")++_CaseConversionTestCase_fromString = (Core.Name "fromString")++_CaseConversionTestCase_toString = (Core.Name "toString")++-- | A test case which evaluates (reduces) a given term and compares it with the expected result+data EvaluationTestCase = +  EvaluationTestCase {+    evaluationTestCaseEvaluationStyle :: EvaluationStyle,+    evaluationTestCaseInput :: Core.Term,+    evaluationTestCaseOutput :: Core.Term}+  deriving (Eq, Ord, Read, Show)++_EvaluationTestCase = (Core.Name "hydra.testing.EvaluationTestCase")++_EvaluationTestCase_evaluationStyle = (Core.Name "evaluationStyle")++_EvaluationTestCase_input = (Core.Name "input")++_EvaluationTestCase_output = (Core.Name "output")++-- | A test case providing a term for which type inference is expected to fail+data InferenceFailureTestCase = +  InferenceFailureTestCase {+    inferenceFailureTestCaseInput :: Core.Term}+  deriving (Eq, Ord, Read, Show)++_InferenceFailureTestCase = (Core.Name "hydra.testing.InferenceFailureTestCase")++_InferenceFailureTestCase_input = (Core.Name "input")++-- | A test case which performs type inference on a given term and compares the result with an expected type scheme+data InferenceTestCase = +  InferenceTestCase {+    inferenceTestCaseInput :: Core.Term,+    inferenceTestCaseOutput :: Core.TypeScheme}+  deriving (Eq, Ord, Read, Show)++_InferenceTestCase = (Core.Name "hydra.testing.InferenceTestCase")++_InferenceTestCase_input = (Core.Name "input")++_InferenceTestCase_output = (Core.Name "output")++newtype Tag = +  Tag {+    unTag :: String}+  deriving (Eq, Ord, Read, Show)++_Tag = (Core.Name "hydra.testing.Tag")+ -- | A simple test case with an input and an expected output data TestCase = -  TestCase {-    testCaseDescription :: (Maybe String),-    testCaseEvaluationStyle :: EvaluationStyle,-    testCaseInput :: Core.Term,-    testCaseOutput :: Core.Term}+  TestCaseCaseConversion CaseConversionTestCase |+  TestCaseEvaluation EvaluationTestCase |+  TestCaseInference InferenceTestCase |+  TestCaseInferenceFailure InferenceFailureTestCase   deriving (Eq, Ord, Read, Show) -_TestCase = (Core.Name "hydra/testing.TestCase")+_TestCase = (Core.Name "hydra.testing.TestCase") -_TestCase_description = (Core.Name "description")+_TestCase_caseConversion = (Core.Name "caseConversion") -_TestCase_evaluationStyle = (Core.Name "evaluationStyle")+_TestCase_evaluation = (Core.Name "evaluation") -_TestCase_input = (Core.Name "input")+_TestCase_inference = (Core.Name "inference") -_TestCase_output = (Core.Name "output")+_TestCase_inferenceFailure = (Core.Name "inferenceFailure") +-- | One of a number of test case variants, together with metadata including a test name, an optional description, and optional tags+data TestCaseWithMetadata = +  TestCaseWithMetadata {+    testCaseWithMetadataName :: String,+    testCaseWithMetadataCase :: TestCase,+    testCaseWithMetadataDescription :: (Maybe String),+    testCaseWithMetadataTags :: [Tag]}+  deriving (Eq, Ord, Read, Show)++_TestCaseWithMetadata = (Core.Name "hydra.testing.TestCaseWithMetadata")++_TestCaseWithMetadata_name = (Core.Name "name")++_TestCaseWithMetadata_case = (Core.Name "case")++_TestCaseWithMetadata_description = (Core.Name "description")++_TestCaseWithMetadata_tags = (Core.Name "tags")+ -- | A collection of test cases with a name and optional description data TestGroup =    TestGroup {     testGroupName :: String,     testGroupDescription :: (Maybe String),     testGroupSubgroups :: [TestGroup],-    testGroupCases :: [TestCase]}+    testGroupCases :: [TestCaseWithMetadata]}   deriving (Eq, Ord, Read, Show) -_TestGroup = (Core.Name "hydra/testing.TestGroup")+_TestGroup = (Core.Name "hydra.testing.TestGroup")  _TestGroup_name = (Core.Name "name")
− src/gen-main/haskell/Hydra/Tier1.hs 
@@ -1,323 +0,0 @@--- | 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 x = case x of-  Core.FloatValueBigfloat v0 -> (Equality.identity v0)-  Core.FloatValueFloat32 v1 -> (Literals.float32ToBigfloat v1)-  Core.FloatValueFloat64 v2 -> (Literals.float64ToBigfloat v2)---- | Convert an integer value of any precision to a bigint-integerValueToBigint :: (Core.IntegerValue -> Integer)-integerValueToBigint x = case x of-  Core.IntegerValueBigint v3 -> (Equality.identity v3)-  Core.IntegerValueInt8 v4 -> (Literals.int8ToBigint v4)-  Core.IntegerValueInt16 v5 -> (Literals.int16ToBigint v5)-  Core.IntegerValueInt32 v6 -> (Literals.int32ToBigint v6)-  Core.IntegerValueInt64 v7 -> (Literals.int64ToBigint v7)-  Core.IntegerValueUint8 v8 -> (Literals.uint8ToBigint v8)-  Core.IntegerValueUint16 v9 -> (Literals.uint16ToBigint v9)-  Core.IntegerValueUint32 v10 -> (Literals.uint32ToBigint v10)-  Core.IntegerValueUint64 v11 -> (Literals.uint64ToBigint v11)---- | Check whether a term is a lambda, possibly nested within let and/or annotation terms-isLambda :: (Core.Term -> Bool)-isLambda term = ((\x -> case x of-  Core.TermFunction v12 -> ((\x -> case x of-    Core.FunctionLambda _ -> True-    _ -> False) v12)-  Core.TermLet v14 -> (isLambda (Core.letEnvironment v14))-  _ -> False) (Strip.fullyStripTerm term))---- | Convert a qualified name to a dot-separated name-unqualifyName :: (Module.QualifiedName -> Core.Name)-unqualifyName qname =  -  let prefix = ((\x -> case x of-          Nothing -> ""-          Just v15 -> (Strings.cat [-            Module.unNamespace v15,-            "."])) (Module.qualifiedNameNamespace qname))-  in (Core.Name (Strings.cat [-    prefix,-    (Module.qualifiedNameLocal qname)]))---- | Fold over a term, traversing its subterms in the specified order-foldOverTerm :: (Coders.TraversalOrder -> (x -> Core.Term -> x) -> x -> Core.Term -> x)-foldOverTerm order fld b0 term = ((\x -> case x of-  Coders.TraversalOrderPre -> (Lists.foldl (foldOverTerm order fld) (fld b0 term) (subterms term))-  Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverTerm order fld) b0 (subterms term)) term)) order)---- | Fold over a type, traversing its subtypes in the specified order-foldOverType :: (Coders.TraversalOrder -> (x -> Core.Type -> x) -> x -> Core.Type -> x)-foldOverType order fld b0 typ = ((\x -> case x of-  Coders.TraversalOrderPre -> (Lists.foldl (foldOverType order fld) (fld b0 typ) (subtypes typ))-  Coders.TraversalOrderPost -> (fld (Lists.foldl (foldOverType order fld) b0 (subtypes typ)) typ)) 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 =  -  let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInTerm t)) Sets.empty (subterms term))-  in ((\x -> case x of-    Core.TermFunction v20 -> ((\x -> case x of-      Core.FunctionLambda v21 -> (Sets.remove (Core.lambdaParameter v21) (freeVariablesInTerm (Core.lambdaBody v21)))-      _ -> dfltVars) v20)-    Core.TermVariable v22 -> (Sets.singleton v22)-    _ -> dfltVars) 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 typ =  -  let dfltVars = (Lists.foldl (\s -> \t -> Sets.union s (freeVariablesInType t)) Sets.empty (subtypes typ))-  in ((\x -> case x of-    Core.TypeLambda v23 -> (Sets.remove (Core.lambdaTypeParameter v23) (freeVariablesInType (Core.lambdaTypeBody v23)))-    Core.TypeVariable v24 -> (Sets.singleton v24)-    _ -> dfltVars) typ)---- | Find the children of a given term-subterms :: (Core.Term -> [Core.Term])-subterms x = case x of-  Core.TermAnnotated v25 -> [-    Core.annotatedTermSubject v25]-  Core.TermApplication v26 -> [-    Core.applicationFunction v26,-    (Core.applicationArgument v26)]-  Core.TermFunction v27 -> ((\x -> case x of-    Core.FunctionElimination v28 -> ((\x -> case x of-      Core.EliminationList v29 -> [-        v29]-      Core.EliminationOptional v30 -> [-        Core.optionalCasesNothing v30,-        (Core.optionalCasesJust v30)]-      Core.EliminationUnion v31 -> (Lists.concat2 ((\x -> case x of-        Nothing -> []-        Just v32 -> [-          v32]) (Core.caseStatementDefault v31)) (Lists.map Core.fieldTerm (Core.caseStatementCases v31)))-      _ -> []) v28)-    Core.FunctionLambda v33 -> [-      Core.lambdaBody v33]-    _ -> []) v27)-  Core.TermLet v34 -> (Lists.cons (Core.letEnvironment v34) (Lists.map Core.letBindingTerm (Core.letBindings v34)))-  Core.TermList v35 -> v35-  Core.TermLiteral _ -> []-  Core.TermMap v37 -> (Lists.concat (Lists.map (\p -> [-    fst p,-    (snd p)]) (Maps.toList v37)))-  Core.TermOptional v38 -> ((\x -> case x of-    Nothing -> []-    Just v39 -> [-      v39]) v38)-  Core.TermProduct v40 -> v40-  Core.TermRecord v41 -> (Lists.map Core.fieldTerm (Core.recordFields v41))-  Core.TermSet v42 -> (Sets.toList v42)-  Core.TermSum v43 -> [-    Core.sumTerm v43]-  Core.TermTypeAbstraction v44 -> [-    Core.typeAbstractionBody v44]-  Core.TermTypeApplication v45 -> [-    Core.typedTermTerm v45]-  Core.TermTyped v46 -> [-    Core.typedTermTerm v46]-  Core.TermUnion v47 -> [-    Core.fieldTerm (Core.injectionField v47)]-  Core.TermVariable _ -> []-  Core.TermWrap v49 -> [-    Core.wrappedTermObject v49]---- | Find the children of a given term-subtermsWithAccessors :: (Core.Term -> [(Mantle.TermAccessor, Core.Term)])-subtermsWithAccessors x = case x of-  Core.TermAnnotated v50 -> [-    (Mantle.TermAccessorAnnotatedSubject, (Core.annotatedTermSubject v50))]-  Core.TermApplication v51 -> [-    (Mantle.TermAccessorApplicationFunction, (Core.applicationFunction v51)),-    (Mantle.TermAccessorApplicationArgument, (Core.applicationArgument v51))]-  Core.TermFunction v52 -> ((\x -> case x of-    Core.FunctionElimination v53 -> ((\x -> case x of-      Core.EliminationList v54 -> [-        (Mantle.TermAccessorListFold, v54)]-      Core.EliminationOptional v55 -> [-        (Mantle.TermAccessorOptionalCasesNothing, (Core.optionalCasesNothing v55)),-        (Mantle.TermAccessorOptionalCasesJust, (Core.optionalCasesJust v55))]-      Core.EliminationUnion v56 -> (Lists.concat2 ((\x -> case x of-        Nothing -> []-        Just v57 -> [-          (Mantle.TermAccessorUnionCasesDefault, v57)]) (Core.caseStatementDefault v56)) (Lists.map (\f -> (Mantle.TermAccessorUnionCasesBranch (Core.fieldName f), (Core.fieldTerm f))) (Core.caseStatementCases v56)))-      _ -> []) v53)-    Core.FunctionLambda v58 -> [-      (Mantle.TermAccessorLambdaBody, (Core.lambdaBody v58))]-    _ -> []) v52)-  Core.TermLet v59 -> (Lists.cons (Mantle.TermAccessorLetEnvironment, (Core.letEnvironment v59)) (Lists.map (\b -> (Mantle.TermAccessorLetBinding (Core.letBindingName b), (Core.letBindingTerm b))) (Core.letBindings v59)))-  Core.TermList v60 -> (Lists.map (\e -> (Mantle.TermAccessorListElement 0, e)) v60)-  Core.TermLiteral _ -> []-  Core.TermMap v62 -> (Lists.concat (Lists.map (\p -> [-    (Mantle.TermAccessorMapKey 0, (fst p)),-    (Mantle.TermAccessorMapValue 0, (snd p))]) (Maps.toList v62)))-  Core.TermOptional v63 -> ((\x -> case x of-    Nothing -> []-    Just v64 -> [-      (Mantle.TermAccessorOptionalTerm, v64)]) v63)-  Core.TermProduct v65 -> (Lists.map (\e -> (Mantle.TermAccessorProductTerm 0, e)) v65)-  Core.TermRecord v66 -> (Lists.map (\f -> (Mantle.TermAccessorRecordField (Core.fieldName f), (Core.fieldTerm f))) (Core.recordFields v66))-  Core.TermSet v67 -> (Lists.map (\e -> (Mantle.TermAccessorListElement 0, e)) (Sets.toList v67))-  Core.TermSum v68 -> [-    (Mantle.TermAccessorSumTerm, (Core.sumTerm v68))]-  Core.TermTypeAbstraction v69 -> [-    (Mantle.TermAccessorTypeAbstractionBody, (Core.typeAbstractionBody v69))]-  Core.TermTypeApplication v70 -> [-    (Mantle.TermAccessorTypeApplicationTerm, (Core.typedTermTerm v70))]-  Core.TermTyped v71 -> [-    (Mantle.TermAccessorTypedTerm, (Core.typedTermTerm v71))]-  Core.TermUnion v72 -> [-    (Mantle.TermAccessorInjectionTerm, (Core.fieldTerm (Core.injectionField v72)))]-  Core.TermVariable _ -> []-  Core.TermWrap v74 -> [-    (Mantle.TermAccessorWrappedTerm, (Core.wrappedTermObject v74))]---- | Find the children of a given type expression-subtypes :: (Core.Type -> [Core.Type])-subtypes x = case x of-  Core.TypeAnnotated v75 -> [-    Core.annotatedTypeSubject v75]-  Core.TypeApplication v76 -> [-    Core.applicationTypeFunction v76,-    (Core.applicationTypeArgument v76)]-  Core.TypeFunction v77 -> [-    Core.functionTypeDomain v77,-    (Core.functionTypeCodomain v77)]-  Core.TypeLambda v78 -> [-    Core.lambdaTypeBody v78]-  Core.TypeList v79 -> [-    v79]-  Core.TypeLiteral _ -> []-  Core.TypeMap v81 -> [-    Core.mapTypeKeys v81,-    (Core.mapTypeValues v81)]-  Core.TypeOptional v82 -> [-    v82]-  Core.TypeProduct v83 -> v83-  Core.TypeRecord v84 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v84))-  Core.TypeSet v85 -> [-    v85]-  Core.TypeSum v86 -> v86-  Core.TypeUnion v87 -> (Lists.map Core.fieldTypeType (Core.rowTypeFields v87))-  Core.TypeVariable _ -> []-  Core.TypeWrap v89 -> [-    Core.wrappedTypeObject v89]--emptyTrace :: Compute.Trace-emptyTrace = Compute.Trace {-  Compute.traceStack = [],-  Compute.traceMessages = [],-  Compute.traceOther = Maps.empty}---- | Check whether a flow succeeds-flowSucceeds :: (s -> Compute.Flow s a -> Bool)-flowSucceeds cx f = (Optionals.isJust (Compute.flowStateValue (Compute.unFlow f cx emptyTrace)))---- | Get the value of a flow, or a default value if the flow fails-fromFlow :: (a -> s -> Compute.Flow s a -> a)-fromFlow def cx f = ((\x -> case x of-  Nothing -> def-  Just v90 -> v90) (Compute.flowStateValue (Compute.unFlow f cx emptyTrace)))--mutateTrace :: ((Compute.Trace -> Mantle.Either_ String Compute.Trace) -> (Compute.Trace -> Compute.Trace -> Compute.Trace) -> Compute.Flow s a -> Compute.Flow s a)-mutateTrace mutate restore f = (Compute.Flow (\s0 -> \t0 ->  -  let forLeft = (\msg -> Compute.FlowState {-          Compute.flowStateValue = Nothing,-          Compute.flowStateState = s0,-          Compute.flowStateTrace = (pushError msg t0)}) -      forRight = (\t1 ->  -              let f2 = (Compute.unFlow f s0 t1)-              in Compute.FlowState {-                Compute.flowStateValue = (Compute.flowStateValue f2),-                Compute.flowStateState = (Compute.flowStateState f2),-                Compute.flowStateTrace = (restore t0 (Compute.flowStateTrace f2))})-  in ((\x -> case x of-    Mantle.EitherLeft v91 -> (forLeft v91)-    Mantle.EitherRight v92 -> (forRight v92)) (mutate t0))))---- | Push an error message-pushError :: (String -> Compute.Trace -> Compute.Trace)-pushError msg t =  -  let errorMsg = (Strings.cat [-          "Error: ",-          msg,-          " (",-          Strings.intercalate " > " (Lists.reverse (Compute.traceStack t)),-          ")"])-  in Compute.Trace {-    Compute.traceStack = (Compute.traceStack t),-    Compute.traceMessages = (Lists.cons errorMsg (Compute.traceMessages t)),-    Compute.traceOther = (Compute.traceOther t)}---- | Continue the current flow after adding a warning message-warn :: (String -> Compute.Flow s a -> Compute.Flow s a)-warn msg b = (Compute.Flow (\s0 -> \t0 ->  -  let f1 = (Compute.unFlow b s0 t0) -      addMessage = (\t -> Compute.Trace {-              Compute.traceStack = (Compute.traceStack t),-              Compute.traceMessages = (Lists.cons (Strings.cat [-                "Warning: ",-                msg]) (Compute.traceMessages t)),-              Compute.traceOther = (Compute.traceOther t)})-  in Compute.FlowState {-    Compute.flowStateValue = (Compute.flowStateValue f1),-    Compute.flowStateState = (Compute.flowStateState f1),-    Compute.flowStateTrace = (addMessage (Compute.flowStateTrace f1))}))---- | Continue the current flow after setting a flag-withFlag :: (Core.Name -> Compute.Flow s a -> Compute.Flow s a)-withFlag flag =  -  let mutate = (\t -> Mantle.EitherRight (Compute.Trace {-          Compute.traceStack = (Compute.traceStack t),-          Compute.traceMessages = (Compute.traceMessages t),-          Compute.traceOther = (Maps.insert flag (Core.TermLiteral (Core.LiteralBoolean True)) (Compute.traceOther t))})) -      restore = (\ignored -> \t1 -> Compute.Trace {-              Compute.traceStack = (Compute.traceStack t1),-              Compute.traceMessages = (Compute.traceMessages t1),-              Compute.traceOther = (Maps.remove flag (Compute.traceOther t1))})-  in (mutateTrace mutate restore)---- | Continue a flow using a given state-withState :: (s1 -> Compute.Flow s1 a -> Compute.Flow s2 a)-withState cx0 f = (Compute.Flow (\cx1 -> \t1 ->  -  let f1 = (Compute.unFlow f cx0 t1)-  in Compute.FlowState {-    Compute.flowStateValue = (Compute.flowStateValue f1),-    Compute.flowStateState = cx1,-    Compute.flowStateTrace = (Compute.flowStateTrace f1)}))---- | Continue the current flow after augmenting the trace-withTrace :: (String -> Compute.Flow s a -> Compute.Flow s a)-withTrace msg =  -  let mutate = (\t -> Logic.ifElse (Mantle.EitherLeft "maximum trace depth exceeded. This may indicate an infinite loop") (Mantle.EitherRight (Compute.Trace {-          Compute.traceStack = (Lists.cons msg (Compute.traceStack t)),-          Compute.traceMessages = (Compute.traceMessages t),-          Compute.traceOther = (Compute.traceOther t)})) (Equality.gteInt32 (Lists.length (Compute.traceStack t)) Constants.maxTraceDepth)) -      restore = (\t0 -> \t1 -> Compute.Trace {-              Compute.traceStack = (Compute.traceStack t0),-              Compute.traceMessages = (Compute.traceMessages t1),-              Compute.traceOther = (Compute.traceOther t1)})-  in (mutateTrace mutate restore)
− src/gen-main/haskell/Hydra/Tier2.hs 
@@ -1,71 +0,0 @@--- | A module for miscellaneous tier-2 functions and constants.--module Hydra.Tier2 where--import qualified Hydra.Compute as Compute-import qualified Hydra.Core as Core-import qualified Hydra.Graph as Graph-import qualified Hydra.Lib.Flows as Flows-import qualified Hydra.Lib.Strings as Strings-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Get the state of the current flow-getState :: (Compute.Flow s s)-getState = (Compute.Flow (\s0 -> \t0 ->  -  let fs1 = (Compute.unFlow (Flows.pure ()) s0 t0)-  in ((\v -> \s -> \t -> (\x -> case x of-    Nothing -> Compute.FlowState {-      Compute.flowStateValue = Nothing,-      Compute.flowStateState = s,-      Compute.flowStateTrace = t}-    Just _ -> Compute.FlowState {-      Compute.flowStateValue = (Just s),-      Compute.flowStateState = s,-      Compute.flowStateTrace = t}) v) (Compute.flowStateValue fs1) (Compute.flowStateState fs1) (Compute.flowStateTrace fs1))))---- | Get the annotated type of a given term, if any-getTermType :: (Core.Term -> Maybe Core.Type)-getTermType x = case x of-  Core.TermAnnotated v315 -> (getTermType (Core.annotatedTermSubject v315))-  Core.TermTyped v316 -> (Just (Core.typedTermType v316))-  _ -> Nothing---- | Set the state of a flow-putState :: (s -> Compute.Flow s ())-putState cx = (Compute.Flow (\s0 -> \t0 ->  -  let f1 = (Compute.unFlow (Flows.pure ()) s0 t0)-  in Compute.FlowState {-    Compute.flowStateValue = (Compute.flowStateValue f1),-    Compute.flowStateState = cx,-    Compute.flowStateTrace = (Compute.flowStateTrace f1)}))---- | Get the annotated type of a given element, or fail if it is missing-requireElementType :: (Graph.Element -> Compute.Flow Graph.Graph Core.Type)-requireElementType el =  -  let withType = (\x -> case x of-          Nothing -> (Flows.fail (Strings.cat [-            "missing type annotation for element ",-            (Core.unName (Graph.elementName el))]))-          Just v317 -> (Flows.pure v317))-  in (withType (getTermType (Graph.elementData el)))---- | Get the annotated type of a given term, or fail if it is missing-requireTermType :: (Core.Term -> Compute.Flow Graph.Graph Core.Type)-requireTermType x = (withType (getTermType x)) -  where -    withType = (\x -> case x of-      Nothing -> (Flows.fail "missing type annotation")-      Just v318 -> (Flows.pure v318))---- | Fail if an actual value does not match an expected value-unexpected :: (String -> String -> Compute.Flow s x)-unexpected expected actual = (Flows.fail (Strings.cat [-  Strings.cat [-    Strings.cat [-      "expected ",-      expected],-    " but found: "],-  actual]))
− src/gen-main/haskell/Hydra/Tier3.hs 
@@ -1,29 +0,0 @@--- | A module for miscellaneous tier-3 functions and constants.--module Hydra.Tier3 where--import qualified Hydra.Compute as Compute-import qualified Hydra.Core as Core-import qualified Hydra.Lib.Io as Io-import qualified Hydra.Lib.Lists as Lists-import qualified Hydra.Lib.Logic as Logic-import qualified Hydra.Lib.Maps as Maps-import qualified Hydra.Lib.Strings as Strings-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S---- | Summarize a trace as a string-traceSummary :: (Compute.Trace -> String)-traceSummary t =  -  let messageLines = (Lists.nub (Compute.traceMessages t)) -      keyvalLines = (Logic.ifElse [] (Lists.cons "key/value pairs: " (Lists.map toLine (Maps.toList (Compute.traceOther t)))) (Maps.isEmpty (Compute.traceOther t)))-      toLine = (\pair -> Strings.cat [-              Strings.cat [-                Strings.cat [-                  "\t",-                  (Core.unName (fst pair))],-                ": "],-              (Io.showTerm (snd pair))])-  in (Strings.intercalate "\n" (Lists.concat2 messageLines keyvalLines))
+ src/gen-main/haskell/Hydra/Topology.hs view
@@ -0,0 +1,61 @@+-- | A model for simple graphs as adjacency lists++module Hydra.Topology where++import qualified Hydra.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++type Graph = (M.Map Vertex [Vertex])++_Graph = (Core.Name "hydra.topology.Graph")++data OrderingIsomorphism a = +  OrderingIsomorphism {+    -- | Mapping from source ordering to target ordering+    orderingIsomorphismEncode :: ([a] -> [a]),+    -- | Mapping from target ordering to source ordering+    orderingIsomorphismDecode :: ([a] -> [a])}++_OrderingIsomorphism = (Core.Name "hydra.topology.OrderingIsomorphism")++_OrderingIsomorphism_encode = (Core.Name "encode")++_OrderingIsomorphism_decode = (Core.Name "decode")++data TarjanState = +  TarjanState {+    -- | Next available index for vertices in the DFS traversal+    tarjanStateCounter :: Int,+    -- | Mapping from vertices to their indices in the DFS traversal+    tarjanStateIndices :: (M.Map Vertex Int),+    -- | Mapping from vertices to their lowest reachable index in the DFS traversal+    tarjanStateLowLinks :: (M.Map Vertex Int),+    -- | Current DFS stack, with vertices in reverse order+    tarjanStateStack :: [Vertex],+    -- | Set of vertices currently on the stack, for quick lookup+    tarjanStateOnStack :: (S.Set Vertex),+    -- | Accumulated strongly connected components, each a list of vertices+    tarjanStateSccs :: [[Vertex]]}+  deriving (Eq, Ord, Read, Show)++_TarjanState = (Core.Name "hydra.topology.TarjanState")++_TarjanState_counter = (Core.Name "counter")++_TarjanState_indices = (Core.Name "indices")++_TarjanState_lowLinks = (Core.Name "lowLinks")++_TarjanState_stack = (Core.Name "stack")++_TarjanState_onStack = (Core.Name "onStack")++_TarjanState_sccs = (Core.Name "sccs")++type Vertex = Int++_Vertex = (Core.Name "hydra.topology.Vertex")
+ src/gen-main/haskell/Hydra/Typing.hs view
@@ -0,0 +1,97 @@+-- | Types supporting type inference and type reconstruction.++module Hydra.Typing where++import qualified Hydra.Core as Core+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | The context provided to type inference, including various typing enviroments.+data InferenceContext = +  InferenceContext {+    -- | A fixed typing environment which is derived from the schema of the graph.+    inferenceContextSchemaTypes :: (M.Map Core.Name Core.TypeScheme),+    -- | A fixed typing environment which is derived from the set of primitives in the graph.+    inferenceContextPrimitiveTypes :: (M.Map Core.Name Core.TypeScheme),+    -- | A mutable typing environment which is specific to the current graph being processed. This environment is (usually) smaller than the schema and primitive typing environments, and is subject to global substitutions.+    inferenceContextDataTypes :: (M.Map Core.Name Core.TypeScheme),+    inferenceContextDebug :: Bool}+  deriving (Eq, Ord, Read, Show)++_InferenceContext = (Core.Name "hydra.typing.InferenceContext")++_InferenceContext_schemaTypes = (Core.Name "schemaTypes")++_InferenceContext_primitiveTypes = (Core.Name "primitiveTypes")++_InferenceContext_dataTypes = (Core.Name "dataTypes")++_InferenceContext_debug = (Core.Name "debug")++-- | The result of applying inference rules to a term.+data InferenceResult = +  InferenceResult {+    inferenceResultTerm :: Core.Term,+    inferenceResultType :: Core.Type,+    inferenceResultSubst :: TypeSubst}+  deriving (Eq, Ord, Read, Show)++_InferenceResult = (Core.Name "hydra.typing.InferenceResult")++_InferenceResult_term = (Core.Name "term")++_InferenceResult_type = (Core.Name "type")++_InferenceResult_subst = (Core.Name "subst")++-- | A substitution of term variables for terms+newtype TermSubst = +  TermSubst {+    unTermSubst :: (M.Map Core.Name Core.Term)}+  deriving (Eq, Ord, Read, Show)++_TermSubst = (Core.Name "hydra.typing.TermSubst")++-- | An assertion that two types can be unified into a single type+data TypeConstraint = +  TypeConstraint {+    typeConstraintLeft :: Core.Type,+    typeConstraintRight :: Core.Type,+    -- | A description of the type constraint which may be used for tracing or debugging+    typeConstraintComment :: String}+  deriving (Eq, Ord, Read, Show)++_TypeConstraint = (Core.Name "hydra.typing.TypeConstraint")++_TypeConstraint_left = (Core.Name "left")++_TypeConstraint_right = (Core.Name "right")++_TypeConstraint_comment = (Core.Name "comment")++-- | A typing environment used for type reconstruction (typeOf) over System F terms+data TypeContext = +  TypeContext {+    typeContextTypes :: (M.Map Core.Name Core.Type),+    typeContextVariables :: (S.Set Core.Name),+    typeContextInferenceContext :: InferenceContext}+  deriving (Eq, Ord, Read, Show)++_TypeContext = (Core.Name "hydra.typing.TypeContext")++_TypeContext_types = (Core.Name "types")++_TypeContext_variables = (Core.Name "variables")++_TypeContext_inferenceContext = (Core.Name "inferenceContext")++-- | A substitution of type variables for types+newtype TypeSubst = +  TypeSubst {+    unTypeSubst :: (M.Map Core.Name Core.Type)}+  deriving (Eq, Ord, Read, Show)++_TypeSubst = (Core.Name "hydra.typing.TypeSubst")
+ src/gen-main/haskell/Hydra/Unification.hs view
@@ -0,0 +1,163 @@+-- | Utilities for type unification.++module Hydra.Unification where++import qualified Hydra.Coders as Coders+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Lib.Equality as Equality+import qualified Hydra.Lib.Flows as Flows+import qualified Hydra.Lib.Lists as Lists+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.Strings as Strings+import qualified Hydra.Rewriting as Rewriting+import qualified Hydra.Show.Core as Core_+import qualified Hydra.Substitution as Substitution+import qualified Hydra.Typing as Typing+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++joinTypes :: (Core.Type -> Core.Type -> String -> Compute.Flow t0 [Typing.TypeConstraint])+joinTypes left right comment =  +  let sleft = (Rewriting.deannotateType left) +      sright = (Rewriting.deannotateType right)+      joinOne = (\l -> \r -> Typing.TypeConstraint {+              Typing.typeConstraintLeft = l,+              Typing.typeConstraintRight = r,+              Typing.typeConstraintComment = (Strings.cat [+                "join types; ",+                comment])})+      cannotUnify = (Flows.fail (Strings.cat [+              Strings.cat [+                Strings.cat [+                  "cannot unify ",+                  (Core_.type_ sleft)],+                " with "],+              (Core_.type_ sright)]))+      assertEqual = (Logic.ifElse (Equality.equal sleft sright) (Flows.pure []) cannotUnify)+      joinList = (\lefts -> \rights -> Logic.ifElse (Equality.equal (Lists.length lefts) (Lists.length rights)) (Flows.pure (Lists.zipWith joinOne lefts rights)) cannotUnify)+      joinRowTypes = (\left -> \right -> Logic.ifElse (Logic.and (Equality.equal (Core.unName (Core.rowTypeTypeName left)) (Core.unName (Core.rowTypeTypeName right))) (Logic.and (Equality.equal (Lists.length (Lists.map Core.fieldTypeName (Core.rowTypeFields left))) (Lists.length (Lists.map Core.fieldTypeName (Core.rowTypeFields right)))) (Lists.foldl Logic.and True (Lists.zipWith (\left -> \right -> Equality.equal (Core.unName left) (Core.unName right)) (Lists.map Core.fieldTypeName (Core.rowTypeFields left)) (Lists.map Core.fieldTypeName (Core.rowTypeFields right)))))) (joinList (Lists.map Core.fieldTypeType (Core.rowTypeFields left)) (Lists.map Core.fieldTypeType (Core.rowTypeFields right))) cannotUnify)+  in ((\x -> case x of+    Core.TypeApplication v1 -> ((\x -> case x of+      Core.TypeApplication v2 -> (Flows.pure [+        joinOne (Core.applicationTypeFunction v1) (Core.applicationTypeFunction v2),+        (joinOne (Core.applicationTypeArgument v1) (Core.applicationTypeArgument v2))])+      _ -> cannotUnify) sright)+    Core.TypeFunction v1 -> ((\x -> case x of+      Core.TypeFunction v2 -> (Flows.pure [+        joinOne (Core.functionTypeDomain v1) (Core.functionTypeDomain v2),+        (joinOne (Core.functionTypeCodomain v1) (Core.functionTypeCodomain v2))])+      _ -> cannotUnify) sright)+    Core.TypeList v1 -> ((\x -> case x of+      Core.TypeList v2 -> (Flows.pure [+        joinOne v1 v2])+      _ -> cannotUnify) sright)+    Core.TypeLiteral _ -> assertEqual+    Core.TypeMap v1 -> ((\x -> case x of+      Core.TypeMap v2 -> (Flows.pure [+        joinOne (Core.mapTypeKeys v1) (Core.mapTypeKeys v2),+        (joinOne (Core.mapTypeValues v1) (Core.mapTypeValues v2))])+      _ -> cannotUnify) sright)+    Core.TypeOptional v1 -> ((\x -> case x of+      Core.TypeOptional v2 -> (Flows.pure [+        joinOne v1 v2])+      _ -> cannotUnify) sright)+    Core.TypeProduct v1 -> ((\x -> case x of+      Core.TypeProduct v2 -> (joinList v1 v2)+      _ -> cannotUnify) sright)+    Core.TypeRecord v1 -> ((\x -> case x of+      Core.TypeRecord v2 -> (joinRowTypes v1 v2)+      _ -> cannotUnify) sright)+    Core.TypeSet v1 -> ((\x -> case x of+      Core.TypeSet v2 -> (Flows.pure [+        joinOne v1 v2])+      _ -> cannotUnify) sright)+    Core.TypeSum v1 -> ((\x -> case x of+      Core.TypeSum v2 -> (joinList v1 v2)+      _ -> cannotUnify) sright)+    Core.TypeUnion v1 -> ((\x -> case x of+      Core.TypeUnion v2 -> (joinRowTypes v1 v2)+      _ -> cannotUnify) sright)+    Core.TypeUnit -> ((\x -> case x of+      Core.TypeUnit -> (Flows.pure [])+      _ -> cannotUnify) sright)+    Core.TypeWrap v1 -> ((\x -> case x of+      Core.TypeWrap v2 -> (Logic.ifElse (Equality.equal (Core.unName (Core.wrappedTypeTypeName v1)) (Core.unName (Core.wrappedTypeTypeName v2))) (Flows.pure [+        joinOne (Core.wrappedTypeObject v1) (Core.wrappedTypeObject v2)]) cannotUnify)+      _ -> cannotUnify) sright)+    _ -> cannotUnify) sleft)++unifyTypeConstraints :: (M.Map Core.Name t0 -> [Typing.TypeConstraint] -> Compute.Flow t1 Typing.TypeSubst)+unifyTypeConstraints schemaTypes constraints =  +  let withConstraint = (\c -> \rest ->  +          let sleft = (Rewriting.deannotateType (Typing.typeConstraintLeft c)) +              sright = (Rewriting.deannotateType (Typing.typeConstraintRight c))+              comment = (Typing.typeConstraintComment c)+              tryBinding = (\v -> \t -> Logic.ifElse (variableOccursInType v t) (Flows.fail (Strings.cat [+                      Strings.cat [+                        Strings.cat [+                          Strings.cat [+                            Strings.cat [+                              Strings.cat [+                                "Variable ",+                                (Core.unName v)],+                              " appears free in type "],+                            (Core_.type_ t)],+                          " ("],+                        comment],+                      ")"])) (bind v t))+              bind = (\v -> \t ->  +                      let subst = (Substitution.singletonTypeSubst v t) +                          withResult = (\s -> Substitution.composeTypeSubst subst s)+                      in (Flows.map withResult (unifyTypeConstraints schemaTypes (Substitution.substituteInConstraints subst rest))))+              noVars =  +                      let withConstraints = (\constraints2 -> unifyTypeConstraints schemaTypes (Lists.concat2 constraints2 rest))+                      in (Flows.bind (joinTypes sleft sright comment) withConstraints)+          in ((\x -> case x of+            Core.TypeVariable v1 -> ((\x -> case x of+              Core.TypeVariable v2 -> (Logic.ifElse (Equality.equal (Core.unName v1) (Core.unName v2)) (unifyTypeConstraints schemaTypes rest) (Logic.ifElse (Optionals.isJust (Maps.lookup v1 schemaTypes)) (Logic.ifElse (Optionals.isJust (Maps.lookup v2 schemaTypes)) (Flows.fail (Strings.cat [+                Strings.cat [+                  Strings.cat [+                    Strings.cat [+                      Strings.cat [+                        Strings.cat [+                          "Attempted to unify schema names ",+                          (Core.unName v1)],+                        " and "],+                      (Core.unName v2)],+                    " ("],+                  comment],+                ")"])) (bind v2 sleft)) (bind v1 sright)))+              _ -> (tryBinding v1 sright)) sright)+            _ -> ((\x -> case x of+              Core.TypeVariable v1 -> (tryBinding v1 sleft)+              _ -> noVars) sright)) sleft))+  in (Logic.ifElse (Lists.null constraints) (Flows.pure Substitution.idTypeSubst) (withConstraint (Lists.head constraints) (Lists.tail constraints)))++unifyTypeLists :: (M.Map Core.Name t0 -> [Core.Type] -> [Core.Type] -> String -> Compute.Flow t1 Typing.TypeSubst)+unifyTypeLists schemaTypes l r comment =  +  let toConstraint = (\l -> \r -> Typing.TypeConstraint {+          Typing.typeConstraintLeft = l,+          Typing.typeConstraintRight = r,+          Typing.typeConstraintComment = comment})+  in (unifyTypeConstraints schemaTypes (Lists.zipWith toConstraint l r))++unifyTypes :: (M.Map Core.Name t0 -> Core.Type -> Core.Type -> String -> Compute.Flow t1 Typing.TypeSubst)+unifyTypes schemaTypes l r comment = (unifyTypeConstraints schemaTypes [+  Typing.TypeConstraint {+    Typing.typeConstraintLeft = l,+    Typing.typeConstraintRight = r,+    Typing.typeConstraintComment = comment}])++-- | Determine whether a type variable appears within a type expression.No distinction is made between free and bound type variables.+variableOccursInType :: (Core.Name -> Core.Type -> Bool)+variableOccursInType var =  +  let tryType = (\b -> \typ -> (\x -> case x of+          Core.TypeVariable v1 -> (Logic.or b (Equality.equal (Core.unName v1) (Core.unName var)))+          _ -> b) typ)+  in (Rewriting.foldOverType Coders.TraversalOrderPre tryType False)
+ src/gen-main/haskell/Hydra/Variants.hs view
@@ -0,0 +1,240 @@+-- | Functions for working with term, type, and literal type variants, as well as numeric precision.++module Hydra.Variants where++import qualified Hydra.Core as Core+import qualified Hydra.Lib.Lists as Lists+import qualified Hydra.Mantle as Mantle+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- | Find the elimination variant (constructor) for a given elimination term+eliminationVariant :: (Core.Elimination -> Mantle.EliminationVariant)+eliminationVariant x = case x of+  Core.EliminationProduct _ -> Mantle.EliminationVariantProduct+  Core.EliminationRecord _ -> Mantle.EliminationVariantRecord+  Core.EliminationUnion _ -> Mantle.EliminationVariantUnion+  Core.EliminationWrap _ -> Mantle.EliminationVariantWrap++-- | All elimination variants (constructors), in a canonical order+eliminationVariants :: [Mantle.EliminationVariant]+eliminationVariants = [+  Mantle.EliminationVariantProduct,+  Mantle.EliminationVariantRecord,+  Mantle.EliminationVariantUnion,+  Mantle.EliminationVariantWrap]++-- | Find the precision of a given floating-point type+floatTypePrecision :: (Core.FloatType -> Mantle.Precision)+floatTypePrecision x = case x of+  Core.FloatTypeBigfloat -> Mantle.PrecisionArbitrary+  Core.FloatTypeFloat32 -> (Mantle.PrecisionBits 32)+  Core.FloatTypeFloat64 -> (Mantle.PrecisionBits 64)++-- | All floating-point types in a canonical order+floatTypes :: [Core.FloatType]+floatTypes = [+  Core.FloatTypeBigfloat,+  Core.FloatTypeFloat32,+  Core.FloatTypeFloat64]++-- | Find the float type for a given floating-point value+floatValueType :: (Core.FloatValue -> Core.FloatType)+floatValueType x = case x of+  Core.FloatValueBigfloat _ -> Core.FloatTypeBigfloat+  Core.FloatValueFloat32 _ -> Core.FloatTypeFloat32+  Core.FloatValueFloat64 _ -> Core.FloatTypeFloat64++-- | Find the function variant (constructor) for a given function+functionVariant :: (Core.Function -> Mantle.FunctionVariant)+functionVariant x = case x of+  Core.FunctionElimination _ -> Mantle.FunctionVariantElimination+  Core.FunctionLambda _ -> Mantle.FunctionVariantLambda+  Core.FunctionPrimitive _ -> Mantle.FunctionVariantPrimitive++-- | All function variants (constructors), in a canonical order+functionVariants :: [Mantle.FunctionVariant]+functionVariants = [+  Mantle.FunctionVariantElimination,+  Mantle.FunctionVariantLambda,+  Mantle.FunctionVariantPrimitive]++-- | Find whether a given integer type is signed (true) or unsigned (false)+integerTypeIsSigned :: (Core.IntegerType -> Bool)+integerTypeIsSigned x = case x of+  Core.IntegerTypeBigint -> True+  Core.IntegerTypeInt8 -> True+  Core.IntegerTypeInt16 -> True+  Core.IntegerTypeInt32 -> True+  Core.IntegerTypeInt64 -> True+  Core.IntegerTypeUint8 -> False+  Core.IntegerTypeUint16 -> False+  Core.IntegerTypeUint32 -> False+  Core.IntegerTypeUint64 -> False++-- | Find the precision of a given integer type+integerTypePrecision :: (Core.IntegerType -> Mantle.Precision)+integerTypePrecision x = case x of+  Core.IntegerTypeBigint -> Mantle.PrecisionArbitrary+  Core.IntegerTypeInt8 -> (Mantle.PrecisionBits 8)+  Core.IntegerTypeInt16 -> (Mantle.PrecisionBits 16)+  Core.IntegerTypeInt32 -> (Mantle.PrecisionBits 32)+  Core.IntegerTypeInt64 -> (Mantle.PrecisionBits 64)+  Core.IntegerTypeUint8 -> (Mantle.PrecisionBits 8)+  Core.IntegerTypeUint16 -> (Mantle.PrecisionBits 16)+  Core.IntegerTypeUint32 -> (Mantle.PrecisionBits 32)+  Core.IntegerTypeUint64 -> (Mantle.PrecisionBits 64)++-- | All integer types, in a canonical order+integerTypes :: [Core.IntegerType]+integerTypes = [+  Core.IntegerTypeBigint,+  Core.IntegerTypeInt8,+  Core.IntegerTypeInt16,+  Core.IntegerTypeInt32,+  Core.IntegerTypeInt64,+  Core.IntegerTypeUint8,+  Core.IntegerTypeUint16,+  Core.IntegerTypeUint32,+  Core.IntegerTypeUint64]++-- | Find the integer type for a given integer value+integerValueType :: (Core.IntegerValue -> Core.IntegerType)+integerValueType x = case x of+  Core.IntegerValueBigint _ -> Core.IntegerTypeBigint+  Core.IntegerValueInt8 _ -> Core.IntegerTypeInt8+  Core.IntegerValueInt16 _ -> Core.IntegerTypeInt16+  Core.IntegerValueInt32 _ -> Core.IntegerTypeInt32+  Core.IntegerValueInt64 _ -> Core.IntegerTypeInt64+  Core.IntegerValueUint8 _ -> Core.IntegerTypeUint8+  Core.IntegerValueUint16 _ -> Core.IntegerTypeUint16+  Core.IntegerValueUint32 _ -> Core.IntegerTypeUint32+  Core.IntegerValueUint64 _ -> Core.IntegerTypeUint64++-- | Find the literal type for a given literal value+literalType :: (Core.Literal -> Core.LiteralType)+literalType x = case x of+  Core.LiteralBinary _ -> Core.LiteralTypeBinary+  Core.LiteralBoolean _ -> Core.LiteralTypeBoolean+  Core.LiteralFloat v1 -> ((\injected_ -> Core.LiteralTypeFloat injected_) (floatValueType v1))+  Core.LiteralInteger v1 -> ((\injected_ -> Core.LiteralTypeInteger injected_) (integerValueType v1))+  Core.LiteralString _ -> Core.LiteralTypeString++-- | Find the literal type variant (constructor) for a given literal value+literalTypeVariant :: (Core.LiteralType -> Mantle.LiteralVariant)+literalTypeVariant x = case x of+  Core.LiteralTypeBinary -> Mantle.LiteralVariantBinary+  Core.LiteralTypeBoolean -> Mantle.LiteralVariantBoolean+  Core.LiteralTypeFloat _ -> Mantle.LiteralVariantFloat+  Core.LiteralTypeInteger _ -> Mantle.LiteralVariantInteger+  Core.LiteralTypeString -> Mantle.LiteralVariantString++-- | All literal types, in a canonical order+literalTypes :: [Core.LiteralType]+literalTypes = (Lists.concat [+  [+    Core.LiteralTypeBinary,+    Core.LiteralTypeBoolean],+  Lists.map (\x -> Core.LiteralTypeFloat x) floatTypes,+  Lists.map (\x -> Core.LiteralTypeInteger x) integerTypes,+  [+    Core.LiteralTypeString]])++-- | Find the literal variant (constructor) for a given literal value+literalVariant :: (Core.Literal -> Mantle.LiteralVariant)+literalVariant arg_ = (literalTypeVariant (literalType arg_))++-- | All literal variants, in a canonical order+literalVariants :: [Mantle.LiteralVariant]+literalVariants = [+  Mantle.LiteralVariantBinary,+  Mantle.LiteralVariantBoolean,+  Mantle.LiteralVariantFloat,+  Mantle.LiteralVariantInteger,+  Mantle.LiteralVariantString]++-- | Find the term variant (constructor) for a given term+termVariant :: (Core.Term -> Mantle.TermVariant)+termVariant x = case x of+  Core.TermAnnotated _ -> Mantle.TermVariantAnnotated+  Core.TermApplication _ -> Mantle.TermVariantApplication+  Core.TermFunction _ -> Mantle.TermVariantFunction+  Core.TermLet _ -> Mantle.TermVariantLet+  Core.TermList _ -> Mantle.TermVariantList+  Core.TermLiteral _ -> Mantle.TermVariantLiteral+  Core.TermMap _ -> Mantle.TermVariantMap+  Core.TermOptional _ -> Mantle.TermVariantOptional+  Core.TermProduct _ -> Mantle.TermVariantProduct+  Core.TermRecord _ -> Mantle.TermVariantRecord+  Core.TermSet _ -> Mantle.TermVariantSet+  Core.TermSum _ -> Mantle.TermVariantSum+  Core.TermTypeApplication _ -> Mantle.TermVariantTypeApplication+  Core.TermTypeLambda _ -> Mantle.TermVariantTypeLambda+  Core.TermUnion _ -> Mantle.TermVariantUnion+  Core.TermUnit -> Mantle.TermVariantUnit+  Core.TermVariable _ -> Mantle.TermVariantVariable+  Core.TermWrap _ -> Mantle.TermVariantWrap++-- | All term (expression) variants, in a canonical order+termVariants :: [Mantle.TermVariant]+termVariants = [+  Mantle.TermVariantAnnotated,+  Mantle.TermVariantApplication,+  Mantle.TermVariantLiteral,+  Mantle.TermVariantFunction,+  Mantle.TermVariantList,+  Mantle.TermVariantMap,+  Mantle.TermVariantOptional,+  Mantle.TermVariantProduct,+  Mantle.TermVariantRecord,+  Mantle.TermVariantSet,+  Mantle.TermVariantSum,+  Mantle.TermVariantTypeLambda,+  Mantle.TermVariantTypeApplication,+  Mantle.TermVariantUnion,+  Mantle.TermVariantUnit,+  Mantle.TermVariantVariable,+  Mantle.TermVariantWrap]++-- | Find the type variant (constructor) for a given type+typeVariant :: (Core.Type -> Mantle.TypeVariant)+typeVariant x = case x of+  Core.TypeAnnotated _ -> Mantle.TypeVariantAnnotated+  Core.TypeApplication _ -> Mantle.TypeVariantApplication+  Core.TypeFunction _ -> Mantle.TypeVariantFunction+  Core.TypeForall _ -> Mantle.TypeVariantForall+  Core.TypeList _ -> Mantle.TypeVariantList+  Core.TypeLiteral _ -> Mantle.TypeVariantLiteral+  Core.TypeMap _ -> Mantle.TypeVariantMap+  Core.TypeOptional _ -> Mantle.TypeVariantOptional+  Core.TypeProduct _ -> Mantle.TypeVariantProduct+  Core.TypeRecord _ -> Mantle.TypeVariantRecord+  Core.TypeSet _ -> Mantle.TypeVariantSet+  Core.TypeSum _ -> Mantle.TypeVariantSum+  Core.TypeUnion _ -> Mantle.TypeVariantUnion+  Core.TypeUnit -> Mantle.TypeVariantUnit+  Core.TypeVariable _ -> Mantle.TypeVariantVariable+  Core.TypeWrap _ -> Mantle.TypeVariantWrap++-- | All type variants, in a canonical order+typeVariants :: [Mantle.TypeVariant]+typeVariants = [+  Mantle.TypeVariantAnnotated,+  Mantle.TypeVariantApplication,+  Mantle.TypeVariantFunction,+  Mantle.TypeVariantForall,+  Mantle.TypeVariantList,+  Mantle.TypeVariantLiteral,+  Mantle.TypeVariantMap,+  Mantle.TypeVariantWrap,+  Mantle.TypeVariantOptional,+  Mantle.TypeVariantProduct,+  Mantle.TypeVariantRecord,+  Mantle.TypeVariantSet,+  Mantle.TypeVariantSum,+  Mantle.TypeVariantUnion,+  Mantle.TypeVariantUnit,+  Mantle.TypeVariantVariable]
src/gen-main/haskell/Hydra/Workflow.hs view
@@ -6,10 +6,11 @@ import qualified Hydra.Core as Core import qualified Hydra.Graph as Graph import qualified Hydra.Module as Module-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S  -- | The specification of a Hydra schema, provided as a set of modules and a distinguished type data HydraSchemaSpec = @@ -20,7 +21,7 @@     hydraSchemaSpecTypeName :: Core.Name}   deriving (Eq, Ord, Read, Show) -_HydraSchemaSpec = (Core.Name "hydra/workflow.HydraSchemaSpec")+_HydraSchemaSpec = (Core.Name "hydra.workflow.HydraSchemaSpec")  _HydraSchemaSpec_modules = (Core.Name "modules") @@ -36,7 +37,7 @@     -- | A file extension for the generated file(s)     lastMileFileExtension :: String} -_LastMile = (Core.Name "hydra/workflow.LastMile")+_LastMile = (Core.Name "hydra.workflow.LastMile")  _LastMile_encoder = (Core.Name "encoder") @@ -54,7 +55,7 @@   SchemaSpecProvided    deriving (Eq, Ord, Read, Show) -_SchemaSpec = (Core.Name "hydra/workflow.SchemaSpec")+_SchemaSpec = (Core.Name "hydra.workflow.SchemaSpec")  _SchemaSpec_hydra = (Core.Name "hydra") @@ -75,7 +76,7 @@     transformWorkflowDestDir :: String}   deriving (Eq, Ord, Read, Show) -_TransformWorkflow = (Core.Name "hydra/workflow.TransformWorkflow")+_TransformWorkflow = (Core.Name "hydra.workflow.TransformWorkflow")  _TransformWorkflow_name = (Core.Name "name")
+ src/gen-test/haskell/Hydra/Test/TestGraph.hs view
@@ -0,0 +1,344 @@+-- | A module defining the graph used in the test suite.++module Hydra.Test.TestGraph where++import qualified Hydra.Core as Core+import qualified Hydra.Module as Module+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++testTypeLatLonName :: Core.Name+testTypeLatLonName = (Core.Name "LatLon")++testTypeLatLonPolyName :: Core.Name+testTypeLatLonPolyName = (Core.Name "LatLonPoly")++latlonRecord :: (Float -> Float -> Core.Term)+latlonRecord lat lon = (Core.TermRecord (Core.Record {+  Core.recordTypeName = testTypeLatLonName,+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "lat"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 lat)))},+    Core.Field {+      Core.fieldName = (Core.Name "lon"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 lon)))}]}))++testTypeLatLon :: Core.Type+testTypeLatLon = (Core.TypeRecord (Core.RowType {+  Core.rowTypeTypeName = testTypeLatLonName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "lat"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "lon"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}]}))++testTypeLatLonPoly :: Core.Type+testTypeLatLonPoly = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeRecord (Core.RowType {+    Core.rowTypeTypeName = testTypeLatLonPolyName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "lat"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "lon"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))}]}))}))++testTypeStringAlias :: Core.Type+testTypeStringAlias = (Core.TypeWrap (Core.WrappedType {+  Core.wrappedTypeTypeName = testTypeStringAliasName,+  Core.wrappedTypeObject = (Core.TypeLiteral Core.LiteralTypeString)}))++testTypeStringAliasName :: Core.Name+testTypeStringAliasName = (Core.Name "StringTypeAlias")++testTypePolymorphicWrapper :: Core.Type+testTypePolymorphicWrapper = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeWrap (Core.WrappedType {+    Core.wrappedTypeTypeName = testTypePolymorphicWrapperName,+    Core.wrappedTypeObject = (Core.TypeList (Core.TypeVariable (Core.Name "a")))}))}))++testTypePolymorphicWrapperName :: Core.Name+testTypePolymorphicWrapperName = (Core.Name "PolymorphicWrapper")++testElementArthur :: Core.Binding+testElementArthur = Core.Binding {+  Core.bindingName = (Core.Name "firstName"),+  Core.bindingTerm = testDataArthur,+  Core.bindingType = (Just (Core.TypeScheme {+    Core.typeSchemeVariables = [],+    Core.typeSchemeType = (Core.TypeVariable testTypePersonName)}))}++testElementFirstName :: Core.Binding+testElementFirstName = Core.Binding {+  Core.bindingName = (Core.Name "firstName"),+  Core.bindingTerm = (Core.TermFunction (Core.FunctionElimination (Core.EliminationRecord (Core.Projection {+    Core.projectionTypeName = testTypePersonName,+    Core.projectionField = (Core.Name "firstName")})))),+  Core.bindingType = (Just (Core.TypeScheme {+    Core.typeSchemeVariables = [],+    Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+      Core.functionTypeDomain = (Core.TypeVariable testTypePersonName),+      Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeString)}))}))}++testNamespace :: Module.Namespace+testNamespace = (Module.Namespace "testGraph")++testSchemaNamespace :: Module.Namespace+testSchemaNamespace = (Module.Namespace "testSchemaGraph")++testDataArthur :: Core.Term+testDataArthur = (Core.TermRecord (Core.Record {+  Core.recordTypeName = testTypePersonName,+  Core.recordFields = [+    Core.Field {+      Core.fieldName = (Core.Name "firstName"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralString "Arthur"))},+    Core.Field {+      Core.fieldName = (Core.Name "lastName"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralString "Dent"))},+    Core.Field {+      Core.fieldName = (Core.Name "age"),+      Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}]}))++testTypeBuddyListA :: Core.Type+testTypeBuddyListA = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeRecord (Core.RowType {+    Core.rowTypeTypeName = testTypeBuddyListAName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "head"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "tail"),+        Core.fieldTypeType = (Core.TypeOptional (Core.TypeApplication (Core.ApplicationType {+          Core.applicationTypeFunction = (Core.TypeVariable testTypeBuddyListBName),+          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "a"))})))}]}))}))++testTypeBuddyListAName :: Core.Name+testTypeBuddyListAName = (Core.Name "BuddyListA")++testTypeBuddyListB :: Core.Type+testTypeBuddyListB = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeRecord (Core.RowType {+    Core.rowTypeTypeName = testTypeBuddyListBName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "head"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "tail"),+        Core.fieldTypeType = (Core.TypeOptional (Core.TypeApplication (Core.ApplicationType {+          Core.applicationTypeFunction = (Core.TypeVariable testTypeBuddyListAName),+          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "a"))})))}]}))}))++testTypeBuddyListBName :: Core.Name+testTypeBuddyListBName = (Core.Name "BuddyListB")++testTypeComparison :: Core.Type+testTypeComparison = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeComparisonName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "lessThan"),+      Core.fieldTypeType = Core.TypeUnit},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "equalTo"),+      Core.fieldTypeType = Core.TypeUnit},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "greaterThan"),+      Core.fieldTypeType = Core.TypeUnit}]}))++testTypeComparisonName :: Core.Name+testTypeComparisonName = (Core.Name "Comparison")++testTypeIntList :: Core.Type+testTypeIntList = (Core.TypeRecord (Core.RowType {+  Core.rowTypeTypeName = testTypeIntListName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "head"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "tail"),+      Core.fieldTypeType = (Core.TypeOptional (Core.TypeVariable testTypeIntListName))}]}))++testTypeIntListName :: Core.Name+testTypeIntListName = (Core.Name "IntList")++testTypeHydraLiteralType :: Core.Type+testTypeHydraLiteralType = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeHydraLiteralTypeName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "boolean"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeBoolean)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "string"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)}]}))++testTypeHydraLiteralTypeName :: Core.Name+testTypeHydraLiteralTypeName = (Core.Name "HydraLiteralType")++testTypeHydraType :: Core.Type+testTypeHydraType = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeHydraTypeName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "literal"),+      Core.fieldTypeType = (Core.TypeVariable testTypeHydraLiteralTypeName)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "list"),+      Core.fieldTypeType = (Core.TypeVariable testTypeHydraTypeName)}]}))++testTypeHydraTypeName :: Core.Name+testTypeHydraTypeName = (Core.Name "HydraType")++testTypeList :: Core.Type+testTypeList = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeRecord (Core.RowType {+    Core.rowTypeTypeName = testTypeListName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "head"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "tail"),+        Core.fieldTypeType = (Core.TypeOptional (Core.TypeApplication (Core.ApplicationType {+          Core.applicationTypeFunction = (Core.TypeVariable testTypeListName),+          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "a"))})))}]}))}))++testTypeListName :: Core.Name+testTypeListName = (Core.Name "List")++testTypeNumber :: Core.Type+testTypeNumber = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeNumberName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "int"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "float"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}]}))++testTypeNumberName :: Core.Name+testTypeNumberName = (Core.Name "Number")++testTypePerson :: Core.Type+testTypePerson = (Core.TypeRecord (Core.RowType {+  Core.rowTypeTypeName = testTypePersonName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "firstName"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "lastName"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "age"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}]}))++testTypePersonName :: Core.Name+testTypePersonName = (Core.Name "Person")++testTypePersonOrSomething :: Core.Type+testTypePersonOrSomething = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeUnion (Core.RowType {+    Core.rowTypeTypeName = testTypePersonOrSomethingName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "person"),+        Core.fieldTypeType = (Core.TypeVariable testTypePersonName)},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "other"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))}]}))}))++testTypePersonOrSomethingName :: Core.Name+testTypePersonOrSomethingName = (Core.Name "PersonOrSomething")++testTypeSimpleNumber :: Core.Type+testTypeSimpleNumber = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeSimpleNumberName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "int"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "float"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}]}))++testTypeSimpleNumberName :: Core.Name+testTypeSimpleNumberName = (Core.Name "SimpleNumber")++testTypeTimestamp :: Core.Type+testTypeTimestamp = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeTimestampName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "unixTimeMillis"),+      Core.fieldTypeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeUint64))},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "date"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)}]}))++testTypeTimestampName :: Core.Name+testTypeTimestampName = (Core.Name "Timestamp")++testTypeUnionMonomorphic :: Core.Type+testTypeUnionMonomorphic = (Core.TypeUnion (Core.RowType {+  Core.rowTypeTypeName = testTypeUnionMonomorphicName,+  Core.rowTypeFields = [+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "bool"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeBoolean)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "string"),+      Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeString)},+    Core.FieldType {+      Core.fieldTypeName = (Core.Name "unit"),+      Core.fieldTypeType = Core.TypeUnit}]}))++testTypeUnionMonomorphicName :: Core.Name+testTypeUnionMonomorphicName = (Core.Name "UnionMonomorphic")++testTypeUnionPolymorphicRecursive :: Core.Type+testTypeUnionPolymorphicRecursive = (Core.TypeForall (Core.ForallType {+  Core.forallTypeParameter = (Core.Name "a"),+  Core.forallTypeBody = (Core.TypeUnion (Core.RowType {+    Core.rowTypeTypeName = testTypeUnionPolymorphicRecursiveName,+    Core.rowTypeFields = [+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "bool"),+        Core.fieldTypeType = (Core.TypeLiteral Core.LiteralTypeBoolean)},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "value"),+        Core.fieldTypeType = (Core.TypeVariable (Core.Name "a"))},+      Core.FieldType {+        Core.fieldTypeName = (Core.Name "other"),+        Core.fieldTypeType = (Core.TypeApplication (Core.ApplicationType {+          Core.applicationTypeFunction = (Core.TypeVariable testTypeUnionPolymorphicRecursiveName),+          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "a"))}))}]}))}))++testTypeUnionPolymorphicRecursiveName :: Core.Name+testTypeUnionPolymorphicRecursiveName = (Core.Name "UnionPolymorphicRecursive")++testTypeUnit :: Core.Type+testTypeUnit = (Core.TypeRecord (Core.RowType {+  Core.rowTypeTypeName = testTypeUnitName,+  Core.rowTypeFields = []}))++testTypeUnitName :: Core.Name+testTypeUnitName = (Core.Name "Unit")
src/gen-test/haskell/Hydra/Test/TestSuite.hs view
@@ -3,467 +3,10838 @@ module Hydra.Test.TestSuite where  import qualified Hydra.Core as Core-import qualified Hydra.Testing as Testing-import Data.Int-import Data.List as L-import Data.Map as M-import Data.Set as S--allTests :: Testing.TestGroup-allTests = Testing.TestGroup {-  Testing.testGroupName = "All tests",-  Testing.testGroupDescription = Nothing,-  Testing.testGroupSubgroups = [-    Testing.TestGroup {-      Testing.testGroupName = "hydra/lib/lists primitives",-      Testing.testGroupDescription = Nothing,-      Testing.testGroupSubgroups = [-        Testing.TestGroup {-          Testing.testGroupName = "apply",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.apply"))),-                  Core.applicationArgument = (Core.TermList [-                    Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper")),-                    (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower")))])})),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralString "One"),-                  Core.TermLiteral (Core.LiteralString "Two"),-                  (Core.TermLiteral (Core.LiteralString "Three"))])})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "ONE"),-                Core.TermLiteral (Core.LiteralString "TWO"),-                Core.TermLiteral (Core.LiteralString "THREE"),-                Core.TermLiteral (Core.LiteralString "one"),-                Core.TermLiteral (Core.LiteralString "two"),-                (Core.TermLiteral (Core.LiteralString "three"))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "bind",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.bind"))),-                  Core.applicationArgument = (Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),-                Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {-                  Core.lambdaParameter = (Core.Name "x"),-                  Core.lambdaDomain = Nothing,-                  Core.lambdaBody = (Core.TermApplication (Core.Application {-                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.pure"))),-                    Core.applicationArgument = (Core.TermApplication (Core.Application {-                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/math.neg"))),-                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))),-                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-4))))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "concat",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.concat"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],-                  Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],-                  (Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),-                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "head",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.head"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}]},-        Testing.TestGroup {-          Testing.testGroupName = "intercalate",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.intercalate"))),-                  Core.applicationArgument = (Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))])})),-                Core.applicationArgument = (Core.TermList [-                  Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],-                  Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],-                  (Core.TermList [-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),-                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),-                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),-                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),-                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "intersperse",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.intersperse"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "and"))})),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralString "one"),-                  Core.TermLiteral (Core.LiteralString "two"),-                  (Core.TermLiteral (Core.LiteralString "three"))])})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "one"),-                Core.TermLiteral (Core.LiteralString "and"),-                Core.TermLiteral (Core.LiteralString "two"),-                Core.TermLiteral (Core.LiteralString "and"),-                (Core.TermLiteral (Core.LiteralString "three"))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "last",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.last"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},-        Testing.TestGroup {-          Testing.testGroupName = "length",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.length"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),-                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),-                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},-        Testing.TestGroup {-          Testing.testGroupName = "map",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.map"))),-                  Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper")))})),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralString "one"),-                  (Core.TermLiteral (Core.LiteralString "two"))])})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "ONE"),-                (Core.TermLiteral (Core.LiteralString "TWO"))])}]},-        Testing.TestGroup {-          Testing.testGroupName = "pure",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/lists.pure"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "one")])}]}],-      Testing.testGroupCases = []},-    Testing.TestGroup {-      Testing.testGroupName = "hydra/lib/strings primitives",-      Testing.testGroupDescription = Nothing,-      Testing.testGroupSubgroups = [-        Testing.TestGroup {-          Testing.testGroupName = "cat",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralString "one"),-                  Core.TermLiteral (Core.LiteralString "two"),-                  (Core.TermLiteral (Core.LiteralString "three"))])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "onetwothree"))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),-                Core.applicationArgument = (Core.TermList [-                  Core.TermLiteral (Core.LiteralString ""),-                  Core.TermLiteral (Core.LiteralString "one"),-                  Core.TermLiteral (Core.LiteralString ""),-                  (Core.TermLiteral (Core.LiteralString ""))])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "one"))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.cat"))),-                Core.applicationArgument = (Core.TermList [])})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString ""))}]},-        Testing.TestGroup {-          Testing.testGroupName = "length",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.length"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))}]},-        Testing.TestGroup {-          Testing.testGroupName = "splitOn",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "ss"))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "Mi"),-                Core.TermLiteral (Core.LiteralString "i"),-                (Core.TermLiteral (Core.LiteralString "ippi"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                (Core.TermLiteral (Core.LiteralString ""))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one two three"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "one"),-                Core.TermLiteral (Core.LiteralString "two"),-                (Core.TermLiteral (Core.LiteralString "three"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " one two three "))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                Core.TermLiteral (Core.LiteralString "one"),-                Core.TermLiteral (Core.LiteralString "two"),-                Core.TermLiteral (Core.LiteralString "three"),-                (Core.TermLiteral (Core.LiteralString ""))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  one two three"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                Core.TermLiteral (Core.LiteralString ""),-                Core.TermLiteral (Core.LiteralString "one"),-                Core.TermLiteral (Core.LiteralString "two"),-                (Core.TermLiteral (Core.LiteralString "three"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  "))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  one two three"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                (Core.TermLiteral (Core.LiteralString "one two three"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aa"))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aaa"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                (Core.TermLiteral (Core.LiteralString "a"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "")])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "abc"))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString ""),-                Core.TermLiteral (Core.LiteralString "a"),-                Core.TermLiteral (Core.LiteralString "b"),-                (Core.TermLiteral (Core.LiteralString "c"))])},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermApplication (Core.Application {-                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.splitOn"))),-                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),-              Testing.testCaseOutput = (Core.TermList [-                Core.TermLiteral (Core.LiteralString "")])}]},-        Testing.TestGroup {-          Testing.testGroupName = "toLower",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "one two three"))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toLower"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "abc123"))}]},-        Testing.TestGroup {-          Testing.testGroupName = "toUpper",-          Testing.testGroupDescription = Nothing,-          Testing.testGroupSubgroups = [],-          Testing.testGroupCases = [-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "ONE TWO THREE"))},-            Testing.TestCase {-              Testing.testCaseDescription = Nothing,-              Testing.testCaseEvaluationStyle = Testing.EvaluationStyleEager,-              Testing.testCaseInput = (Core.TermApplication (Core.Application {-                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra/lib/strings.toUpper"))),-                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),-              Testing.testCaseOutput = (Core.TermLiteral (Core.LiteralString "ABC123"))}]}],-      Testing.testGroupCases = []}],+import qualified Hydra.Lib.Maps as Maps+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Test.TestGraph as TestGraph+import qualified Hydra.Testing as Testing+import Prelude hiding  (Enum, Ordering, fail, map, pure, sum)+import qualified Data.Int as I+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++allTests :: Testing.TestGroup+allTests = Testing.TestGroup {+  Testing.testGroupName = "All tests",+  Testing.testGroupDescription = Nothing,+  Testing.testGroupSubgroups = [+    formattingTests,+    inferenceTests,+    primitiveTests],+  Testing.testGroupCases = []}++formattingTests :: Testing.TestGroup+formattingTests = Testing.TestGroup {+  Testing.testGroupName = "formatting tests",+  Testing.testGroupDescription = Nothing,+  Testing.testGroupSubgroups = [],+  Testing.testGroupCases = [+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#1 (lower_snake_case -> UPPER_SNAKE_CASE)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseFromString = "a_hello_world_42_a42_42a_b",+        Testing.caseConversionTestCaseToString = "A_HELLO_WORLD_42_A42_42A_B"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#2 (lower_snake_case -> camelCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseFromString = "a_hello_world_42_a42_42a_b",+        Testing.caseConversionTestCaseToString = "aHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#3 (lower_snake_case -> PascalCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseFromString = "a_hello_world_42_a42_42a_b",+        Testing.caseConversionTestCaseToString = "AHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#4 (lower_snake_case -> lower_snake_case)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseFromString = "a_hello_world_42_a42_42a_b",+        Testing.caseConversionTestCaseToString = "a_hello_world_42_a42_42a_b"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#5 (UPPER_SNAKE_CASE -> lower_snake_case)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseFromString = "A_HELLO_WORLD_42_A42_42A_B",+        Testing.caseConversionTestCaseToString = "a_hello_world_42_a42_42a_b"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#6 (UPPER_SNAKE_CASE -> camelCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseFromString = "A_HELLO_WORLD_42_A42_42A_B",+        Testing.caseConversionTestCaseToString = "aHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#7 (UPPER_SNAKE_CASE -> PascalCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseFromString = "A_HELLO_WORLD_42_A42_42A_B",+        Testing.caseConversionTestCaseToString = "AHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#8 (UPPER_SNAKE_CASE -> UPPER_SNAKE_CASE)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseFromString = "A_HELLO_WORLD_42_A42_42A_B",+        Testing.caseConversionTestCaseToString = "A_HELLO_WORLD_42_A42_42A_B"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#9 (camelCase -> lower_snake_case)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseFromString = "aHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "a_hello_world42_a4242a_b"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#10 (camelCase -> UPPER_SNAKE_CASE)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseFromString = "aHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "A_HELLO_WORLD42_A4242A_B"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#11 (camelCase -> PascalCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseFromString = "aHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "AHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#12 (camelCase -> camelCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseFromString = "aHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "aHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#13 (PascalCase -> lower_snake_case)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionLowerSnake,+        Testing.caseConversionTestCaseFromString = "AHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "a_hello_world42_a4242a_b"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#14 (PascalCase -> UPPER_SNAKE_CASE)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionUpperSnake,+        Testing.caseConversionTestCaseFromString = "AHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "A_HELLO_WORLD42_A4242A_B"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#15 (PascalCase -> camelCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionCamel,+        Testing.caseConversionTestCaseFromString = "AHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "aHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []},+    Testing.TestCaseWithMetadata {+      Testing.testCaseWithMetadataName = "#16 (PascalCase -> PascalCase)",+      Testing.testCaseWithMetadataCase = (Testing.TestCaseCaseConversion (Testing.CaseConversionTestCase {+        Testing.caseConversionTestCaseFromConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseToConvention = Mantle.CaseConventionPascal,+        Testing.caseConversionTestCaseFromString = "AHelloWorld42A4242aB",+        Testing.caseConversionTestCaseToString = "AHelloWorld42A4242aB"})),+      Testing.testCaseWithMetadataDescription = Nothing,+      Testing.testCaseWithMetadataTags = []}]}++inferenceTests :: Testing.TestGroup+inferenceTests = Testing.TestGroup {+  Testing.testGroupName = "Inference tests",+  Testing.testGroupDescription = Nothing,+  Testing.testGroupSubgroups = [+    Testing.TestGroup {+      Testing.testGroupName = "Algebraic terms",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "List eliminations (folds)",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                  Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                    Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))),+                      Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                    Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))),+                    Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#3",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                      Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                    Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                  Core.applicationArgument = (Core.TermList [+                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                    Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                    (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]}]},+        Testing.TestGroup {+          Testing.testGroupName = "List terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "List of strings",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermLiteral (Core.LiteralString "bar"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List of lists of strings",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermList [+                        Core.TermLiteral (Core.LiteralString "foo")],+                      (Core.TermList [])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Empty list",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List containing an empty list",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermList []]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0"))))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambda producing a polymorphic list",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x")])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambda producing a list of integers",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List with repeated variables",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x"),+                        Core.TermLiteral (Core.LiteralString "foo"),+                        (Core.TermVariable (Core.Name "x"))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Map terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermMap (M.fromList [+                  (Core.TermLiteral (Core.LiteralString "firstName"), (Core.TermLiteral (Core.LiteralString "Arthur"))),+                  (Core.TermLiteral (Core.LiteralString "lastName"), (Core.TermLiteral (Core.LiteralString "Dent")))])),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeMap (Core.MapType {+                    Core.mapTypeKeys = (Core.TypeLiteral Core.LiteralTypeString),+                    Core.mapTypeValues = (Core.TypeLiteral Core.LiteralTypeString)}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermMap (M.fromList [])),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0",+                    (Core.Name "t1")],+                  Core.typeSchemeType = (Core.TypeMap (Core.MapType {+                    Core.mapTypeKeys = (Core.TypeVariable (Core.Name "t0")),+                    Core.mapTypeValues = (Core.TypeVariable (Core.Name "t1"))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]}]},+        Testing.TestGroup {+          Testing.testGroupName = "Optional terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermOptional Nothing),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0"],+                  Core.typeSchemeType = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0")))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]}]},+        Testing.TestGroup {+          Testing.testGroupName = "Product terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Empty products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Non-empty, monotyped products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermList [+                        Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 42.0)),+                        (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 137.0)))])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      (Core.TermList [+                        Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 42.0)),+                        (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 137.0)))])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polytyped products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermList [],+                      (Core.TermLiteral (Core.LiteralString "foo"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0")),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermList [])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeList (Core.TypeVariable (Core.Name "t0")))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Pairs",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      (Core.TermLiteral (Core.LiteralString "foo"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermList [],+                      (Core.TermLiteral (Core.LiteralString "foo"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0")),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermList [],+                      (Core.TermList [])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0")),+                        (Core.TypeList (Core.TypeVariable (Core.Name "t1")))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Set terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermSet (S.fromList [+                  Core.TermLiteral (Core.LiteralBoolean True)])),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeSet (Core.TypeLiteral Core.LiteralTypeBoolean))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermSet (S.fromList [+                  Core.TermSet (S.fromList [])])),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0"],+                  Core.typeSchemeType = (Core.TypeSet (Core.TypeSet (Core.TypeVariable (Core.Name "t0"))))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]}]},+        Testing.TestGroup {+          Testing.testGroupName = "Sum terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Singleton sum terms",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 1,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeLiteral Core.LiteralTypeString])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 1,+                      Core.sumTerm = (Core.TermList [])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Non-singleton sum terms",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 2,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeVariable (Core.Name "t0"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 1,+                      Core.sumSize = 2,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeVariable (Core.Name "t0"),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Algorithm W test cases",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "STLC to System F",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                  Core.lambdaParameter = (Core.Name "x"),+                  Core.lambdaDomain = Nothing,+                  Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0"],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                    Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "foo"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#3",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                    Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#4",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "x"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#5",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "sng"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermList [+                          Core.TermVariable (Core.Name "x")])}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermVariable (Core.Name "sng"))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0"],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                    Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#6",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "sng"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermList [+                          Core.TermVariable (Core.Name "x")])}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermProduct [+                    Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermVariable (Core.Name "sng")),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}),+                    (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermVariable (Core.Name "sng")),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "alice"))}))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeProduct [+                    Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                    (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))])}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#7",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "+"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "+")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermVariable (Core.Name "+")),+                      Core.applicationArgument = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))})),+                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#9",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0"],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                    Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#10",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                      Core.bindingType = Nothing},+                    Core.Binding {+                      Core.bindingName = (Core.Name "g"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "xx"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "yy"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "xx"))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermProduct [+                    Core.TermVariable (Core.Name "f"),+                    (Core.TermVariable (Core.Name "g"))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0",+                    (Core.Name "t1")],+                  Core.typeSchemeType = (Core.TypeProduct [+                    Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}),+                    (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}))])}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#11",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                      Core.bindingType = Nothing},+                    Core.Binding {+                      Core.bindingName = (Core.Name "g"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "u"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "v"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermProduct [+                    Core.TermVariable (Core.Name "f"),+                    (Core.TermVariable (Core.Name "g"))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0",+                    Core.Name "t1",+                    Core.Name "t2",+                    (Core.Name "t3")],+                  Core.typeSchemeType = (Core.TypeProduct [+                    Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}),+                    (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t3"))}))}))])}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#12",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}))),+                      Core.bindingType = Nothing},+                    Core.Binding {+                      Core.bindingName = (Core.Name "g"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "u"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "v"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermProduct [+                    Core.TermVariable (Core.Name "f"),+                    (Core.TermVariable (Core.Name "g"))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0",+                    (Core.Name "t1")],+                  Core.typeSchemeType = (Core.TypeProduct [+                    Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}),+                    (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}))])}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#13",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                  Core.letBindings = [+                    Core.Binding {+                      Core.bindingName = (Core.Name "f"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                      Core.bindingType = Nothing},+                    Core.Binding {+                      Core.bindingName = (Core.Name "g"),+                      Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "u"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "v"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}))),+                      Core.bindingType = Nothing}],+                  Core.letEnvironment = (Core.TermProduct [+                    Core.TermVariable (Core.Name "f"),+                    (Core.TermVariable (Core.Name "g"))])})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [+                    Core.Name "t0",+                    (Core.Name "t1")],+                  Core.typeSchemeType = (Core.TypeProduct [+                    Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}),+                    (Core.TypeFunction (Core.FunctionType {+                      Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                      Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}))])}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []}]}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Expected failures",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "Undefined variable",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Basic unbound variables",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermVariable (Core.Name "x"))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermVariable (Core.Name "y"))})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "y"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Unbound in let expressions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "y")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "y")),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "z"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "y"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "z")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermVariable (Core.Name "y"))])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Shadowing scope errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "y"),+                            Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermVariable (Core.Name "z"))}))})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "y"),+                            Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermVariable (Core.Name "z"))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "z"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Unification failure",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Basic type mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermList [+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      (Core.TermLiteral (Core.LiteralString "foo"))])})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermList [+                      Core.TermList [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))],+                      (Core.TermLiteral (Core.LiteralString "foo"))])})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermProduct [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                        (Core.TermLiteral (Core.LiteralString "foo"))]),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bar"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Collection type mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a list"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermList [+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      (Core.TermList [+                        Core.TermLiteral (Core.LiteralString "foo")])])})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermProduct [+                        Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))],+                        (Core.TermList [+                          Core.TermLiteral (Core.LiteralString "foo")])]),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                      Core.applicationArgument = (Core.TermList [+                        Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))],+                        (Core.TermList [+                          Core.TermLiteral (Core.LiteralString "foo")])])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Conditional type mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                        Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "x"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polymorphic instantiation conflicts",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermList [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermProduct [+                          Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                          (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))]),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "cons"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermList [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "cons")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "cons")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Invalid application",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Non-function application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermLiteral (Core.LiteralString "foo")),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermLiteral (Core.LiteralBoolean True)),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 3.14))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Collection application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermList [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))]),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bar"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermProduct [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                        (Core.TermLiteral (Core.LiteralString "foo"))]),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermList []),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermProduct [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                        (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))]),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "index"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Primitive misapplication",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.maps.empty"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.sets.empty"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermOptional Nothing),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "value"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermList []),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Self-application",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Direct self-application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Indirect self-application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "y")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "a"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "b")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "b"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "a"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "cycle"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "cycle"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "cycle")),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "cycle"))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Arity mismatch",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Too many arguments",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 999)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))}))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137))])})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "extra"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Wrong argument types with extra args",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "extra"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.not"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "arg"))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Recursive type construction",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Direct recursive types",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermList [+                            Core.TermVariable (Core.Name "x")]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermVariable (Core.Name "x"),+                            (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermVariable (Core.Name "x"),+                            (Core.TermVariable (Core.Name "x"))]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Recursive function types",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "f"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermList [+                              Core.TermVariable (Core.Name "f")])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Mutually recursive types",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermList [+                            Core.TermVariable (Core.Name "y")]),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "y"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermVariable (Core.Name "x"),+                            (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "a"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "b"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "b"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "a")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "a"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermList [+                            Core.TermVariable (Core.Name "g")]),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermVariable (Core.Name "f"),+                            (Core.TermVariable (Core.Name "f"))]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Occur check failures",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Function occur checks",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "h"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "g"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "h"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "g"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Mutual occur checks",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "a"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "b")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "b"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "a")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "b"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "a"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "cycle1"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "cycle2")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "cycle1"))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "cycle2"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "cycle1")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "cycle1"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Complex occur checks",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "omega"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "omega"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "omega"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "loop"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "loop")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "loop"))}))})),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "loop"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Type constructor misuse",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "List constructor errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a list"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "String constructor errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                      Core.applicationArgument = (Core.TermList [+                        Core.TermLiteral (Core.LiteralString "foo")])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a list"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Math constructor errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.sub"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a number"))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.mul"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a number"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.div"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Polymorphism violations",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Identity function violations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermList [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermProduct [+                          Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                          (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))]),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Constrained polymorphism violations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermList [+                              Core.TermVariable (Core.Name "x"),+                              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermProduct [+                              Core.TermVariable (Core.Name "x"),+                              (Core.TermLiteral (Core.LiteralString "constant"))])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                              Core.tupleProjectionArity = 2,+                              Core.tupleProjectionIndex = 0,+                              Core.tupleProjectionDomain = Nothing})))),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))}))})),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                            Core.tupleProjectionArity = 2,+                            Core.tupleProjectionIndex = 0,+                            Core.tupleProjectionDomain = Nothing})))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bad"))}))}))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "h"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                              Core.applicationArgument = (Core.TermList [+                                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))])}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "h")),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "incompatible"))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Higher-order polymorphism violations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "f"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermProduct [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "g"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bad"))}))])})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "h"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "h")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "h")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "error"))}))}))})))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Let binding type mismatches",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Application type mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "y"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "y"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermLiteral (Core.LiteralString "result"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "extra"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "g"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "num"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "num")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "num"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Collection type mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "list1"),+                          Core.bindingTerm = (Core.TermList [+                            Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))]),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "list2"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "list1"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "list2"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "nums"),+                          Core.bindingTerm = (Core.TermList [+                            Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                            (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))]),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "mixed"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bad"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "nums"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "mixed"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "pair1"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                            (Core.TermLiteral (Core.LiteralString "foo"))]),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "pair2"),+                          Core.bindingTerm = (Core.TermProduct [+                            Core.TermLiteral (Core.LiteralString "bar"),+                            (Core.TermVariable (Core.Name "pair1"))]),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                              Core.tupleProjectionArity = 2,+                              Core.tupleProjectionIndex = 0,+                              Core.tupleProjectionDomain = Nothing})))),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "pair2"))}))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Function binding mismatches",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "add"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "badCall"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "add")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a number"))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "badCall"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Constraint solver edge cases",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Complex constraint propagation",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "complex"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "g"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))})))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "complex")),+                              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "a"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})))})),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "b"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermLiteral (Core.LiteralString "foo"))})))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Fixed point combinators",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "fix"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "fix")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "y"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))),+                              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "y")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "rec"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "n"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "rec"))}))})))})))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "omega"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "omega")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "omega"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Constraint cycles",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "a"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "b")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "c"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "b"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "c")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "c"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "z"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "a")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "z"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "a")),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "circular"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "circular"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "circular")),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "circular"))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Primitive function type errors",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Logic primitive errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.and"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.or"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not boolean"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Collection primitive errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.maps.lookup"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a map"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.sets.member"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermList [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a list"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.fromMaybe"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not optional"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Math primitive errors",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a number"))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.mul"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean True))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.div"))),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.mod"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "not a number"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Complex constraint failures",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Multi-level constraint conflicts",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermProduct [+                                Core.TermVariable (Core.Name "x"),+                                (Core.TermVariable (Core.Name "y"))])})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "a"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "a"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "a"))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "h"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "z"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermVariable (Core.Name "z"))})))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "h")),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "weird"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "weird")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermProduct [+                                Core.TermVariable (Core.Name "y"),+                                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])})))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "nested"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "g"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                      Core.applicationArgument = (Core.TermApplication (Core.Application {+                                        Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))}))})))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "int_f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "n"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "n"))})),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "str_g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "s"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+                              Core.applicationArgument = (Core.TermList [+                                Core.TermVariable (Core.Name "s"),+                                (Core.TermLiteral (Core.LiteralString "!"))])}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "nested")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "int_f"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "str_g"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Function composition failures",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "triple"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "increment"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "n"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "n"))})),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "stringify"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "s"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+                              Core.applicationArgument = (Core.TermList [+                                Core.TermVariable (Core.Name "s"),+                                (Core.TermLiteral (Core.LiteralString "!"))])}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "triple")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "increment"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "stringify"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInferenceFailure (Testing.InferenceFailureTestCase {+                    Testing.inferenceFailureTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "compose"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "g"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "reverse_compose"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "g"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "f"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bad"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "compose")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "reverse_compose"))})),+                              Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length")))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "bad"))}))})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Fundamentals",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "Lambdas",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Simple lambdas",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt16 137)))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt16))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Nested lambdas",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "y"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))})))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Nested lambdas with shadowing",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))})))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Let terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Simple",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 42.0))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "y"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "z"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Empty let",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [],+                      Core.letEnvironment = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Trivial let",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Multiple references to a let-bound term",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bar"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermList [+                        Core.TermVariable (Core.Name "foo"),+                        Core.TermVariable (Core.Name "bar"),+                        (Core.TermVariable (Core.Name "foo"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Nested let",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "bar"),+                            Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137))),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermList [+                          Core.TermVariable (Core.Name "foo"),+                          (Core.TermVariable (Core.Name "bar"))])}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "bar"),+                            Core.bindingTerm = (Core.TermProduct [+                              Core.TermVariable (Core.Name "foo"),+                              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))]),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermVariable (Core.Name "bar"))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "sng"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermList [+                              Core.TermVariable (Core.Name "x")])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "foo"),+                            Core.bindingTerm = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "sng")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                            Core.bindingType = Nothing},+                          Core.Binding {+                            Core.bindingName = (Core.Name "bar"),+                            Core.bindingTerm = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "sng")),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "bar"))})),+                            Core.bindingType = Nothing},+                          Core.Binding {+                            Core.bindingName = (Core.Name "quux"),+                            Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "sng")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermProduct [+                          Core.TermVariable (Core.Name "foo"),+                          (Core.TermProduct [+                            Core.TermVariable (Core.Name "bar"),+                            (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "quux")),+                              Core.applicationArgument = (Core.TermList [])}))])])}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        (Core.TypeProduct [+                          Core.TypeList (Core.TypeLiteral Core.LiteralTypeString),+                          (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0"))))])])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Nested let with shadowing",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralString "foo")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "foo"),+                            Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137))),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermVariable (Core.Name "foo"))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralString "foo")),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bar"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "foo")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "foo"),+                            Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137))),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermProduct [+                          Core.TermVariable (Core.Name "bar"),+                          (Core.TermVariable (Core.Name "foo"))])}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Let-polymorphism",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})])}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermList [+                            Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})])}))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "list"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermList [+                              Core.TermVariable (Core.Name "x")])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "list")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}),+                        (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "list")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))}))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#6",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "singleton"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermList [+                              Core.TermVariable (Core.Name "x")])}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                                  Core.applicationArgument = (Core.TermProduct [+                                    Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "singleton")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}),+                                    (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "singleton")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))])})),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeVariable (Core.Name "t0"))]))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabled"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#7",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "fortytwo"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "fortytwo"),+                        (Core.TermVariable (Core.Name "foo"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#8",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "fortytwo"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "fortytwo"),+                        (Core.TermVariable (Core.Name "foo"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Recursive and mutually recursive let (@wisnesky's test cases)",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "y")),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "y"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermVariable (Core.Name "y"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeVariable (Core.Name "t0"),+                        (Core.TypeVariable (Core.Name "t1"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "u"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "v"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "v"))})),+                                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "f"),+                        (Core.TermVariable (Core.Name "g"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}),+                        (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "v0")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabled"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "plus"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "y"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "plus")),+                                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "plus")),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))})),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "z"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "z"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "p0"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermProduct [+                              Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "p0"))}),+                              (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "p0"))}))])}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#6",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "y"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "z"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermVariable (Core.Name "z"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}),+                        (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#7",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "y"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "z"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "w"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "z")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermProduct [+                          Core.TermVariable (Core.Name "w"),+                          (Core.TermVariable (Core.Name "z"))])])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        Core.Name "t1",+                        (Core.Name "t2")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}),+                        (Core.TypeProduct [+                          Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}),+                          (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t2")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t2"))}))])])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Recursive and mutually recursive let with polymorphism",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "g"))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                            Core.applicationArgument = (Core.TermList [+                              Core.TermVariable (Core.Name "f")])})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "f"),+                        (Core.TermVariable (Core.Name "g"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                              Core.applicationArgument = (Core.TermList [+                                Core.TermVariable (Core.Name "f")])}))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "f"),+                        (Core.TermVariable (Core.Name "g"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "g"))}))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                              Core.applicationArgument = (Core.TermList [+                                Core.TermVariable (Core.Name "f")])}))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "f"),+                        (Core.TermVariable (Core.Name "g"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Recursion involving polymorphic functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "b"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})),+                                  Core.applicationArgument = (Core.TermList [+                                    Core.TermList [+                                      Core.TermVariable (Core.Name "x")]])})),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))})))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "b"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "b"))})),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                                Core.applicationArgument = (Core.TermList [+                                  Core.TermList [+                                    Core.TermVariable (Core.Name "x")]])}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeBoolean),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0"))))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "inst"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                                Core.lambdaParameter = (Core.Name "x"),+                                Core.lambdaDomain = Nothing,+                                Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))})))})),+                            Core.applicationArgument = (Core.TermLiteral (Core.LiteralBoolean False))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "rec"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "b0"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "f"))})),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "b0"))}))}))})))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "inst"),+                        (Core.TermVariable (Core.Name "rec"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeBoolean,+                        (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))})),+                          Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "inst"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))})))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "rec"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "inst"),+                        (Core.TermVariable (Core.Name "rec"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeBoolean,+                        (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))})),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "inst1"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))})))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "inst2"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                            Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                              Core.lambdaParameter = (Core.Name "x"),+                              Core.lambdaDomain = Nothing,+                              Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})))})),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "rec"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "rec")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "inst1"),+                        Core.TermVariable (Core.Name "inst2"),+                        (Core.TermVariable (Core.Name "rec"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeBoolean,+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                            Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))})),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "bar")),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "bar"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "foo")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermProduct [+                        Core.TermVariable (Core.Name "foo"),+                        (Core.TermVariable (Core.Name "bar"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeVariable (Core.Name "t0"),+                        (Core.TypeVariable (Core.Name "t1"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Literals",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralString "foo")),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#3",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralBoolean False)),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeBoolean)}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#4",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 42.0))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []}]},+        Testing.TestGroup {+          Testing.testGroupName = "Pathological terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Recursion",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermVariable (Core.Name "x")),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeVariable (Core.Name "t0"))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "id"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "weird"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "id")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "id"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "id"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "weird"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "f"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "x")),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "x"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t1"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "paradox"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "f"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "paradox")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "f"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "paradox"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))})),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#6",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "f"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))}))),+                          Core.bindingType = Nothing},+                        Core.Binding {+                          Core.bindingName = (Core.Name "g"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "g")),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Infinite lists",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "self"),+                          Core.bindingTerm = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "self"))})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "self"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermLet (Core.Let {+                        Core.letBindings = [+                          Core.Binding {+                            Core.bindingName = (Core.Name "self"),+                            Core.bindingTerm = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "self"))})),+                            Core.bindingType = Nothing}],+                        Core.letEnvironment = (Core.TermVariable (Core.Name "self"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "self"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "e"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "e"))})),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "self")),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "e"))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermVariable (Core.Name "self")),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabled"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "build"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "x"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "build")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermVariable (Core.Name "build")),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Polymorphism",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Simple lists and optionals",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermOptional Nothing),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0")))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambdas, lists, and products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermProduct [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermVariable (Core.Name "x"))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeProduct [+                          Core.TypeVariable (Core.Name "t0"),+                          (Core.TypeVariable (Core.Name "t0"))])}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x")])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})),+                      (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "y"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "y"))})))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))})))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "y"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermProduct [+                            Core.TermVariable (Core.Name "y"),+                            (Core.TermVariable (Core.Name "x"))])})))}))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                          Core.functionTypeCodomain = (Core.TypeProduct [+                            Core.TypeVariable (Core.Name "t1"),+                            (Core.TypeVariable (Core.Name "t0"))])}))})))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambdas and application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Primitives and application",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                      Core.applicationArgument = (Core.TermList [+                        Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))],+                        (Core.TermList [])])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambdas and primitives",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Mixed expressions with lambdas, constants, and primitive functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.sub"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Primitives",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Monomorphic primitive functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.sub"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polymorphic primitive functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "el"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermVariable (Core.Name "el")])}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "el"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermList [+                          Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                          (Core.TermVariable (Core.Name "el"))])}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0")))),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "lists"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "lists"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0")))),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "lists"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "lists"))}))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0")))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#6",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "list"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                          Core.applicationArgument = (Core.TermList [+                            Core.TermVariable (Core.Name "list"),+                            (Core.TermList [])])}))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0"))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#7",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "list"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                          Core.applicationArgument = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                            Core.applicationArgument = (Core.TermList [+                              Core.TermVariable (Core.Name "list"),+                              (Core.TermList [])])}))}))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0"))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#8",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "lists"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "lists"))}))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0")))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Examples from the Hydra kernel",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "Nested let",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "hydra.formatting.mapFirstLetter",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "mapping"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "s"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermLet (Core.Let {+                          Core.letBindings = [+                            Core.Binding {+                              Core.bindingName = (Core.Name "firstLetter"),+                              Core.bindingTerm = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermVariable (Core.Name "mapping")),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+                                    Core.applicationArgument = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "list"))}))}))}))})),+                              Core.bindingType = Nothing},+                            Core.Binding {+                              Core.bindingName = (Core.Name "list"),+                              Core.bindingTerm = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "s"))})),+                              Core.bindingType = Nothing}],+                          Core.letEnvironment = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "s"))}))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "s"))})),+                            Core.applicationArgument = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "firstLetter"))})),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "list"))}))}))}))}))}))})))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                          Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeString)})),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                          Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeString)}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Nominal terms",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "Case statements",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionElimination (Core.EliminationUnion (Core.CaseStatement {+                  Core.caseStatementTypeName = TestGraph.testTypeSimpleNumberName,+                  Core.caseStatementDefault = Nothing,+                  Core.caseStatementCases = [+                    Core.Field {+                      Core.fieldName = (Core.Name "int"),+                      Core.fieldTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))},+                    Core.Field {+                      Core.fieldName = (Core.Name "float"),+                      Core.fieldTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})))}]})))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeVariable TestGraph.testTypeSimpleNumberName),+                    Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionElimination (Core.EliminationUnion (Core.CaseStatement {+                  Core.caseStatementTypeName = TestGraph.testTypeUnionMonomorphicName,+                  Core.caseStatementDefault = Nothing,+                  Core.caseStatementCases = [+                    Core.Field {+                      Core.fieldName = (Core.Name "bool"),+                      Core.fieldTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "_"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean True))})))},+                    Core.Field {+                      Core.fieldName = (Core.Name "string"),+                      Core.fieldTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "_"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))})))},+                    Core.Field {+                      Core.fieldName = (Core.Name "unit"),+                      Core.fieldTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "_"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermLiteral (Core.LiteralBoolean False))})))}]})))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeVariable TestGraph.testTypeUnionMonomorphicName),+                    Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = [+                Testing.Tag "disabledForMinimalInference"]}]},+        Testing.TestGroup {+          Testing.testGroupName = "Projections",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Record eliminations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionElimination (Core.EliminationRecord (Core.Projection {+                      Core.projectionTypeName = TestGraph.testTypePersonName,+                      Core.projectionField = (Core.Name "firstName")})))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable TestGraph.testTypePersonName),+                        Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeString)}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Records",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Simple records",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermRecord (Core.Record {+                      Core.recordTypeName = TestGraph.testTypeLatLonName,+                      Core.recordFields = [+                        Core.Field {+                          Core.fieldName = (Core.Name "lat"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 37.7749)))},+                        Core.Field {+                          Core.fieldName = (Core.Name "lon"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 (0-122.4194))))}]})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeLatLonName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermRecord (Core.Record {+                      Core.recordTypeName = TestGraph.testTypeLatLonPolyName,+                      Core.recordFields = [+                        Core.Field {+                          Core.fieldName = (Core.Name "lat"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 37.7749)))},+                        Core.Field {+                          Core.fieldName = (Core.Name "lon"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 (0-122.4194))))}]})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeLatLonPolyName),+                        Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "lon"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermRecord (Core.Record {+                        Core.recordTypeName = TestGraph.testTypeLatLonPolyName,+                        Core.recordFields = [+                          Core.Field {+                            Core.fieldName = (Core.Name "lat"),+                            Core.fieldTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 37.7749)))},+                          Core.Field {+                            Core.fieldName = (Core.Name "lon"),+                            Core.fieldTerm = (Core.TermVariable (Core.Name "lon"))}]}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)),+                        Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType {+                          Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeLatLonPolyName),+                          Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "latlon"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermRecord (Core.Record {+                        Core.recordTypeName = TestGraph.testTypeLatLonPolyName,+                        Core.recordFields = [+                          Core.Field {+                            Core.fieldName = (Core.Name "lat"),+                            Core.fieldTerm = (Core.TermVariable (Core.Name "latlon"))},+                          Core.Field {+                            Core.fieldName = (Core.Name "lon"),+                            Core.fieldTerm = (Core.TermVariable (Core.Name "latlon"))}]}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType {+                          Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeLatLonPolyName),+                          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t0"))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = TestGraph.testDataArthur,+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypePersonName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Record instances of simply recursive record types",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermRecord (Core.Record {+                      Core.recordTypeName = TestGraph.testTypeIntListName,+                      Core.recordFields = [+                        Core.Field {+                          Core.fieldName = (Core.Name "head"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))},+                        Core.Field {+                          Core.fieldName = (Core.Name "tail"),+                          Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                            Core.recordTypeName = TestGraph.testTypeIntListName,+                            Core.recordFields = [+                              Core.Field {+                                Core.fieldName = (Core.Name "head"),+                                Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 43)))},+                              Core.Field {+                                Core.fieldName = (Core.Name "tail"),+                                Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeIntListName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermRecord (Core.Record {+                          Core.recordTypeName = TestGraph.testTypeIntListName,+                          Core.recordFields = [+                            Core.Field {+                              Core.fieldName = (Core.Name "head"),+                              Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                            Core.Field {+                              Core.fieldName = (Core.Name "tail"),+                              Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                                Core.recordTypeName = TestGraph.testTypeIntListName,+                                Core.recordFields = [+                                  Core.Field {+                                    Core.fieldName = (Core.Name "head"),+                                    Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                                  Core.Field {+                                    Core.fieldName = (Core.Name "tail"),+                                    Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]}))}))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeIntListName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermRecord (Core.Record {+                      Core.recordTypeName = TestGraph.testTypeListName,+                      Core.recordFields = [+                        Core.Field {+                          Core.fieldName = (Core.Name "head"),+                          Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))},+                        Core.Field {+                          Core.fieldName = (Core.Name "tail"),+                          Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                            Core.recordTypeName = TestGraph.testTypeListName,+                            Core.recordFields = [+                              Core.Field {+                                Core.fieldName = (Core.Name "head"),+                                Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 43)))},+                              Core.Field {+                                Core.fieldName = (Core.Name "tail"),+                                Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeListName),+                        Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermRecord (Core.Record {+                          Core.recordTypeName = TestGraph.testTypeListName,+                          Core.recordFields = [+                            Core.Field {+                              Core.fieldName = (Core.Name "head"),+                              Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                            Core.Field {+                              Core.fieldName = (Core.Name "tail"),+                              Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                                Core.recordTypeName = TestGraph.testTypeListName,+                                Core.recordFields = [+                                  Core.Field {+                                    Core.fieldName = (Core.Name "head"),+                                    Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                                  Core.Field {+                                    Core.fieldName = (Core.Name "tail"),+                                    Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]}))}))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeListName),+                        Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermRecord (Core.Record {+                        Core.recordTypeName = TestGraph.testTypeListName,+                        Core.recordFields = [+                          Core.Field {+                            Core.fieldName = (Core.Name "head"),+                            Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                          Core.Field {+                            Core.fieldName = (Core.Name "tail"),+                            Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                              Core.recordTypeName = TestGraph.testTypeListName,+                              Core.recordFields = [+                                Core.Field {+                                  Core.fieldName = (Core.Name "head"),+                                  Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                                Core.Field {+                                  Core.fieldName = (Core.Name "tail"),+                                  Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType {+                          Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeListName),+                          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t0"))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Record instances of mutually recursive record types",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermRecord (Core.Record {+                          Core.recordTypeName = TestGraph.testTypeBuddyListAName,+                          Core.recordFields = [+                            Core.Field {+                              Core.fieldName = (Core.Name "head"),+                              Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                            Core.Field {+                              Core.fieldName = (Core.Name "tail"),+                              Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                                Core.recordTypeName = TestGraph.testTypeBuddyListBName,+                                Core.recordFields = [+                                  Core.Field {+                                    Core.fieldName = (Core.Name "head"),+                                    Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                                  Core.Field {+                                    Core.fieldName = (Core.Name "tail"),+                                    Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]}))}))),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeBuddyListAName),+                        Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermRecord (Core.Record {+                        Core.recordTypeName = TestGraph.testTypeBuddyListAName,+                        Core.recordFields = [+                          Core.Field {+                            Core.fieldName = (Core.Name "head"),+                            Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                          Core.Field {+                            Core.fieldName = (Core.Name "tail"),+                            Core.fieldTerm = (Core.TermOptional (Just (Core.TermRecord (Core.Record {+                              Core.recordTypeName = TestGraph.testTypeBuddyListBName,+                              Core.recordFields = [+                                Core.Field {+                                  Core.fieldName = (Core.Name "head"),+                                  Core.fieldTerm = (Core.TermVariable (Core.Name "x"))},+                                Core.Field {+                                  Core.fieldName = (Core.Name "tail"),+                                  Core.fieldTerm = (Core.TermOptional Nothing)}]}))))}]}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeApplication (Core.ApplicationType {+                          Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeBuddyListAName),+                          Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t0"))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Variant terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Variants",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = TestGraph.testTypeTimestampName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "unixTimeMillis"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueUint64 1638200308368)))}})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeTimestampName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = TestGraph.testTypeUnionMonomorphicName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "string"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralString "bar"))}})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeUnionMonomorphicName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polymorphic and recursive variants",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = TestGraph.testTypeUnionPolymorphicRecursiveName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "bool"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralBoolean True))}})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeUnionPolymorphicRecursiveName),+                        Core.applicationTypeArgument = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermUnion (Core.Injection {+                      Core.injectionTypeName = TestGraph.testTypeUnionPolymorphicRecursiveName,+                      Core.injectionField = Core.Field {+                        Core.fieldName = (Core.Name "value"),+                        Core.fieldTerm = (Core.TermLiteral (Core.LiteralString "foo"))}})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeUnionPolymorphicRecursiveName),+                        Core.applicationTypeArgument = (Core.TypeLiteral Core.LiteralTypeString)}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "other"),+                          Core.bindingTerm = (Core.TermUnion (Core.Injection {+                            Core.injectionTypeName = TestGraph.testTypeUnionPolymorphicRecursiveName,+                            Core.injectionField = Core.Field {+                              Core.fieldName = (Core.Name "value"),+                              Core.fieldTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))}})),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermUnion (Core.Injection {+                        Core.injectionTypeName = TestGraph.testTypeUnionPolymorphicRecursiveName,+                        Core.injectionField = Core.Field {+                          Core.fieldName = (Core.Name "other"),+                          Core.fieldTerm = (Core.TermVariable (Core.Name "other"))}}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeApplication (Core.ApplicationType {+                        Core.applicationTypeFunction = (Core.TypeVariable TestGraph.testTypeUnionPolymorphicRecursiveName),+                        Core.applicationTypeArgument = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Wrapper introductions and eliminations",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Wrapper introductions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermWrap (Core.WrappedTerm {+                      Core.wrappedTermTypeName = TestGraph.testTypeStringAliasName,+                      Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeVariable TestGraph.testTypeStringAliasName)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "v"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermWrap (Core.WrappedTerm {+                        Core.wrappedTermTypeName = TestGraph.testTypeStringAliasName,+                        Core.wrappedTermObject = (Core.TermVariable (Core.Name "v"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.functionTypeCodomain = (Core.TypeVariable TestGraph.testTypeStringAliasName)}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Wrapper eliminations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionElimination (Core.EliminationWrap TestGraph.testTypeStringAliasName))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable TestGraph.testTypeStringAliasName),+                        Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeString)}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationWrap TestGraph.testTypeStringAliasName))),+                      Core.applicationArgument = (Core.TermWrap (Core.WrappedTerm {+                        Core.wrappedTermTypeName = TestGraph.testTypeStringAliasName,+                        Core.wrappedTermObject = (Core.TermLiteral (Core.LiteralString "foo"))}))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []},+    Testing.TestGroup {+      Testing.testGroupName = "Simple terms",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [+        Testing.TestGroup {+          Testing.testGroupName = "Application terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [],+          Testing.testGroupCases = [+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#1",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                    Core.lambdaParameter = (Core.Name "x"),+                    Core.lambdaDomain = Nothing,+                    Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                  Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "foo"))})),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []},+            Testing.TestCaseWithMetadata {+              Testing.testCaseWithMetadataName = "#2",+              Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                  Core.lambdaParameter = (Core.Name "x"),+                  Core.lambdaDomain = Nothing,+                  Core.lambdaBody = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.sub"))),+                      Core.applicationArgument = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add"))),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                    Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))}))}))),+                Testing.inferenceTestCaseOutput = Core.TypeScheme {+                  Core.typeSchemeVariables = [],+                  Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                    Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                    Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+              Testing.testCaseWithMetadataDescription = Nothing,+              Testing.testCaseWithMetadataTags = []}]},+        Testing.TestGroup {+          Testing.testGroupName = "Function terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Lambdas",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermVariable (Core.Name "x"))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt16 137)))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt16))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List eliminations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                      Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                        Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                      Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.foldl"))),+                          Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.add")))})),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+                      Core.applicationArgument = (Core.TermList [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                        (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Optional eliminations",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.maybe"))),+                        Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                      Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg")))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.maybe"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg")))})),+                      Core.applicationArgument = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 137)))))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.maybe"))),+                          Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                        Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg")))})),+                      Core.applicationArgument = (Core.TermOptional Nothing)})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermApplication (Core.Application {+                            Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.maybe"))),+                            Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                          Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.pure")))})),+                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0"))),+                        Core.functionTypeCodomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#5",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.optionals.maybe"))),+                        Core.applicationArgument = (Core.TermList [])})),+                      Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "x"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermList [+                          Core.TermVariable (Core.Name "x")])})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0"))),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Tuple projections",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                      Core.tupleProjectionArity = 2,+                      Core.tupleProjectionIndex = 0,+                      Core.tupleProjectionDomain = Nothing})))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeProduct [+                          Core.TypeVariable (Core.Name "t0"),+                          (Core.TypeVariable (Core.Name "t1"))]),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermApplication (Core.Application {+                      Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                        Core.tupleProjectionArity = 2,+                        Core.tupleProjectionIndex = 1,+                        Core.tupleProjectionDomain = Nothing})))),+                      Core.applicationArgument = (Core.TermProduct [+                        Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                        (Core.TermLiteral (Core.LiteralString "foo"))])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                          Core.tupleProjectionArity = 1,+                          Core.tupleProjectionIndex = 0,+                          Core.tupleProjectionDomain = Nothing})))),+                        Core.applicationArgument = (Core.TermProduct [+                          Core.TermVariable (Core.Name "x")])}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeVariable (Core.Name "t0"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionElimination (Core.EliminationProduct (Core.TupleProjection {+                          Core.tupleProjectionArity = 3,+                          Core.tupleProjectionIndex = 2,+                          Core.tupleProjectionDomain = Nothing})))),+                        Core.applicationArgument = (Core.TermProduct [+                          Core.TermVariable (Core.Name "x"),+                          Core.TermVariable (Core.Name "x"),+                          (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Individual terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Literal values",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralString "foo")),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeString)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralBoolean False)),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral Core.LiteralTypeBoolean)}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#4",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 42.0))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Let terms",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "x"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 42.0))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "y"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "z"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermVariable (Core.Name "x"))})))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t1")),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "square"),+                          Core.bindingTerm = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "z"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.mul"))),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "z"))})),+                              Core.applicationArgument = (Core.TermVariable (Core.Name "z"))}))}))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "f"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                          Core.lambdaParameter = (Core.Name "x"),+                          Core.lambdaDomain = Nothing,+                          Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                            Core.lambdaParameter = (Core.Name "y"),+                            Core.lambdaDomain = Nothing,+                            Core.lambdaBody = (Core.TermApplication (Core.Application {+                              Core.applicationFunction = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.logic.ifElse"))),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                      Core.applicationArgument = (Core.TermApplication (Core.Application {+                                        Core.applicationFunction = (Core.TermVariable (Core.Name "square")),+                                        Core.applicationArgument = (Core.TermVariable (Core.Name "x"))}))})),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))})),+                                Core.applicationArgument = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                                    Core.applicationFunction = (Core.TermApplication (Core.Application {+                                      Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                      Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                                    Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})),+                              Core.applicationArgument = (Core.TermApplication (Core.Application {+                                Core.applicationFunction = (Core.TermApplication (Core.Application {+                                  Core.applicationFunction = (Core.TermVariable (Core.Name "f")),+                                  Core.applicationArgument = (Core.TermVariable (Core.Name "x"))})),+                                Core.applicationArgument = (Core.TermVariable (Core.Name "y"))}))}))})))})))})))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeBoolean),+                            Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)}))})),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                            Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeBoolean),+                            Core.functionTypeCodomain = (Core.TypeLiteral Core.LiteralTypeBoolean)}))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Optionals",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeOptional (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermOptional Nothing),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeOptional (Core.TypeVariable (Core.Name "t0")))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+                      (Core.TermLiteral (Core.LiteralString "foo"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Sets",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSet (S.fromList [+                      Core.TermLiteral (Core.LiteralBoolean True)])),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeSet (Core.TypeLiteral Core.LiteralTypeBoolean))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSet (S.fromList [+                      Core.TermSet (S.fromList [])])),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSet (Core.TypeSet (Core.TypeVariable (Core.Name "t0"))))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Maps",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermMap (M.fromList [+                      (Core.TermLiteral (Core.LiteralString "firstName"), (Core.TermLiteral (Core.LiteralString "Arthur"))),+                      (Core.TermLiteral (Core.LiteralString "lastName"), (Core.TermLiteral (Core.LiteralString "Dent")))])),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeMap (Core.MapType {+                        Core.mapTypeKeys = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.mapTypeValues = (Core.TypeLiteral Core.LiteralTypeString)}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermMap Maps.empty),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0",+                        (Core.Name "t1")],+                      Core.typeSchemeType = (Core.TypeMap (Core.MapType {+                        Core.mapTypeKeys = (Core.TypeVariable (Core.Name "t0")),+                        Core.mapTypeValues = (Core.TypeVariable (Core.Name "t1"))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#3",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                        Core.lambdaParameter = (Core.Name "y"),+                        Core.lambdaDomain = Nothing,+                        Core.lambdaBody = (Core.TermMap (M.fromList [+                          (Core.TermVariable (Core.Name "x"), (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.1)))),+                          (Core.TermVariable (Core.Name "y"), (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat64 0.2))))]))})))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeVariable (Core.Name "t0")),+                          Core.functionTypeCodomain = (Core.TypeMap (Core.MapType {+                            Core.mapTypeKeys = (Core.TypeVariable (Core.Name "t0")),+                            Core.mapTypeValues = (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat64))}))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Let terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Empty let",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [],+                      Core.letEnvironment = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Trivial let",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermLet (Core.Let {+                      Core.letBindings = [+                        Core.Binding {+                          Core.bindingName = (Core.Name "foo"),+                          Core.bindingTerm = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))),+                          Core.bindingType = Nothing}],+                      Core.letEnvironment = (Core.TermVariable (Core.Name "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "List terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "List of strings",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermLiteral (Core.LiteralString "bar"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List of lists of strings",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermList [+                        Core.TermLiteral (Core.LiteralString "foo")],+                      (Core.TermList [])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString)))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Empty list",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeVariable (Core.Name "t0")))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List containing an empty list",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermList [+                      Core.TermList []]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0"))))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Lambda producing a list of integers",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x"),+                        (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "List with bound variables",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "x"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermList [+                        Core.TermVariable (Core.Name "x"),+                        Core.TermLiteral (Core.LiteralString "foo"),+                        (Core.TermVariable (Core.Name "x"))])}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.functionTypeCodomain = (Core.TypeList (Core.TypeLiteral Core.LiteralTypeString))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Primitive terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Monomorphic primitive functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral Core.LiteralTypeString),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.sub"))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                        Core.functionTypeCodomain = (Core.TypeFunction (Core.FunctionType {+                          Core.functionTypeDomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32)),+                          Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polymorphic primitive functions",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                      Core.lambdaParameter = (Core.Name "els"),+                      Core.lambdaDomain = Nothing,+                      Core.lambdaBody = (Core.TermApplication (Core.Application {+                        Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+                        Core.applicationArgument = (Core.TermApplication (Core.Application {+                          Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+                          Core.applicationArgument = (Core.TermVariable (Core.Name "els"))}))}))}))),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeFunction (Core.FunctionType {+                        Core.functionTypeDomain = (Core.TypeList (Core.TypeList (Core.TypeVariable (Core.Name "t0")))),+                        Core.functionTypeCodomain = (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))}))}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Product terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Empty product",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct []),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Non-empty monotyped products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeLiteral (Core.LiteralTypeInteger Core.IntegerTypeInt32))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermLiteral (Core.LiteralString "foo"),+                      (Core.TermList [+                        Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 42.0)),+                        (Core.TermLiteral (Core.LiteralFloat (Core.FloatValueFloat32 137.0)))])]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeList (Core.TypeLiteral (Core.LiteralTypeFloat Core.FloatTypeFloat32)))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]},+            Testing.TestGroup {+              Testing.testGroupName = "Polytyped products",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermProduct [+                      Core.TermList [],+                      (Core.TermLiteral (Core.LiteralString "foo"))]),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeProduct [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0")),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = []}]}],+          Testing.testGroupCases = []},+        Testing.TestGroup {+          Testing.testGroupName = "Sum terms",+          Testing.testGroupDescription = Nothing,+          Testing.testGroupSubgroups = [+            Testing.TestGroup {+              Testing.testGroupName = "Singleton sum terms",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 1,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeLiteral Core.LiteralTypeString])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 1,+                      Core.sumTerm = (Core.TermList [])})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeList (Core.TypeVariable (Core.Name "t0"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]},+            Testing.TestGroup {+              Testing.testGroupName = "Non-singleton sum terms",+              Testing.testGroupDescription = Nothing,+              Testing.testGroupSubgroups = [],+              Testing.testGroupCases = [+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#1",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 0,+                      Core.sumSize = 2,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeLiteral Core.LiteralTypeString,+                        (Core.TypeVariable (Core.Name "t0"))])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]},+                Testing.TestCaseWithMetadata {+                  Testing.testCaseWithMetadataName = "#2",+                  Testing.testCaseWithMetadataCase = (Testing.TestCaseInference (Testing.InferenceTestCase {+                    Testing.inferenceTestCaseInput = (Core.TermSum (Core.Sum {+                      Core.sumIndex = 1,+                      Core.sumSize = 2,+                      Core.sumTerm = (Core.TermLiteral (Core.LiteralString "foo"))})),+                    Testing.inferenceTestCaseOutput = Core.TypeScheme {+                      Core.typeSchemeVariables = [+                        Core.Name "t0"],+                      Core.typeSchemeType = (Core.TypeSum [+                        Core.TypeVariable (Core.Name "t0"),+                        (Core.TypeLiteral Core.LiteralTypeString)])}})),+                  Testing.testCaseWithMetadataDescription = Nothing,+                  Testing.testCaseWithMetadataTags = [+                    Testing.Tag "disabledForMinimalInference"]}]}],+          Testing.testGroupCases = []}],+      Testing.testGroupCases = []}],+  Testing.testGroupCases = []}++listPrimitiveTests :: Testing.TestGroup+listPrimitiveTests = Testing.TestGroup {+  Testing.testGroupName = "hydra.lib.lists primitives",+  Testing.testGroupDescription = Nothing,+  Testing.testGroupSubgroups = [+    Testing.TestGroup {+      Testing.testGroupName = "apply",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string transformations",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.apply"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper")),+                  (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower")))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "One"),+                Core.TermLiteral (Core.LiteralString "Two"),+                (Core.TermLiteral (Core.LiteralString "Three"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "ONE"),+              Core.TermLiteral (Core.LiteralString "TWO"),+              Core.TermLiteral (Core.LiteralString "THREE"),+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "two"),+              (Core.TermLiteral (Core.LiteralString "three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty function list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.apply"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString "b"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty input list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.apply"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single function",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.apply"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello")])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "HELLO")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single input",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.apply"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper")),+                  (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower")))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "Test")])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "TEST"),+              (Core.TermLiteral (Core.LiteralString "test"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "at",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "first element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.at"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "middle element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.at"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "last element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.at"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.at"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list access",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.at"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "bind",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "negation function",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.bind"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = (Core.Name "arg_"),+                Core.lambdaDomain = Nothing,+                Core.lambdaBody = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                    Core.applicationArgument = (Core.TermVariable (Core.Name "arg_"))}))}))})))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-4))))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.bind"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = (Core.Name "arg_"),+                Core.lambdaDomain = Nothing,+                Core.lambdaBody = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                    Core.applicationArgument = (Core.TermVariable (Core.Name "arg_"))}))}))})))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.bind"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5))])})),+              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = (Core.Name "arg_"),+                Core.lambdaDomain = Nothing,+                Core.lambdaBody = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                    Core.applicationArgument = (Core.TermVariable (Core.Name "arg_"))}))}))})))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-5)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "duplicate elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.bind"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+              Core.applicationArgument = (Core.TermFunction (Core.FunctionLambda (Core.Lambda {+                Core.lambdaParameter = (Core.Name "arg_"),+                Core.lambdaDomain = Nothing,+                Core.lambdaBody = (Core.TermApplication (Core.Application {+                  Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+                  Core.applicationArgument = (Core.TermApplication (Core.Application {+                    Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg"))),+                    Core.applicationArgument = (Core.TermVariable (Core.Name "arg_"))}))}))})))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "concat",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple non-empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty lists included",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))],+                Core.TermList [],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))]])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [],+                Core.TermList [],+                (Core.TermList [])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list of lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "concat2",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two non-empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "first list empty",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "second list empty",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "both lists empty",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.concat2"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralString "a"),+                  (Core.TermLiteral (Core.LiteralString "b"))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "c"),+                (Core.TermLiteral (Core.LiteralString "d"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "a"),+              Core.TermLiteral (Core.LiteralString "b"),+              Core.TermLiteral (Core.LiteralString "c"),+              (Core.TermLiteral (Core.LiteralString "d"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "cons",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "cons to non-empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "cons to empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "cons negative number",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "cons string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.cons"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "world")])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello"),+              (Core.TermLiteral (Core.LiteralString "world"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "drop",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop from beginning",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop zero elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop all elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop more than length",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop from empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "drop negative amount",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.drop"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "elem",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "element present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "element not present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element not present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "duplicate elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string element present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "world"),+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "test"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string element not present",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.elem"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "missing"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "world"),+                (Core.TermLiteral (Core.LiteralString "hello"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "group",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "consecutive duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.group"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))],+              (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "no duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.group"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))],+              (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all same",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.group"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))]])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.group"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.group"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))]])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "head",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "three element list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "negative numbers",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.head"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "init",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.init"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.init"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.init"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.init"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "a"),+              (Core.TermLiteral (Core.LiteralString "b"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "intercalate",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "double zero separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 99))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 99)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 99)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list of lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))]])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "lists with empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intercalate"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))],+                (Core.TermList [])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "intersperse",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string interspersion",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intersperse"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "and"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "one"),+                Core.TermLiteral (Core.LiteralString "two"),+                (Core.TermLiteral (Core.LiteralString "three"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "and"),+              Core.TermLiteral (Core.LiteralString "two"),+              Core.TermLiteral (Core.LiteralString "and"),+              (Core.TermLiteral (Core.LiteralString "three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intersperse"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "x"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "only")])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "only")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intersperse"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "x"))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intersperse"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "+"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString "b"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "a"),+              Core.TermLiteral (Core.LiteralString "+"),+              (Core.TermLiteral (Core.LiteralString "b"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "number interspersion",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.intersperse"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "last",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "three element list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.last"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.last"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "negative numbers",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.last"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.last"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "length",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "three elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "many elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 7)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 8)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 9)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 10)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 10)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.length"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "map",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string to uppercase",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.map"))),+                Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper")))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "one"),+                (Core.TermLiteral (Core.LiteralString "two"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "ONE"),+              (Core.TermLiteral (Core.LiteralString "TWO"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.map"))),+                Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper")))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.map"))),+                Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper")))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello")])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "HELLO")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "number negation",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.map"))),+                Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.math.neg")))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-2))),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-3))))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "identity function",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.map"))),+                Core.applicationArgument = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.equality.identity")))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "nub",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "remove duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "no duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.nub"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "a"),+              Core.TermLiteral (Core.LiteralString "b"),+              (Core.TermLiteral (Core.LiteralString "c"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "null",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty int list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.null"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.null"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.null"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.null"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "non-empty string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.null"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a")])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "pure",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "one")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "number element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "negative number",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.pure"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-5))))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-5)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "replicate",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "replicate three times",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.replicate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "replicate zero times",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.replicate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "replicate once",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.replicate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 99)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 99))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "replicate string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.replicate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello"),+              (Core.TermLiteral (Core.LiteralString "hello"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "reverse",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.reverse"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.reverse"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.reverse"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.reverse"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.reverse"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "c"),+              Core.TermLiteral (Core.LiteralString "b"),+              (Core.TermLiteral (Core.LiteralString "a"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "safeHead",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "non-empty int list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.safeHead"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty int list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.safeHead"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermOptional Nothing)})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.safeHead"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+            Testing.evaluationTestCaseOutput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "non-empty string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.safeHead"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermOptional (Just (Core.TermLiteral (Core.LiteralString "hello"))))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.safeHead"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermOptional Nothing)})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "singleton",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "number element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.singleton"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 42))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "negative number",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.singleton"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "zero",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.singleton"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.singleton"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "sort",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unsorted numbers",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "already sorted",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "reverse sorted",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "duplicates",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string sort",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.sort"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "zebra"),+                Core.TermLiteral (Core.LiteralString "apple"),+                (Core.TermLiteral (Core.LiteralString "banana"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "apple"),+              Core.TermLiteral (Core.LiteralString "banana"),+              (Core.TermLiteral (Core.LiteralString "zebra"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "tail",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single element",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.tail"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "b"),+              (Core.TermLiteral (Core.LiteralString "c"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "take",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take from beginning",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take zero elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take all elements",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take more than length",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take from empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "take negative amount",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.take"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 (0-1))))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "transpose",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "square matrix",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.transpose"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+              (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.transpose"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single row",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.transpose"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))]])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))],+              (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single column",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.transpose"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1))],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))]])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "ragged matrix",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.transpose"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))],+                Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3))],+                (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6)))])])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))],+              Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))],+              (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 6))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "zip",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "equal length lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralString "a"))],+              Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralString "b"))],+              (Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)),+                (Core.TermLiteral (Core.LiteralString "c"))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "first list shorter",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralString "a"))],+              (Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralString "b"))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "second list shorter",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString "b"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                (Core.TermLiteral (Core.LiteralString "a"))],+              (Core.TermProduct [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)),+                (Core.TermLiteral (Core.LiteralString "b"))])])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty first list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString "b"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty second list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [+                  Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)),+                  (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "both empty lists",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.lists.zip"))),+                Core.applicationArgument = (Core.TermList [])})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]}],+  Testing.testGroupCases = []}++primitiveTests :: Testing.TestGroup+primitiveTests = Testing.TestGroup {+  Testing.testGroupName = "Primitive functions",+  Testing.testGroupDescription = (Just "Test cases for primitive functions"),+  Testing.testGroupSubgroups = [+    listPrimitiveTests,+    stringPrimitiveTests],+  Testing.testGroupCases = []}++stringPrimitiveTests :: Testing.TestGroup+stringPrimitiveTests = Testing.TestGroup {+  Testing.testGroupName = "hydra.lib.strings primitives",+  Testing.testGroupDescription = Nothing,+  Testing.testGroupSubgroups = [+    Testing.TestGroup {+      Testing.testGroupName = "cat",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic concatenation",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "one"),+                Core.TermLiteral (Core.LiteralString "two"),+                (Core.TermLiteral (Core.LiteralString "three"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "onetwothree"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with empty strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString ""),+                Core.TermLiteral (Core.LiteralString "one"),+                Core.TermLiteral (Core.LiteralString ""),+                (Core.TermLiteral (Core.LiteralString ""))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "one"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello")])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "many empty strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString ""),+                Core.TermLiteral (Core.LiteralString ""),+                Core.TermLiteral (Core.LiteralString ""),+                (Core.TermLiteral (Core.LiteralString ""))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "\241"),+                Core.TermLiteral (Core.LiteralString "\19990"),+                (Core.TermLiteral (Core.LiteralString "\127757"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\241\19990\127757"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "\n"),+                Core.TermLiteral (Core.LiteralString "\t"),+                (Core.TermLiteral (Core.LiteralString "\r"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numbers as strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "1"),+                Core.TermLiteral (Core.LiteralString "2"),+                (Core.TermLiteral (Core.LiteralString "3"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "123"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString " "),+                Core.TermLiteral (Core.LiteralString " "),+                (Core.TermLiteral (Core.LiteralString " "))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "   "))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "mixed content",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "Hello"),+                Core.TermLiteral (Core.LiteralString " "),+                Core.TermLiteral (Core.LiteralString "World"),+                (Core.TermLiteral (Core.LiteralString "!"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "Hello World!"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "cat2",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic concatenation",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "helloworld"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty first string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty second string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "both empty strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello "))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\241"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\19990"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\241\19990"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numeric strings",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "123"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "456"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "123456"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.cat2"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\t"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\t"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "charAt",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "first character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 104)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "middle character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 2)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 108)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "last character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 4)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 111)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 97)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\241"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 241)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "space character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 32)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "newline character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 10)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "tab character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.charAt"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\t"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 9)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "fromList",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic ascii string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 104)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 101)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 108)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 108)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 111)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty code point list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 97))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "a"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 104)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 32)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 105)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "h i"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 241)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 19990)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 127757)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\241\19990\127757"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numeric characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 49)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 50)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 51)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "123"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.fromList"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 10)),+                Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 9)),+                (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 13)))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "intercalate",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "comma separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ","))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "one"),+                Core.TermLiteral (Core.LiteralString "two"),+                (Core.TermLiteral (Core.LiteralString "three"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "one,two,three"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "space separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "a"),+                Core.TermLiteral (Core.LiteralString "b"),+                (Core.TermLiteral (Core.LiteralString "c"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "abc"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multi-character separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " | "))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "A"),+                Core.TermLiteral (Core.LiteralString "B"),+                (Core.TermLiteral (Core.LiteralString "C"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "A | B | C"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ","))})),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single item list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ","))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "only")])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "only"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty strings in list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ","))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString ""),+                Core.TermLiteral (Core.LiteralString "a"),+                (Core.TermLiteral (Core.LiteralString ""))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ",a,"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.intercalate"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\128279"))})),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "link1"),+                (Core.TermLiteral (Core.LiteralString "link2"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "link1\128279link2"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "length",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 0)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 1)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic word",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "string with spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 11)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\241\19990\127757"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 3)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numeric string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "12345"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 5)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "long string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.length"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "this is a longer string for testing"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 35)))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "lines",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single line",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello world")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "two lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello\nworld"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello"),+              (Core.TermLiteral (Core.LiteralString "world"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "three lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one\ntwo\nthree"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "two"),+              (Core.TermLiteral (Core.LiteralString "three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "just newline",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "trailing newline",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello\n"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "leading newline",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\nhello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "hello"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple consecutive newlines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.lines"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a\n\nb"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "a"),+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "b"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "null",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean True))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "space only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic word",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "newline only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "tab only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.null"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\t"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralBoolean False))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "splitOn",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "double s in Mississippi",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "ss"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "Mi"),+              Core.TermLiteral (Core.LiteralString "i"),+              (Core.TermLiteral (Core.LiteralString "ippi"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "whole string as separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Mississippi"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString ""))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "space separated words",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "one two three"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "two"),+              (Core.TermLiteral (Core.LiteralString "three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "leading and trailing spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " one two three "))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "two"),+              Core.TermLiteral (Core.LiteralString "three"),+              (Core.TermLiteral (Core.LiteralString ""))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple consecutive spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString " "))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  one two three"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              Core.TermLiteral (Core.LiteralString ""),+              Core.TermLiteral (Core.LiteralString "one"),+              Core.TermLiteral (Core.LiteralString "two"),+              (Core.TermLiteral (Core.LiteralString "three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "double space separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  "))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "  one two three"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "one two three"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "overlapping pattern aa in aaa",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aa"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "aaa"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "a"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "separator on empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty separator on abc",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "abc"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              Core.TermLiteral (Core.LiteralString "a"),+              Core.TermLiteral (Core.LiteralString "b"),+              (Core.TermLiteral (Core.LiteralString "c"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "both separator and string empty",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "separator not found",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "x"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello")])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "separator at start",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "h"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "ello"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "separator at end",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "o"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hell"),+              (Core.TermLiteral (Core.LiteralString ""))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multiple same separators",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "l"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "he"),+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString "o"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character string and separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString ""),+              (Core.TermLiteral (Core.LiteralString ""))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\19990"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello\19990world\19990!"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "hello"),+              Core.TermLiteral (Core.LiteralString "world"),+              (Core.TermLiteral (Core.LiteralString "!"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "multi-character separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "ab"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "cabbage"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "c"),+              (Core.TermLiteral (Core.LiteralString "bage"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "newline separator",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermApplication (Core.Application {+                Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.splitOn"))),+                Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n"))})),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "line1\nline2\nline3"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralString "line1"),+              Core.TermLiteral (Core.LiteralString "line2"),+              (Core.TermLiteral (Core.LiteralString "line3"))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "toList",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single character",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 97))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic word",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 104)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 101)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 108)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 108)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 111)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with space",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "h i"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 104)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 32)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 105)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\241\19990\127757"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 241)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 19990)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 127757)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numeric string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "123"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 49)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 50)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 51)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toList"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+            Testing.evaluationTestCaseOutput = (Core.TermList [+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 10)),+              Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 9)),+              (Core.TermLiteral (Core.LiteralInteger (Core.IntegerValueInt32 13)))])})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "toLower",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "mixed case sentence",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "one two three"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "alphanumeric mixed case",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "abc123"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all uppercase",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "HELLO"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all lowercase",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single uppercase char",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "A"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "a"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single lowercase char",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "a"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Hello World"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello world"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with punctuation",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Hello, World!"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello, world!"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode accented chars",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\209\193\201\205\211\218"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\241\225\233\237\243\250"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numbers only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "12345"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "12345"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toLower"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "toUpper",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "mixed case sentence",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "One TWO threE"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "ONE TWO THREE"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "alphanumeric mixed case",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "Abc123"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "ABC123"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all lowercase",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "HELLO"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all uppercase",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "HELLO"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "HELLO"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty string",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString ""))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single lowercase char",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "a"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "A"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single uppercase char",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "A"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "A"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with spaces",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello world"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "HELLO WORLD"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with punctuation",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "hello, world!"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "HELLO, WORLD!"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode accented chars",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\241\225\233\237\243\250"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\209\193\201\205\211\218"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "numbers only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "12345"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "12345"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "special characters only",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.toUpper"))),+              Core.applicationArgument = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\t\r"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]},+    Testing.TestGroup {+      Testing.testGroupName = "unlines",+      Testing.testGroupDescription = Nothing,+      Testing.testGroupSubgroups = [],+      Testing.testGroupCases = [+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "basic two lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello\nworld\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "single line",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello")])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "empty list",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString ""))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "three lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "one"),+                Core.TermLiteral (Core.LiteralString "two"),+                (Core.TermLiteral (Core.LiteralString "three"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "one\ntwo\nthree\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "with empty lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "hello"),+                Core.TermLiteral (Core.LiteralString ""),+                (Core.TermLiteral (Core.LiteralString "world"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "hello\n\nworld\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "all empty lines",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString ""),+                Core.TermLiteral (Core.LiteralString ""),+                (Core.TermLiteral (Core.LiteralString ""))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\n\n\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []},+        Testing.TestCaseWithMetadata {+          Testing.testCaseWithMetadataName = "unicode content",+          Testing.testCaseWithMetadataCase = (Testing.TestCaseEvaluation (Testing.EvaluationTestCase {+            Testing.evaluationTestCaseEvaluationStyle = Testing.EvaluationStyleEager,+            Testing.evaluationTestCaseInput = (Core.TermApplication (Core.Application {+              Core.applicationFunction = (Core.TermFunction (Core.FunctionPrimitive (Core.Name "hydra.lib.strings.unlines"))),+              Core.applicationArgument = (Core.TermList [+                Core.TermLiteral (Core.LiteralString "\241o\241o"),+                (Core.TermLiteral (Core.LiteralString "\19990\30028"))])})),+            Testing.evaluationTestCaseOutput = (Core.TermLiteral (Core.LiteralString "\241o\241o\n\19990\30028\n"))})),+          Testing.testCaseWithMetadataDescription = Nothing,+          Testing.testCaseWithMetadataTags = []}]}],   Testing.testGroupCases = []}
− src/main/haskell/Hydra/AdapterUtils.hs 
@@ -1,134 +0,0 @@--- | Additional adapter utilities, above and beyond the generated ones--module Hydra.AdapterUtils (-  module Hydra.AdapterUtils,-  module Hydra.Printing,-) where--import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.Basics-import Hydra.Module-import Hydra.Printing-import Hydra.Mantle-import Hydra.Strip-import Hydra.Annotations-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Data.List as L-import qualified Data.Set as S-import qualified Data.Maybe as Y-import Control.Monad---type SymmetricAdapter s t v = Adapter s s t t v v--type TypeAdapter = Type -> Flow AdapterContext (SymmetricAdapter AdapterContext Type Term)--key_types = Name "types"--bidirectional :: (CoderDirection -> b -> Flow s b) -> Coder s s b b-bidirectional f = Coder (f CoderDirectionEncode) (f CoderDirectionDecode)--chooseAdapter :: (Eq t, Ord t, Show t) =>-    (t -> [Flow so (SymmetricAdapter si t v)])- -> (t -> Bool)- -> (t -> String)- -> t- -> Flow so (SymmetricAdapter si t v)-chooseAdapter alts supported describe typ = if supported typ-  then pure $ Adapter False typ typ idCoder-  else do-    -- Uncomment to debug adapter cycles-    -- debugCheckType typ--    raw <- sequence (alts typ)-    let candidates = L.filter (supported . adapterTarget) raw-    if L.null candidates-      then fail $ "no adapters found for " ++ describe typ-        ++ (if L.null raw-           then ""-           else " (discarded " ++ show (L.length raw) ++ " unsupported candidate types: " ++ show (adapterTarget <$> raw) ++ ")")-        ++ ". Original type: " ++ show typ-      else do-        -- Uncomment to debug adapter cycles-        -- debugRemoveType typ--        return $ L.head candidates--composeCoders :: Coder s s a b -> Coder s s b c -> Coder s s a c-composeCoders c1 c2 = Coder {-  coderEncode = coderEncode c1 >=> coderEncode c2,-  coderDecode = coderDecode c2 >=> coderDecode c1}--debugCheckType :: (Eq t, Ord t, Show t) => t -> Flow s ()-debugCheckType typ = do-  let s = show typ-  types <- getAttrWithDefault key_types (Terms.set S.empty) >>= Expect.set Expect.string-  if S.member s types-    then fail $ "detected a cycle; type has already been encountered: " ++ show typ-    else putAttr key_types $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types))-  return ()--debugRemoveType :: (Eq t, Ord t, Show t) => t -> Flow s ()-debugRemoveType typ = do-  let s = show typ-  types <- getAttrWithDefault key_types (Terms.set S.empty) >>= Expect.set Expect.string-  let types' = S.delete s types-  putAttr key_types $ Terms.set $ S.fromList (Terms.string <$> (S.toList $ S.insert s types'))--encodeDecode :: CoderDirection -> Coder s s x x -> x -> Flow s x-encodeDecode dir = case dir of-  CoderDirectionEncode -> coderEncode-  CoderDirectionDecode -> coderDecode--floatTypeIsSupported :: LanguageConstraints -> FloatType -> Bool-floatTypeIsSupported constraints ft = S.member ft $ languageConstraintsFloatTypes constraints--idAdapter :: t -> SymmetricAdapter s t v-idAdapter t = Adapter False t t idCoder--idCoder :: Coder s s a a-idCoder = Coder pure pure--integerTypeIsSupported :: LanguageConstraints -> IntegerType -> Bool-integerTypeIsSupported constraints it = S.member it $ languageConstraintsIntegerTypes constraints--literalTypeIsSupported :: LanguageConstraints -> LiteralType -> Bool-literalTypeIsSupported constraints at = S.member (literalTypeVariant at) (languageConstraintsLiteralVariants constraints)-  && case at of-    LiteralTypeFloat ft -> floatTypeIsSupported constraints ft-    LiteralTypeInteger it -> integerTypeIsSupported constraints it-    _ -> True--nameToFilePath :: Bool -> FileExtension -> Name -> FilePath-nameToFilePath caps ext name = namespaceToFilePath caps ext $ Namespace $ prefix ++ local-  where-    QualifiedName ns local = qualifyNameEager name-    prefix = Y.maybe "" (\(Namespace gname) -> gname ++ "/") ns--typeIsSupported :: LanguageConstraints -> Type -> Bool-typeIsSupported constraints t = languageConstraintsTypes constraints base -- these are *additional* type constraints-  && isSupportedVariant (typeVariant base)-  && case base of-    TypeLiteral at -> literalTypeIsSupported constraints at-    TypeFunction (FunctionType dom cod) -> typeIsSupported constraints dom && typeIsSupported constraints cod-    TypeList lt -> typeIsSupported constraints lt-    TypeMap (MapType kt vt) -> typeIsSupported constraints kt && typeIsSupported constraints vt-    TypeWrap _ -> True -- TODO: dereference the type-    TypeOptional t -> typeIsSupported constraints t-    TypeRecord rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt-    TypeSet st -> typeIsSupported constraints st-    TypeUnion rt -> and $ typeIsSupported constraints . fieldTypeType <$> rowTypeFields rt-    _ -> True-  where-    isSupportedVariant v = v == TypeVariantVariable || S.member v (languageConstraintsTypeVariants constraints)-    base = stripType t--unidirectionalCoder :: (a -> Flow s b) -> Coder s s a b-unidirectionalCoder m = Coder {-  coderEncode = m,-  coderDecode = \_ -> fail "inbound mapping is unsupported"}
− src/main/haskell/Hydra/Adapters.hs 
@@ -1,90 +0,0 @@--- | Entry point for Hydra's adapter (type/term rewriting) framework.---   An adapter takes a type expression which is supported in a source language, and rewrites it to a type which is supported by a target language.---   In parallel, terms conforming to the original type are rewritten. Both levels of the transformation are bidirectional.--module Hydra.Adapters where--import Hydra.TermAdapters-import Hydra.Printing-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.Schemas-import Hydra.CoreLanguage-import Hydra.Graph-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Module-import Hydra.Strip-import Hydra.TermAdapters-import Hydra.AdapterUtils-import Hydra.Reduction-import Hydra.Tier1-import Hydra.Tier2--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S---adaptAndEncodeType :: Language -> (Type -> Flow Graph t) -> Type -> Flow Graph t-adaptAndEncodeType lang enc typ = case stripType typ of-  TypeVariable _ -> enc typ-  _ -> adaptType lang typ >>= enc---- | Given a target language and a source type, find the target type to which the latter will be adapted.-adaptType :: Language -> Type -> Flow Graph Type-adaptType lang typ = adapterTarget <$> languageAdapter lang typ---- | Given a target language, a unidirectional last-mile encoding, and a source type,---   construct a unidirectional adapting coder for terms of that type. Terms will be rewritten according to the type and---   according to the constraints of the target language, then carried by the last mile into the final representation-constructCoder :: Language-  -> (Term -> Flow Graph c)-  -> Type-  -> Flow Graph (Coder Graph Graph Term c)-constructCoder lang encodeTerm typ = withTrace ("coder for " ++ describeType typ) $ do-    adapter <- languageAdapter lang typ-    return $ composeCoders (adapterCoder adapter) (unidirectionalCoder encodeTerm)---- | Given a target language and a source type, produce an adapter,---   which rewrites the type and its terms according to the language's constraints-languageAdapter :: Language -> Type -> Flow Graph (SymmetricAdapter Graph Type Term)-languageAdapter lang typ0 = do-  -- TODO: rather than beta-reducing types all at once, we should incrementally extend the environment when application types are adapted-  -- typ <- betaReduceType typ0-  let typ = typ0--  g  <- getState-  -- Provide an initial adapter context-  let cx0 = AdapterContext g lang M.empty-  -- Construct the term adapter, and capture the populated adapter context-  (adapter, cx) <- withState cx0 $ do-    ad <- termAdapter typ-    cx <- getState -- The state has been mutated to hold adapters for type elements-    return (ad, cx)-  -- Wrap terms in the adapter context as they pass through the adapter coder-  let ac = Coder encode decode-        where-          encode = withState cx . coderEncode (adapterCoder adapter)-          decode = withState cx . coderDecode (adapterCoder adapter)-  return $ adapter {adapterCoder = ac}---- | Given a target language, a unidirectional last mile encoding, and an intermediate helper function,---   transform a given module into a target representation-transformModule :: Language-  -> (Term -> Flow Graph e)-  -> (Module -> M.Map Type (Coder Graph Graph Term e) -> [(Element, TypedTerm)] -> Flow Graph d)-  -> Module -> Flow Graph d-transformModule lang encodeTerm createModule mod = withTrace ("transform module " ++ unNamespace (moduleNamespace mod)) $ do-    tterms <- withSchemaContext $ CM.mapM elementAsTypedTerm els-    let types = L.nub (typedTermType <$> tterms)-    coders <- codersFor types-    createModule mod coders $ L.zip els tterms-  where-    els = moduleElements mod--    codersFor types = do-      cdrs <- CM.mapM (constructCoder lang encodeTerm) types-      return $ M.fromList $ L.zip types cdrs
− src/main/haskell/Hydra/Annotations.hs 
@@ -1,216 +0,0 @@--- | Functions for working with term and type annotations--module Hydra.Annotations where--import Hydra.Basics-import Hydra.Strip-import Hydra.Core-import Hydra.Compute-import Hydra.Extras-import Hydra.Graph-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import Hydra.Mantle-import Hydra.Rewriting-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---key_classes = Name "classes"-key_description = Name "description"-key_type = Name "type"---aggregateAnnotations :: (x -> Maybe y) -> (y -> x) -> (y -> M.Map Name Term) -> x -> M.Map Name Term-aggregateAnnotations getValue getX getAnns t = M.fromList $ L.concat $ toPairs [] t-  where-    toPairs rest t = case getValue t of-      Nothing -> rest-      Just yy -> toPairs ((M.toList (getAnns yy)):rest) (getX yy)--failOnFlag :: Name -> String -> Flow s ()-failOnFlag flag msg = do-  val <- hasFlag flag-  if val-    then fail msg-    else pure ()--getAttr :: Name -> Flow s (Maybe Term)-getAttr key = Flow q-  where-    q s0 t0 = FlowState (Just $ M.lookup key $ traceOther t0) s0 t0--getAttrWithDefault :: Name -> Term -> Flow s Term-getAttrWithDefault key def = Y.fromMaybe def <$> getAttr key--getDescription :: M.Map Name Term -> Flow Graph (Y.Maybe String)-getDescription anns = case getAnnotation key_description anns of-  Nothing -> pure Nothing-  Just term -> case term of-    TermLiteral (LiteralString s) -> pure $ Just s-    _ -> fail $ "unexpected value for " ++ show key_description ++ ": " ++ show term--getTermAnnotation :: Name -> Term -> Y.Maybe Term-getTermAnnotation key = getAnnotation key . termAnnotationInternal--getTermDescription :: Term -> Flow Graph (Y.Maybe String)-getTermDescription = getDescription . termAnnotationInternal--getType :: M.Map Name Term -> Flow Graph (Y.Maybe Type)-getType anns = case getAnnotation key_type anns of-  Nothing -> pure Nothing-  Just dat -> Just <$> coreDecodeType dat--getTypeAnnotation :: Name -> Type -> Y.Maybe Term-getTypeAnnotation key = getAnnotation key . typeAnnotationInternal--getTypeClasses :: Type -> Flow Graph (M.Map Name (S.Set TypeClass))-getTypeClasses typ = case getTypeAnnotation key_classes typ of-    Nothing -> pure M.empty-    Just term -> Expect.map coreDecodeName (Expect.set decodeClass) term-  where-    decodeClass term = Expect.unitVariant _TypeClass term >>= \fn -> Y.maybe-      (unexpected "type class" $ show term) pure $ M.lookup fn byName-    byName = M.fromList [(_TypeClass_equality, TypeClassEquality), (_TypeClass_ordering, TypeClassOrdering)]--getTypeDescription :: Type -> Flow Graph (Y.Maybe String)-getTypeDescription = getDescription . typeAnnotationInternal--hasFlag :: Name -> Flow s Bool-hasFlag flag = getAttrWithDefault flag (Terms.boolean False) >>= Expect.boolean---- | Return a zero-indexed counter for the given key: 0, 1, 2, ...-nextCount :: Name -> Flow s Int-nextCount attrName = do-  count <- getAttrWithDefault attrName (Terms.int32 0) >>= Expect.int32-  putAttr attrName (Terms.int32 $ count + 1)-  return count--resetCount :: Name -> Flow s ()-resetCount attrName = do-  putAttr attrName (Terms.int32 0)-  return ()--normalizeTermAnnotations :: Term -> Term-normalizeTermAnnotations term = if M.null anns-    then stripped-    else TermAnnotated $ AnnotatedTerm stripped anns-  where-    anns = termAnnotationInternal term-    stripped = stripTerm term--normalizeTypeAnnotations :: Type -> Type-normalizeTypeAnnotations typ = if M.null anns-    then stripped-    else TypeAnnotated $ AnnotatedType stripped anns-  where-    anns = typeAnnotationInternal typ-    stripped = stripType typ--putAttr :: Name -> Term -> Flow s ()-putAttr key val = Flow q-  where-    q s0 t0 = FlowState (Just ()) s0 (t0 {traceOther = M.insert key val $ traceOther t0})--setAnnotation :: Name -> Y.Maybe Term -> M.Map Name Term -> M.Map Name Term-setAnnotation key val m = M.alter (const val) key m--setDescription :: Y.Maybe String -> M.Map Name Term -> M.Map Name Term-setDescription d = setAnnotation key_description (Terms.string <$> d)--setTermAnnotation :: Name -> Y.Maybe Term -> Term -> Term-setTermAnnotation key val term = if anns == M.empty-    then term'-    else TermAnnotated $ AnnotatedTerm term' anns-  where-    term' = stripTerm term-    anns = setAnnotation key val $ termAnnotationInternal term--setTermDescription :: Y.Maybe String -> Term -> Term-setTermDescription d = setTermAnnotation key_description (Terms.string <$> d)---- TODO: temporary. Move this function out of Annotations-setTermType :: Y.Maybe Type -> Term -> Term-setTermType mtyp term = case mtyp of-    Nothing -> withoutType term-    Just typ -> TermTyped $ TypedTerm (withoutType term) typ-  where-    withoutType term = case term of-      TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm (withoutType term1) ann-      TermTyped (TypedTerm term1 _) -> term1-      _ -> term--setType mt = setAnnotation key_type (coreEncodeType <$> mt)--setTypeAnnotation :: Name -> Y.Maybe Term -> Type -> Type-setTypeAnnotation key val typ = if anns == M.empty-    then typ'-    else TypeAnnotated $ AnnotatedType typ' anns-  where-    typ' = stripType typ-    anns = setAnnotation key val $ typeAnnotationInternal typ--setTypeClasses :: M.Map Name (S.Set TypeClass) -> Type -> Type-setTypeClasses m = setTypeAnnotation key_classes encoded-  where-    encoded = if M.null m-      then Nothing-      else Just $ Terms.map $ M.fromList (encodePair <$> M.toList m)-    encodePair (name, classes) = (coreEncodeName name, Terms.set $ S.fromList (encodeClass <$> (S.toList classes)))-    encodeClass tc = Terms.unitVariant _TypeClass $ case tc of-      TypeClassEquality -> _TypeClass_equality-      TypeClassOrdering -> _TypeClass_ordering--setTypeDescription :: Y.Maybe String -> Type -> Type-setTypeDescription d = setTypeAnnotation key_description (Terms.string <$> d)--termAnnotationInternal :: Term -> M.Map Name Term-termAnnotationInternal = aggregateAnnotations getAnn annotatedTermSubject annotatedTermAnnotation-  where-    getAnn t = case t of-      TermAnnotated a -> Just a-      TermTyped (TypedTerm t1 _) -> getAnn t1-      _ -> Nothing--typeAnnotationInternal :: Type -> M.Map Name Term-typeAnnotationInternal = aggregateAnnotations getAnn annotatedTypeSubject annotatedTypeAnnotation-  where-    getAnn t = case t of-      TypeAnnotated a -> Just a-      _ -> Nothing--whenFlag :: Name -> Flow s a -> Flow s a -> Flow s a-whenFlag flag fthen felse = do-  b <- hasFlag flag-  if b-    then fthen-    else felse---- TODO: move out of Annotations and into Rewriting-unshadowVariables :: Term -> Term-unshadowVariables term = Y.fromJust $ flowStateValue $ unFlow (rewriteTermM rewrite term) (S.empty, M.empty) emptyTrace-  where-    rewrite recurse term = do-      (reserved, subst) <- getState-      case term of-        TermVariable v -> pure $ TermVariable $ Y.fromMaybe v $ M.lookup v subst-        TermFunction (FunctionLambda (Lambda v d body)) -> if S.member v reserved-          then do-            v' <- freshName-            putState (S.insert v' reserved, M.insert v v' subst)-            body' <- recurse body-            putState (reserved, subst)-            pure $ TermFunction $ FunctionLambda $ Lambda v' d body'-          else do-            putState (S.insert v reserved, subst)-            body' <- recurse body-            return $ TermFunction $ FunctionLambda $ Lambda v d body'-        _ -> recurse term-    freshName = (\n -> Name $ "s" ++ show n) <$> nextCount (Name "unshadow")
− src/main/haskell/Hydra/Codegen.hs 
@@ -1,107 +0,0 @@--- | Entry point for Hydra code generation utilities--module Hydra.Codegen (-  modulesToGraph,-  writeGraphql,-  writeHaskell,-  writeJava,-  writePdl,-  writeProtobuf,-  writeScala,-  writeYaml,-  module Hydra.Sources.Tier4.All-) where--import Hydra.Kernel-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Ext.Graphql.Coder-import Hydra.Ext.Haskell.Coder-import Hydra.Ext.Java.Coder-import Hydra.Ext.Json.Coder-import Hydra.Ext.Pegasus.Coder-import Hydra.Ext.Protobuf.Coder-import Hydra.Ext.Scala.Coder-import Hydra.Ext.Yaml.Modules--import Hydra.Sources.Libraries-import Hydra.Sources.Tier4.All--import qualified Control.Monad as CM-import qualified System.FilePath as FP-import qualified Data.List as L-import qualified Data.Map as M-import qualified System.Directory as SD-import qualified Data.Maybe as Y---generateSources :: (Module -> Flow (Graph) (M.Map FilePath String)) -> FilePath -> [Module] -> IO ()-generateSources printModule basePath mods = do-    mfiles <- runFlow bootstrapGraph generateFiles-    case mfiles of-      Nothing -> fail "Transformation failed"-      Just files -> mapM_ writePair files-  where-    generateFiles = do-      withTrace "generate files" $ do-        withState (modulesToGraph mods) $ do-          g' <- inferGraphTypes-          withState g' $ do-              maps <- CM.mapM forModule $ refreshModule (graphElements g') <$> mods-              return $ L.concat (M.toList <$> maps)-            where-              refreshModule els mod = mod {-                moduleElements = Y.catMaybes ((\e -> M.lookup (elementName e) els) <$> moduleElements mod)}--    writePair (path, s) = do-      let fullPath = FP.combine basePath path-      SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath-      writeFile fullPath s--    forModule mod = withTrace ("module " ++ unNamespace (moduleNamespace mod)) $ printModule mod--modulesToGraph :: [Module] -> Graph-modulesToGraph mods = elementsToGraph parent (Just schemaGraph) dataElements-  where-    parent = bootstrapGraph-    dataElements = L.concat (moduleElements <$> (L.concat (close <$> mods)))-    schemaElements = L.concat (moduleElements <$> (L.concat (close <$> (L.nub $ L.concat (moduleTypeDependencies <$> mods)))))-    schemaGraph = elementsToGraph bootstrapGraph Nothing schemaElements-    close mod = mod:(L.concat (close <$> moduleTermDependencies mod))--printTrace :: Bool -> Trace -> IO ()-printTrace isError t = do-  CM.unless (L.null $ traceMessages t) $ do-      putStrLn $ if isError then "Flow failed. Messages:" else "Messages:"-      putStrLn $ indentLines $ traceSummary t--runFlow :: s -> Flow s a -> IO (Maybe a)-runFlow cx f = do-    printTrace (Y.isNothing v) t-    return v-  where-    FlowState v _ t = unFlow f cx emptyTrace--writeGraphql :: FP.FilePath -> [Module] -> IO ()-writeGraphql = generateSources moduleToGraphql--writeHaskell :: FilePath -> [Module] -> IO ()-writeHaskell = generateSources moduleToHaskell--writeJava :: FP.FilePath -> [Module] -> IO ()-writeJava = generateSources moduleToJava---- writeJson :: FP.FilePath -> [Module] -> IO ()--- writeJson = generateSources Json.printModule--writePdl :: FP.FilePath -> [Module] -> IO ()-writePdl = generateSources moduleToPdl--writeProtobuf :: FP.FilePath -> [Module] -> IO ()-writeProtobuf = generateSources moduleToProtobuf--writeScala :: FP.FilePath -> [Module] -> IO ()-writeScala = generateSources moduleToScala--writeYaml :: FP.FilePath -> [Module] -> IO ()-writeYaml = generateSources moduleToYaml
− src/main/haskell/Hydra/CoreDecoding.hs 
@@ -1,165 +0,0 @@--- | Decoding of encoded types (as terms) back to types according to LambdaGraph's epsilon encoding--module Hydra.CoreDecoding (-  coreDecodeFieldType,-  coreDecodeFieldTypes,-  coreDecodeFloatType,-  coreDecodeFunctionType,-  coreDecodeIntegerType,-  coreDecodeLambdaType,-  coreDecodeLiteralType,-  coreDecodeMapType,-  coreDecodeName,-  coreDecodeRowType,-  coreDecodeString,-  coreDecodeType,-  ) where--import Hydra.Basics-import Hydra.Strip-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.Graph-import Hydra.Mantle-import Hydra.Module-import Hydra.Lexical-import Hydra.Rewriting-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---coreDecodeApplicationType :: Term -> Flow Graph (ApplicationType)-coreDecodeApplicationType = matchRecord $ \m -> ApplicationType-  <$> getField m _ApplicationType_function coreDecodeType-  <*> getField m _ApplicationType_argument coreDecodeType--coreDecodeFieldType :: Term -> Flow Graph (FieldType)-coreDecodeFieldType = matchRecord $ \m -> FieldType-  <$> getField m _FieldType_name coreDecodeName-  <*> getField m _FieldType_type coreDecodeType--coreDecodeFieldTypes :: Term -> Flow Graph [FieldType]-coreDecodeFieldTypes term = case fullyStripTerm term of-  TermList els -> CM.mapM coreDecodeFieldType els-  _ -> unexpected "list" $ show term--coreDecodeFloatType :: Term -> Flow Graph FloatType-coreDecodeFloatType = matchEnum _FloatType [-  (_FloatType_bigfloat, FloatTypeBigfloat),-  (_FloatType_float32, FloatTypeFloat32),-  (_FloatType_float64, FloatTypeFloat64)]--coreDecodeFunctionType :: Term -> Flow Graph (FunctionType)-coreDecodeFunctionType = matchRecord $ \m -> FunctionType-  <$> getField m _FunctionType_domain coreDecodeType-  <*> getField m _FunctionType_codomain coreDecodeType--coreDecodeIntegerType :: Term -> Flow Graph IntegerType-coreDecodeIntegerType = matchEnum _IntegerType [-  (_IntegerType_bigint, IntegerTypeBigint),-  (_IntegerType_int8, IntegerTypeInt8),-  (_IntegerType_int16, IntegerTypeInt16),-  (_IntegerType_int32, IntegerTypeInt32),-  (_IntegerType_int64, IntegerTypeInt64),-  (_IntegerType_uint8, IntegerTypeUint8),-  (_IntegerType_uint16, IntegerTypeUint16),-  (_IntegerType_uint32, IntegerTypeUint32),-  (_IntegerType_uint64, IntegerTypeUint64)]--coreDecodeLambdaType :: Term -> Flow Graph (LambdaType)-coreDecodeLambdaType = matchRecord $ \m -> LambdaType-  <$> (getField m _LambdaType_parameter coreDecodeName)-  <*> getField m _LambdaType_body coreDecodeType--coreDecodeLiteralType :: Term -> Flow Graph LiteralType-coreDecodeLiteralType = matchUnion _LiteralType [-  matchUnitField _LiteralType_binary LiteralTypeBinary,-  matchUnitField _LiteralType_boolean LiteralTypeBoolean,-  (_LiteralType_float, fmap LiteralTypeFloat . coreDecodeFloatType),-  (_LiteralType_integer, fmap LiteralTypeInteger . coreDecodeIntegerType),-  matchUnitField _LiteralType_string LiteralTypeString]--coreDecodeMapType :: Term -> Flow Graph (MapType)-coreDecodeMapType = matchRecord $ \m -> MapType-  <$> getField m _MapType_keys coreDecodeType-  <*> getField m _MapType_values coreDecodeType--coreDecodeName :: Term -> Flow Graph Name-coreDecodeName term = Name <$> (Expect.wrap _Name term >>= Expect.string)--coreDecodeWrappedType :: Term -> Flow Graph WrappedType-coreDecodeWrappedType term = do-  fields <- Expect.recordWithName _WrappedType term-  name <- Expect.field _WrappedType_typeName coreDecodeName fields-  obj <- Expect.field _WrappedType_object coreDecodeType fields-  pure $ WrappedType name obj--coreDecodeRowType :: Term -> Flow Graph (RowType)-coreDecodeRowType = matchRecord $ \m -> RowType-  <$> getField m _RowType_typeName coreDecodeName-  <*> getField m _RowType_fields coreDecodeFieldTypes--coreDecodeString :: Term -> Flow Graph String-coreDecodeString = Expect.string . fullyStripTerm--coreDecodeType :: Term -> Flow Graph Type-coreDecodeType dat = case dat of-  TermAnnotated (AnnotatedTerm term ann) -> (\t -> TypeAnnotated $ AnnotatedType t ann) <$> coreDecodeType term-  TermTyped (TypedTerm term _) -> coreDecodeType term-  _ -> matchUnion _Type [---    (_Type_annotated, fmap TypeAnnotated . coreDecodeAnnotated),-    (_Type_application, fmap TypeApplication . coreDecodeApplicationType),-    (_Type_function, fmap TypeFunction . coreDecodeFunctionType),-    (_Type_lambda, fmap TypeLambda . coreDecodeLambdaType),-    (_Type_list, fmap TypeList . coreDecodeType),-    (_Type_literal, fmap TypeLiteral . coreDecodeLiteralType),-    (_Type_map, fmap TypeMap . coreDecodeMapType),-    (_Type_optional, fmap TypeOptional . coreDecodeType),-    (_Type_product, \l -> do-      types <- Expect.list pure l-      TypeProduct <$> (CM.mapM coreDecodeType types)),-    (_Type_record, fmap TypeRecord . coreDecodeRowType),-    (_Type_set, fmap TypeSet . coreDecodeType),-    (_Type_sum, \(TermList types) -> TypeSum <$> (CM.mapM coreDecodeType types)),-    (_Type_union, fmap TypeUnion . coreDecodeRowType),-    (_Type_variable, fmap TypeVariable . coreDecodeName),-    (_Type_wrap, fmap TypeWrap . (coreDecodeWrappedType))] dat--getField :: M.Map Name (Term) -> Name -> (Term -> Flow Graph b) -> Flow Graph b-getField m fname decode = case M.lookup fname m of-  Nothing -> fail $ "expected field " ++ show fname ++ " not found"-  Just val -> decode val--matchEnum :: Name -> [(Name, b)] -> Term -> Flow Graph b-matchEnum tname = matchUnion tname . fmap (uncurry matchUnitField)--matchRecord :: (M.Map Name (Term) -> Flow Graph b) -> Term -> Flow Graph b-matchRecord decode term = case fullyStripTerm term of-  TermRecord (Record _ fields) -> decode $ M.fromList $ fmap (\(Field fname val) -> (fname, val)) fields-  _ -> unexpected "record" $ show term--matchUnion :: Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b-matchUnion tname pairs term = case fullyStripTerm term of-    TermVariable name -> do-      el <- requireElement name-      matchUnion tname pairs (elementData el)-    TermUnion (Injection tname' (Field fname val)) -> if tname' == tname-      then case M.lookup fname mapping of-        Nothing -> fail $ "no matching case for field " ++ show fname-        Just f -> f val-      else unexpected ("injection for type " ++ show tname) $ show term-    t -> unexpected ("union with one of {" ++ L.intercalate ", " (unName . fst <$> pairs) ++ "}") $ show t-  where-    mapping = M.fromList pairs--matchUnitField :: Name -> y -> (Name, x -> Flow Graph y)-matchUnitField fname x = (fname, \_ -> pure x)
+ src/main/haskell/Hydra/Dsl/Accessors.hs view
@@ -0,0 +1,103 @@+module Hydra.Dsl.Accessors where++import Hydra.Kernel+import Hydra.Dsl.Phantoms+import Hydra.Accessors++import qualified Data.Map as M+import qualified Data.Maybe as Y+++accessorEdge :: TTerm AccessorNode -> TTerm AccessorPath -> TTerm AccessorNode -> TTerm AccessorEdge+accessorEdge source path target = record _AccessorEdge [+  _AccessorEdge_source>>: source,+  _AccessorEdge_path>>: path,+  _AccessorEdge_target>>: target]++accessorEdgeSource = unitVariant _AccessorEdge _AccessorEdge_source+accessorEdgePath = unitVariant _AccessorEdge _AccessorEdge_path+accessorEdgeTarget = unitVariant _AccessorEdge _AccessorEdge_target++accessorGraph :: TTerm [AccessorNode] -> TTerm [AccessorEdge] -> TTerm AccessorGraph+accessorGraph nodes edges = record _AccessorGraph [+  _AccessorGraph_nodes>>: nodes,+  _AccessorGraph_edges>>: edges]++accessorGraphNodes = unitVariant _AccessorGraph _AccessorGraph_nodes+accessorGraphEdges = unitVariant _AccessorGraph _AccessorGraph_edges++accessorNode :: TTerm Name -> TTerm String -> TTerm String -> TTerm AccessorNode+accessorNode name label id = record _AccessorNode [+  _AccessorNode_name>>: name,+  _AccessorNode_label>>: label,+  _AccessorNode_id>>: id]++accessorNodeName = unitVariant _AccessorNode _AccessorNode_name+accessorNodeLabel = unitVariant _AccessorNode _AccessorNode_label+accessorNodeId = unitVariant _AccessorNode _AccessorNode_id++accessorPath :: TTerm [TermAccessor] -> TTerm AccessorPath+accessorPath path = wrap _AccessorPath path++termAccessorAnnotatedSubject :: TTerm TermAccessor+termAccessorAnnotatedSubject = unitVariant _TermAccessor _TermAccessor_annotatedSubject++termAccessorApplicationFunction :: TTerm TermAccessor+termAccessorApplicationFunction = unitVariant _TermAccessor _TermAccessor_applicationFunction++termAccessorApplicationArgument :: TTerm TermAccessor+termAccessorApplicationArgument = unitVariant _TermAccessor _TermAccessor_applicationArgument++termAccessorLambdaBody :: TTerm TermAccessor+termAccessorLambdaBody = unitVariant _TermAccessor _TermAccessor_lambdaBody++termAccessorUnionCasesDefault :: TTerm TermAccessor+termAccessorUnionCasesDefault = unitVariant _TermAccessor _TermAccessor_unionCasesDefault++termAccessorUnionCasesBranch :: TTerm Name -> TTerm TermAccessor+termAccessorUnionCasesBranch = variant _TermAccessor _TermAccessor_unionCasesBranch++termAccessorLetEnvironment :: TTerm TermAccessor+termAccessorLetEnvironment = unitVariant _TermAccessor _TermAccessor_letEnvironment++termAccessorLetBinding :: TTerm Name -> TTerm TermAccessor+termAccessorLetBinding = variant _TermAccessor _TermAccessor_letBinding++termAccessorListElement :: TTerm Int -> TTerm TermAccessor+termAccessorListElement = variant _TermAccessor _TermAccessor_listElement++termAccessorMapKey :: TTerm Int -> TTerm TermAccessor+termAccessorMapKey = variant _TermAccessor _TermAccessor_mapKey++termAccessorMapValue :: TTerm Int -> TTerm TermAccessor+termAccessorMapValue = variant _TermAccessor _TermAccessor_mapValue++termAccessorOptionalTerm :: TTerm TermAccessor+termAccessorOptionalTerm = unitVariant _TermAccessor _TermAccessor_optionalTerm++termAccessorProductTerm :: TTerm Int -> TTerm TermAccessor+termAccessorProductTerm = variant _TermAccessor _TermAccessor_productTerm++termAccessorRecordField :: TTerm Name -> TTerm TermAccessor+termAccessorRecordField = variant _TermAccessor _TermAccessor_recordField++termAccessorSetElement :: TTerm Int -> TTerm TermAccessor+termAccessorSetElement = variant _TermAccessor _TermAccessor_setElement++termAccessorSumTerm :: TTerm TermAccessor+termAccessorSumTerm = unitVariant _TermAccessor _TermAccessor_sumTerm++termAccessorTypeLambdaBody :: TTerm TermAccessor+termAccessorTypeLambdaBody = unitVariant _TermAccessor _TermAccessor_typeLambdaBody++termAccessorTypeApplicationTerm :: TTerm TermAccessor+termAccessorTypeApplicationTerm = unitVariant _TermAccessor _TermAccessor_typeApplicationTerm++termAccessorInjectionTerm :: TTerm TermAccessor+termAccessorInjectionTerm = unitVariant _TermAccessor _TermAccessor_injectionTerm++termAccessorWrappedTerm :: TTerm TermAccessor+termAccessorWrappedTerm = unitVariant _TermAccessor _TermAccessor_wrappedTerm++unAccessorPath :: TTerm AccessorPath -> TTerm [TermAccessor]+unAccessorPath path = unwrap _AccessorPath @@ path
src/main/haskell/Hydra/Dsl/Annotations.hs view
@@ -4,8 +4,9 @@  import Hydra.Core import Hydra.Compute+import Hydra.Constants import Hydra.Annotations-import Hydra.Tools.Formatting+import Hydra.Formatting import Hydra.Dsl.Terms as Terms import qualified Hydra.Dsl.Types as Types @@ -13,11 +14,6 @@ import qualified Data.Maybe as Y  -key_deprecated = Name "_deprecated"-key_maxLength = Name "_maxLength"-key_minLength = Name "_minLength"-key_preserveFieldName = Name "_preserveFieldName"- annotateTerm :: Name -> Y.Maybe Term -> Term -> Term annotateTerm = setTermAnnotation @@ -33,6 +29,9 @@ boundedList :: Maybe Int -> Maybe Int -> Type -> Type boundedList min max et = bounded min max $ Types.list et +boundedMap :: Maybe Int -> Maybe Int -> Type -> Type -> Type+boundedMap min max kt vt = bounded min max $ Types.map kt vt+ boundedSet :: Maybe Int -> Maybe Int -> Type -> Type boundedSet min max et = bounded min max $ Types.set et @@ -54,11 +53,17 @@ dataDoc :: String -> Term -> Term dataDoc s = setTermDescription (Just s) +exclude :: Type -> Type+exclude = setTypeAnnotation key_exclude $ Just $ Terms.boolean True+ minLengthList :: Int -> Type -> Type minLengthList len = boundedList (Just len) Nothing  nonemptyList :: Type -> Type nonemptyList = minLengthList 1++nonemptyMap :: Type -> Type -> Type+nonemptyMap = boundedMap (Just 1) Nothing  note :: String -> Type -> Type note s = doc $ "Note: " ++ s
+ src/main/haskell/Hydra/Dsl/Ast.hs view
@@ -0,0 +1,189 @@+module Hydra.Dsl.Ast where++import Hydra.Kernel+import Hydra.Dsl.Phantoms+import Hydra.Ast++import qualified Data.Map as M+import qualified Data.Int as I+++-- Associativity++associativityNone :: TTerm Associativity+associativityNone = unitVariant _Associativity _Associativity_none++associativityLeft :: TTerm Associativity+associativityLeft = unitVariant _Associativity _Associativity_left++associativityRight :: TTerm Associativity+associativityRight = unitVariant _Associativity _Associativity_right++associativityBoth :: TTerm Associativity+associativityBoth = unitVariant _Associativity _Associativity_both++-- BlockStyle++blockStyle :: TTerm (Maybe String) -> TTerm Bool -> TTerm Bool -> TTerm BlockStyle+blockStyle indent newlineBefore newlineAfter = record _BlockStyle [+    _BlockStyle_indent >>: indent,+    _BlockStyle_newlineBeforeContent >>: newlineBefore,+    _BlockStyle_newlineAfterContent >>: newlineAfter]++blockStyleIndent :: TTerm BlockStyle -> TTerm (Maybe String)+blockStyleIndent bs = project _BlockStyle _BlockStyle_indent @@ bs++blockStyleNewlineBeforeContent :: TTerm BlockStyle -> TTerm Bool+blockStyleNewlineBeforeContent bs = project _BlockStyle _BlockStyle_newlineBeforeContent @@ bs++blockStyleNewlineAfterContent :: TTerm BlockStyle -> TTerm Bool+blockStyleNewlineAfterContent bs = project _BlockStyle _BlockStyle_newlineAfterContent @@ bs++-- BracketExpr++bracketExpr :: TTerm Brackets -> TTerm Expr -> TTerm BlockStyle -> TTerm BracketExpr+bracketExpr brackets enclosed style = record _BracketExpr [+    _BracketExpr_brackets >>: brackets,+    _BracketExpr_enclosed >>: enclosed,+    _BracketExpr_style >>: style]++bracketExprBrackets :: TTerm BracketExpr -> TTerm Brackets+bracketExprBrackets be = project _BracketExpr _BracketExpr_brackets @@ be++bracketExprEnclosed :: TTerm BracketExpr -> TTerm Expr+bracketExprEnclosed be = project _BracketExpr _BracketExpr_enclosed @@ be++bracketExprStyle :: TTerm BracketExpr -> TTerm BlockStyle+bracketExprStyle be = project _BracketExpr _BracketExpr_style @@ be++-- Brackets++brackets :: TTerm Symbol -> TTerm Symbol -> TTerm Brackets+brackets open close = record _Brackets [+    _Brackets_open >>: open,+    _Brackets_close >>: close]++bracketsOpen :: TTerm Brackets -> TTerm Symbol+bracketsOpen b = project _Brackets _Brackets_open @@ b++bracketsClose :: TTerm Brackets -> TTerm Symbol+bracketsClose b = project _Brackets _Brackets_close @@ b++-- Expr (sum type)++exprConst :: TTerm Symbol -> TTerm Expr+exprConst sym = variant _Expr _Expr_const sym++exprIndent :: TTerm IndentedExpression -> TTerm Expr+exprIndent ind = variant _Expr _Expr_indent ind++exprOp :: TTerm OpExpr -> TTerm Expr+exprOp op = variant _Expr _Expr_op op++exprBrackets :: TTerm BracketExpr -> TTerm Expr+exprBrackets be = variant _Expr _Expr_brackets be++-- IndentedExpression++indentedExpression :: TTerm IndentStyle -> TTerm Expr -> TTerm IndentedExpression+indentedExpression style expr = record _IndentedExpression [+    _IndentedExpression_style >>: style,+    _IndentedExpression_expr >>: expr]++indentedExpressionStyle :: TTerm IndentedExpression -> TTerm IndentStyle+indentedExpressionStyle ie = project _IndentedExpression _IndentedExpression_style @@ ie++indentedExpressionExpr :: TTerm IndentedExpression -> TTerm Expr+indentedExpressionExpr ie = project _IndentedExpression _IndentedExpression_expr @@ ie++-- IndentStyle (sum type)++indentStyleAllLines :: TTerm String -> TTerm IndentStyle+indentStyleAllLines s = variant _IndentStyle _IndentStyle_allLines s++indentStyleSubsequentLines :: TTerm String -> TTerm IndentStyle+indentStyleSubsequentLines s = variant _IndentStyle _IndentStyle_subsequentLines s++-- Op++op :: TTerm Symbol -> TTerm Padding -> TTerm Precedence -> TTerm Associativity -> TTerm Op+op symbol padding precedence associativity = record _Op [+    _Op_symbol >>: symbol,+    _Op_padding >>: padding,+    _Op_precedence >>: precedence,+    _Op_associativity >>: associativity]++opSymbol :: TTerm Op -> TTerm Symbol+opSymbol o = project _Op _Op_symbol @@ o++opPadding :: TTerm Op -> TTerm Padding+opPadding o = project _Op _Op_padding @@ o++opPrecedence :: TTerm Op -> TTerm Precedence+opPrecedence o = project _Op _Op_precedence @@ o++opAssociativity :: TTerm Op -> TTerm Associativity+opAssociativity o = project _Op _Op_associativity @@ o++-- OpExpr++opExpr :: TTerm Op -> TTerm Expr -> TTerm Expr -> TTerm OpExpr+opExpr op lhs rhs = record _OpExpr [+    _OpExpr_op >>: op,+    _OpExpr_lhs >>: lhs,+    _OpExpr_rhs >>: rhs]++opExprOp :: TTerm OpExpr -> TTerm Op+opExprOp oe = project _OpExpr _OpExpr_op @@ oe++opExprLhs :: TTerm OpExpr -> TTerm Expr+opExprLhs oe = project _OpExpr _OpExpr_lhs @@ oe++opExprRhs :: TTerm OpExpr -> TTerm Expr+opExprRhs oe = project _OpExpr _OpExpr_rhs @@ oe++-- Padding++padding :: TTerm Ws -> TTerm Ws -> TTerm Padding+padding left right = record _Padding [+    _Padding_left >>: left,+    _Padding_right >>: right]++paddingLeft :: TTerm Padding -> TTerm Ws+paddingLeft p = project _Padding _Padding_left @@ p++paddingRight :: TTerm Padding -> TTerm Ws+paddingRight p = project _Padding _Padding_right @@ p++-- Precedence (newtype wrapping Int)++precedence :: TTerm I.Int -> TTerm Precedence+precedence = wrap _Precedence++unPrecedence :: TTerm Precedence -> TTerm I.Int+unPrecedence p = unwrap _Precedence @@ p++-- Symbol (newtype wrapping String)++symbol :: TTerm String -> TTerm Symbol+symbol = wrap _Symbol++unSymbol :: TTerm Symbol -> TTerm String+unSymbol s = unwrap _Symbol @@ s++-- Ws (sum type)++wsNone :: TTerm Ws+wsNone = unitVariant _Ws _Ws_none++wsSpace :: TTerm Ws+wsSpace = unitVariant _Ws _Ws_space++wsBreak :: TTerm Ws+wsBreak = unitVariant _Ws _Ws_break++wsBreakAndIndent :: TTerm String -> TTerm Ws+wsBreakAndIndent s = variant _Ws _Ws_breakAndIndent s++wsDoubleBreak :: TTerm Ws+wsDoubleBreak = unitVariant _Ws _Ws_doubleBreak
− src/main/haskell/Hydra/Dsl/Base.hs 
@@ -1,224 +0,0 @@--- | Base DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions.--module Hydra.Dsl.Base (-  module Hydra.Dsl.Base,-  module Hydra.Dsl.PhantomLiterals,-  module Hydra.Dsl.ShorthandTypes,-  hydraCore,-) where--import Hydra.Coders-import Hydra.Core-import Hydra.Compute-import Hydra.Graph-import Hydra.Annotations-import Hydra.Phantoms-import Hydra.Module-import qualified Hydra.Tier1 as Tier1-import Hydra.Dsl.PhantomLiterals-import Hydra.Dsl.ShorthandTypes-import Hydra.Sources.Core-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types-import qualified Hydra.Dsl.Lib.Lists as Lists-import Hydra.Sources.Libraries--import Prelude hiding ((++))-import Data.String(IsString(..))--import qualified Data.Map as M-import qualified Data.Set as S---instance IsString (TTerm a) where fromString = TTerm . Terms.string--infixr 0 >:-(>:) :: String -> TTerm a -> Field-n >: d = Field (Name n) (unTTerm d)--infixr 0 >>:-(>>:) :: Name -> TTerm a -> Field-fname >>: d = Field fname (unTTerm d)--(<.>) :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)-f <.> g = compose f g---- Two alternative symbols for typed term application-(@@) :: TTerm (a -> b) -> TTerm a -> TTerm b-f @@ x = apply f x-($$) :: TTerm (a -> b) -> TTerm a -> TTerm b-f $$ x = apply f x--infixr 0 @->-(@->) :: a -> b -> (a, b)-x @-> y = (x, y)--infixr 0 -->-(-->) :: TCase a -> TTerm (a -> b) -> Field-c --> t = caseField c t--apply :: TTerm (a -> b) -> TTerm a -> TTerm b-apply (TTerm lhs) (TTerm rhs) = TTerm $ Terms.apply lhs rhs--apply2 :: TTerm (a -> b -> c) -> TTerm a -> TTerm b -> TTerm c-apply2 (TTerm f) (TTerm a1) (TTerm a2) = TTerm $ Terms.apply (Terms.apply f a1) a2--caseField :: TCase a -> TTerm (a -> b) -> Field-caseField (TCase fname) (TTerm f) = Field fname f--compose :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)-compose (TTerm f) (TTerm g) = TTerm $ Terms.compose f g--constant :: TTerm a -> TTerm (b -> a)-constant (TTerm term) = TTerm $ Terms.constant term--definitionInModule :: Module -> String -> TTerm a -> TElement a-definitionInModule mod lname = TElement $ Tier1.unqualifyName $ QualifiedName (Just $ moduleNamespace mod) lname--doc :: String -> TTerm a -> TTerm a-doc s (TTerm term) = TTerm $ setTermDescription (Just s) term--doc70 :: String -> TTerm a -> TTerm a-doc70 = doc . wrapLine 70--doc80 :: String -> TTerm a -> TTerm a-doc80 = doc . wrapLine 80--el :: TElement a -> Element-el (TElement name (TTerm term)) = Element name term--field :: Name -> TTerm a -> Field-field fname (TTerm val) = Field fname val--first :: TTerm ((a, b) -> a)-first = TTerm $ Terms.untuple 2 0--fld :: Name -> TTerm a -> TField a-fld fname (TTerm val) = TField $ Field fname val--fold :: TTerm (b -> a -> b) -> TTerm (b -> [a] -> b)-fold f = Lists.foldl @@ f--function :: Type -> Type -> TTerm a -> TTerm a-function dom cod = typed (Types.function dom cod)--functionN :: [Type] -> TTerm a -> TTerm a-functionN ts = typed $ Types.functionN ts--functionNWithClasses :: [Type] -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a-functionNWithClasses ts classes = typed $ setTypeClasses classes (Types.functionN ts)--functionWithClasses :: Type -> Type -> M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a-functionWithClasses dom cod classes = typed $ setTypeClasses classes (Types.function dom cod)---- Note: Haskell has trouble type-checking this construction if the convenience functions from Base are used-ifElse :: TTerm Bool -> TTerm a -> TTerm a -> TTerm a-ifElse (TTerm cond) (TTerm ifTrue) (TTerm ifFalse) = TTerm $-  Terms.apply (Terms.apply (Terms.apply (Terms.primitive _logic_ifElse) ifTrue) ifFalse) cond--ifOpt :: TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b-ifOpt m n j = matchOpt n j @@ m--identity :: TTerm (a -> a)-identity = TTerm Terms.identity--inject :: Name -> Name -> TTerm a -> TTerm b-inject name fname (TTerm term) = TTerm $ Terms.inject name (Field fname term)--inject2 :: Name -> Name -> TTerm (a -> b)-inject2 name fname = lambda "x2" $ inject name fname $ var "x2"--just :: TTerm x -> TTerm (Maybe x)-just (TTerm term) = TTerm $ Terms.just term--lambda :: String -> TTerm x -> TTerm (a -> b)-lambda v (TTerm body) = TTerm $ Terms.lambda v body----letTerm :: Var a -> TTerm a -> TTerm b -> TTerm b---letTerm (Var k) (TTerm v) (TTerm env) = TTerm $ Terms.letTerm (Name k) v env--list :: [TTerm a] -> TTerm [a]-list els = TTerm $ Terms.list (unTTerm <$> els)--map :: M.Map (TTerm a) (TTerm b) -> TTerm (M.Map a b)-map = TTerm . Terms.map . M.fromList . fmap fromTTerm . M.toList-  where-    fromTTerm (TTerm k, TTerm v) = (k, v)--match :: Name -> Maybe (TTerm b) -> [Field] -> TTerm (u -> b)-match name dflt fields = TTerm $ Terms.match name (unTTerm <$> dflt) fields--matchData :: Name -> Maybe (TTerm b) -> [(Name, TTerm (x -> b))] -> TTerm (a -> b)-matchData name dflt pairs = TTerm $ Terms.match name (unTTerm <$> dflt) (toField <$> pairs)-  where-    toField (fname, TTerm term) = Field fname term--matchOpt :: TTerm b -> TTerm (a -> b) -> TTerm (Maybe a -> b)-matchOpt (TTerm n) (TTerm j) = TTerm $ Terms.matchOpt n j--matchToEnum :: Name -> Name -> Maybe (TTerm b) -> [(Name, Name)] -> TTerm (a -> b)-matchToEnum domName codName dflt pairs = matchData domName dflt (toCase <$> pairs)-  where-    toCase (fromName, toName) = (fromName, constant $ unitVariant codName toName)--matchToUnion :: Name -> Name -> Maybe (TTerm b) -> [(Name, Field)] -> TTerm (a -> b)-matchToUnion domName codName dflt pairs = matchData domName dflt (toCase <$> pairs)-  where-    toCase (fromName, fld) = (fromName, constant $ TTerm $ Terms.inject codName fld)---- Note: the phantom types provide no guarantee of type safety in this case-nom :: Name -> TTerm a -> TTerm b-nom name (TTerm term) = TTerm $ Terms.wrap name term--nothing :: TTerm a-nothing = TTerm Terms.nothing--opt :: Maybe (TTerm a) -> TTerm (Maybe a)-opt mc = TTerm $ Terms.optional (unTTerm <$> mc)--pair :: (TTerm a) -> (TTerm b) -> TTerm (a, b)-pair (TTerm l) (TTerm r) = TTerm $ Terms.pair l r--primitive :: Name -> TTerm a-primitive = TTerm . Terms.primitive--project :: Name -> Name -> TTerm (a -> b)-project name fname = TTerm $ Terms.project name fname--record :: Name -> [Field] -> TTerm a-record name fields = TTerm $ Terms.record name fields--ref :: TElement a -> TTerm a-ref (TElement name _) = TTerm (TermVariable name)--second :: TTerm ((a, b) -> b)-second = TTerm $ Terms.untuple 2 1--set :: S.Set (TTerm a) -> TTerm (S.Set a)-set = TTerm . Terms.set . S.fromList . fmap unTTerm . S.toList--typed :: Type -> TTerm a -> TTerm a-typed typ (TTerm term) = TTerm $ setTermType (Just typ) term--unit :: TTerm a-unit = TTerm Terms.unit--unitVariant :: Name -> Name -> TTerm a-unitVariant name fname = TTerm $ Terms.inject name $ Field fname Terms.unit--unwrap :: Name -> TTerm (a -> b)-unwrap = TTerm . Terms.unwrap--var :: String -> TTerm a-var v = TTerm $ Terms.var v--variant :: Name -> Name -> TTerm a -> TTerm b-variant name fname (TTerm term) = TTerm $ Terms.inject name $ Field fname term--with :: TTerm a -> [Field] -> TTerm a-(TTerm env) `with` fields = TTerm $ TermLet $ Let (toBinding <$> fields) env-  where-     toBinding (Field name value) = LetBinding name value Nothing--wrap :: Name -> TTerm a -> TTerm b-wrap name (TTerm term) = TTerm $ Terms.wrap name term
src/main/haskell/Hydra/Dsl/Bootstrap.hs view
@@ -5,8 +5,9 @@ import Hydra.Compute import Hydra.Constants import Hydra.Core-import Hydra.CoreEncoding+import qualified Hydra.Encode.Core as EncodeCore import Hydra.Graph+import Hydra.Lexical import Hydra.Annotations import Hydra.Module import Hydra.Rewriting@@ -20,17 +21,11 @@ import qualified Data.Set as S  --- | An empty graph (no elements, no primitives, but an annotation class) which is used for bootstrapping Hydra Core+-- | An empty graph (no elements, no schema, but with primitive functions) which is used for bootstrapping Hydra Core bootstrapGraph :: Graph-bootstrapGraph = Graph {-  graphElements = M.empty,-  graphEnvironment = M.empty,-  graphTypes = M.empty,-  graphBody = Terms.list [], -- Note: the bootstrap body is arbitrary-  graphPrimitives = M.fromList $ fmap (\p -> (primitiveName p, p)) (L.concat (libraryPrimitives <$> standardLibraries)),-  graphSchema = Nothing}+bootstrapGraph = emptyGraph {graphPrimitives = M.fromList $ fmap (\p -> (primitiveName p, p)) (L.concat (libraryPrimitives <$> standardLibraries))} -datatype :: Namespace -> String -> Type -> Element+datatype :: Namespace -> String -> Type -> Binding datatype gname lname typ = typeElement elName $ rewriteType replacePlaceholders typ   where     elName = qualify gname (Name lname)@@ -50,17 +45,8 @@       where         rect = rec t -typeref :: Namespace -> String -> Type-typeref ns = TypeVariable . qualify ns . Name- qualify :: Namespace -> Name -> Name qualify (Namespace gname) (Name lname) = Name $ gname ++ "." ++ lname -typeElement :: Name -> Type -> Element-typeElement name typ = Element {-    elementName = name,-    elementData = dataTerm}-  where-    -- These type annotations allow type inference to proceed despite cyclic type definitions, e.g. in Hydra Core-    dataTerm = normalizeTermAnnotations $ TermAnnotated $ AnnotatedTerm (coreEncodeType typ) $ M.fromList [(key_type, schemaTerm)]-    schemaTerm = TermVariable _Type+typeref :: Namespace -> String -> Type+typeref ns = TypeVariable . qualify ns . Name
+ src/main/haskell/Hydra/Dsl/Coders.hs view
@@ -0,0 +1,105 @@+module Hydra.Dsl.Coders where++import Hydra.Kernel+import Hydra.Dsl.Phantoms as Phantoms+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Lib.Sets as Sets+import Hydra.Dsl.Mantle as Mantle+import qualified Hydra.Dsl.TTypes as T++import qualified Data.Map as M+import qualified Data.Set as S+++adapterContext :: TTerm Graph -> TTerm Language -> TTerm (M.Map Name (Adapter AdapterContext AdapterContext Type Type Term Term)) -> TTerm AdapterContext+adapterContext graph language adapters = Phantoms.record _AdapterContext [+  _AdapterContext_graph>>: graph,+  _AdapterContext_language>>: language,+  _AdapterContext_adapters>>: adapters]++adapterContextGraph :: TTerm AdapterContext -> TTerm Graph+adapterContextGraph c = project _AdapterContext _AdapterContext_graph @@ c++adapterContextLanguage :: TTerm AdapterContext -> TTerm Language+adapterContextLanguage c = project _AdapterContext _AdapterContext_language @@ c++adapterContextAdapters :: TTerm AdapterContext -> TTerm (M.Map Name (Adapter AdapterContext AdapterContext Type Type Term Term))+adapterContextAdapters c = project _AdapterContext _AdapterContext_adapters @@ c++coderDirectionEncode :: TTerm CoderDirection+coderDirectionEncode = unitVariant _CoderDirection _CoderDirection_encode++coderDirectionDecode :: TTerm CoderDirection+coderDirectionDecode = unitVariant _CoderDirection _CoderDirection_decode++language :: TTerm LanguageName -> TTerm LanguageConstraints -> TTerm Language+language name constraints = record _Language [+    _Language_name>>: name,+    _Language_constraints>>: constraints]++languageName :: TTerm String -> TTerm LanguageName+languageName = wrap _LanguageName++unLanguageName :: TTerm LanguageName -> TTerm String+unLanguageName n = unwrap _LanguageName @@ n++-- TODO: resolve _Language_name/_LanguageName conflict+languageNameProjection :: TTerm Language -> TTerm LanguageName+languageNameProjection c = project _Language _Language_name @@ c++-- TODO: resolve _Language_constraints/LanguageConstraints conflict+languageConstraintsProjection :: TTerm Language -> TTerm LanguageConstraints+languageConstraintsProjection c = project _Language _Language_constraints @@ c++languageConstraints :: TTerm (S.Set EliminationVariant)+                    -> TTerm (S.Set LiteralVariant)+                    -> TTerm (S.Set FloatType)+                    -> TTerm (S.Set FunctionVariant)+                    -> TTerm (S.Set IntegerType)+                    -> TTerm (S.Set TermVariant)+                    -> TTerm (S.Set TypeVariant)+                    -> TTerm (Type -> Bool)+                    -> TTerm LanguageConstraints+languageConstraints eliminationVariants+                    literalVariants+                    floatTypes+                    functionVariants+                    integerTypes+                    termVariants+                    typeVariants+                    types = record _LanguageConstraints [+    _LanguageConstraints_eliminationVariants>>: eliminationVariants,+    _LanguageConstraints_literalVariants>>: literalVariants,+    _LanguageConstraints_floatTypes>>: floatTypes,+    _LanguageConstraints_functionVariants>>: functionVariants,+    _LanguageConstraints_integerTypes>>: integerTypes,+    _LanguageConstraints_termVariants>>: termVariants,+    _LanguageConstraints_typeVariants>>: typeVariants,+    _LanguageConstraints_types>>: types]++languageConstraintsEliminationVariants :: TTerm LanguageConstraints -> TTerm (S.Set EliminationVariant)+languageConstraintsEliminationVariants lc = project _LanguageConstraints _LanguageConstraints_eliminationVariants @@ lc++languageConstraintsLiteralVariants :: TTerm LanguageConstraints -> TTerm (S.Set LiteralVariant)+languageConstraintsLiteralVariants lc = project _LanguageConstraints _LanguageConstraints_literalVariants @@ lc++languageConstraintsFloatTypes :: TTerm LanguageConstraints -> TTerm (S.Set FloatType)+languageConstraintsFloatTypes lc = project _LanguageConstraints _LanguageConstraints_floatTypes @@ lc++languageConstraintsFunctionVariants :: TTerm LanguageConstraints -> TTerm (S.Set FunctionVariant)+languageConstraintsFunctionVariants lc = project _LanguageConstraints _LanguageConstraints_functionVariants @@ lc++languageConstraintsIntegerTypes :: TTerm LanguageConstraints -> TTerm (S.Set IntegerType)+languageConstraintsIntegerTypes lc = project _LanguageConstraints _LanguageConstraints_integerTypes @@ lc++languageConstraintsTermVariants :: TTerm LanguageConstraints -> TTerm (S.Set TermVariant)+languageConstraintsTermVariants lc = project _LanguageConstraints _LanguageConstraints_termVariants @@ lc++languageConstraintsTypeVariants :: TTerm LanguageConstraints -> TTerm (S.Set TypeVariant)+languageConstraintsTypeVariants lc = project _LanguageConstraints _LanguageConstraints_typeVariants @@ lc++languageConstraintsTypes :: TTerm LanguageConstraints -> TTerm (Type -> Bool)+languageConstraintsTypes lc = project _LanguageConstraints _LanguageConstraints_types @@ lc++traversalOrderPre = unitVariant _TraversalOrder _TraversalOrder_pre+traversalOrderPost = unitVariant _TraversalOrder _TraversalOrder_post
+ src/main/haskell/Hydra/Dsl/Common.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleInstances #-}++module Hydra.Dsl.Common where++import Hydra.Core+import Hydra.Phantoms++import Data.String(IsString(..))+++instance IsString Type where fromString = TypeVariable . Name+instance IsString Term where fromString = TermLiteral . LiteralString+instance IsString (TTerm a) where fromString = TTerm . TermLiteral . LiteralString
+ src/main/haskell/Hydra/Dsl/Compute.hs view
@@ -0,0 +1,95 @@+module Hydra.Dsl.Compute where++import Hydra.Kernel+import Hydra.Dsl.Phantoms+import qualified Hydra.Dsl.Core as Core++import qualified Data.Map as M+import qualified Data.Maybe as Y+++adapter :: TTerm Bool -> TTerm t1 -> TTerm t2 -> TTerm (Coder s1 s2 v1 v2) -> TTerm (Adapter s1 s2 t1 t2 v1 v2)+adapter isLossy source target coder = record _Adapter [+  _Adapter_isLossy>>: isLossy,+  _Adapter_source>>: source,+  _Adapter_target>>: target,+  _Adapter_coder>>: coder]++adapterIsLossy :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm Bool+adapterIsLossy a = project _Adapter _Adapter_isLossy @@ a++adapterSource :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm t1+adapterSource a = project _Adapter _Adapter_source @@ a++adapterTarget :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm t2+adapterTarget a = project _Adapter _Adapter_target @@ a++adapterCoder :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm (Coder s1 s2 v1 v2)+adapterCoder a = project _Adapter _Adapter_coder @@ a++adapterWithCoder :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm (Coder s1 s2 v1 v2) -> TTerm (Adapter s1 s2 t1 t2 v1 v2)+adapterWithCoder a coder = adapter+  (Hydra.Dsl.Compute.adapterIsLossy a)+  (Hydra.Dsl.Compute.adapterSource a)+  (Hydra.Dsl.Compute.adapterTarget a)+  coder++adapterWithTarget :: TTerm (Adapter s1 s2 t1 t2 v1 v2) -> TTerm t2 -> TTerm (Adapter s1 s2 t1 t2 v1 v2)+adapterWithTarget a target = adapter+  (Hydra.Dsl.Compute.adapterIsLossy a)+  (Hydra.Dsl.Compute.adapterSource a)+  target+  (Hydra.Dsl.Compute.adapterCoder a)++coder :: TTerm (v1 -> Flow s1 v2) -> TTerm (v2 -> Flow s2 v1) -> TTerm (Coder s1 s2 v1 v2)+coder encode decode = record _Coder [+  _Coder_encode>>: encode,+  _Coder_decode>>: decode]++coderEncode :: TTerm (Coder s1 s2 v1 v2) -> TTerm (v1 -> Flow s1 v2)+coderEncode c = project _Coder _Coder_encode @@ c++coderDecode :: TTerm (Coder s1 s2 v1 v2) -> TTerm (v2 -> Flow s2 v1)+coderDecode c = project _Coder _Coder_decode @@ c++flow :: TTerm (s -> Trace -> FlowState s v) -> TTerm (Flow s v)+flow = wrap _Flow++flowState :: TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)+flowState value state trace = record _FlowState [+  _FlowState_value>>: value,+  _FlowState_state>>: state,+  _FlowState_trace>>: trace]++flowStateState :: TTerm (FlowState s x) -> TTerm s+flowStateState fs = project _FlowState _FlowState_state @@ fs++flowStateTrace :: TTerm (FlowState s x) -> TTerm Trace+flowStateTrace fs = project _FlowState _FlowState_trace @@ fs++flowStateValue :: TTerm (FlowState s x) -> TTerm (Maybe x)+flowStateValue fs = project _FlowState _FlowState_value @@ fs++trace :: TTerm [String] -> TTerm [String] -> TTerm (M.Map Name Term) -> TTerm Trace+trace stack messages other = record _Trace [+  _Trace_stack>>: stack,+  _Trace_messages>>: messages,+  _Trace_other>>: other]++traceStack :: TTerm Trace -> TTerm [String]+traceStack t = project _Trace _Trace_stack @@ t++traceMessages :: TTerm Trace -> TTerm [String]+traceMessages t = project _Trace _Trace_messages @@ t++traceOther :: TTerm Trace -> TTerm (M.Map Name Term)+traceOther t = project _Trace _Trace_other @@ t++traceWithOther :: TTerm Trace -> TTerm (M.Map Name Term) -> TTerm Trace+traceWithOther t other = record _Trace [+  _Trace_stack>>: Hydra.Dsl.Compute.traceStack t,+  _Trace_messages>>: Hydra.Dsl.Compute.traceMessages t,+  _Trace_other>>: other]++unFlow :: TTerm (Flow s x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)+unFlow f s t = unwrap _Flow @@ f @@ s @@ t
src/main/haskell/Hydra/Dsl/Core.hs view
@@ -1,160 +1,270 @@ module Hydra.Dsl.Core where  import Hydra.Kernel-import Hydra.Dsl.Base as Base+import Hydra.Dsl.Phantoms as Phantoms+import qualified Hydra.Dsl.Terms as Terms +-- For helpers+import qualified Hydra.Dsl.Lib.Equality as Equality+import qualified Hydra.Dsl.Lib.Lists as Lists+import qualified Hydra.Dsl.Lib.Logic as Logic+import Hydra.Sources.Libraries+ import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Maybe as Y+import Data.Int+import Prelude hiding (map, product, sum)  -annotatedTerm :: TTerm Term -> TTerm (M.Map String Term) -> TTerm AnnotatedTerm-annotatedTerm subject annotation = Base.record _AnnotatedTerm [-    _AnnotatedTerm_subject>>: subject,-    _AnnotatedTerm_annotation>>: annotation]+annotatedTerm :: TTerm Term -> TTerm (M.Map Name Term) -> TTerm AnnotatedTerm+annotatedTerm subject annotation = Phantoms.record _AnnotatedTerm [+  _AnnotatedTerm_subject>>: subject,+  _AnnotatedTerm_annotation>>: annotation] -annotatedTermSubject :: TTerm (AnnotatedTerm -> Term)-annotatedTermSubject = project _AnnotatedTerm _AnnotatedTerm_subject+annotatedTermSubject :: TTerm AnnotatedTerm -> TTerm Term+annotatedTermSubject at = Phantoms.project _AnnotatedTerm _AnnotatedTerm_subject @@ at -annotatedTermAnnotation :: TTerm (AnnotatedTerm -> M.Map String Term)-annotatedTermAnnotation = project _AnnotatedTerm _AnnotatedTerm_annotation+annotatedTermAnnotation :: TTerm AnnotatedTerm -> TTerm (M.Map Name Term)+annotatedTermAnnotation at = Phantoms.project _AnnotatedTerm _AnnotatedTerm_annotation @@ at -annotatedType :: TTerm Type -> TTerm (M.Map String Term) -> TTerm AnnotatedType-annotatedType subject annotation = Base.record _AnnotatedType [-    _AnnotatedType_subject>>: subject,-    _AnnotatedType_annotation>>: annotation]+annotatedType :: TTerm Type -> TTerm (M.Map Name Term) -> TTerm AnnotatedType+annotatedType subject annotation = Phantoms.record _AnnotatedType [+  _AnnotatedType_subject>>: subject,+  _AnnotatedType_annotation>>: annotation] -annotatedTypeSubject :: TTerm (AnnotatedType -> Type)-annotatedTypeSubject = project _AnnotatedType _AnnotatedType_subject+annotatedTypeSubject :: TTerm AnnotatedType -> TTerm Type+annotatedTypeSubject at = Phantoms.project _AnnotatedType _AnnotatedType_subject @@ at -annotatedTypeAnnotation :: TTerm (AnnotatedType -> M.Map String Term)-annotatedTypeAnnotation = project _AnnotatedType _AnnotatedType_annotation+annotatedTypeAnnotation :: TTerm AnnotatedType -> TTerm (M.Map Name Term)+annotatedTypeAnnotation at = Phantoms.project _AnnotatedType _AnnotatedType_annotation @@ at -application :: TTerm Term -> TTerm Term -> TTerm (Application)-application function argument = Base.record _Application [-    _Application_function>>: function,-    _Application_argument>>: argument]+application :: TTerm Term -> TTerm Term -> TTerm Application+application function argument = Phantoms.record _Application [+  _Application_function>>: function,+  _Application_argument>>: argument] -applicationFunction :: TTerm (Application -> Term)-applicationFunction = project _Application _Application_function+applicationFunction :: TTerm Application -> TTerm Term+applicationFunction app = Phantoms.project _Application _Application_function @@ app -applicationArgument :: TTerm (Application -> Term)-applicationArgument = project _Application _Application_argument+applicationArgument :: TTerm Application -> TTerm Term+applicationArgument app = Phantoms.project _Application _Application_argument @@ app -applicationType :: TTerm Type -> TTerm Type -> TTerm (ApplicationType)-applicationType function argument = Base.record _ApplicationType [-    _ApplicationType_function>>: function,-    _ApplicationType_argument>>: argument]+applicationType :: TTerm Type -> TTerm Type -> TTerm ApplicationType+applicationType function argument = Phantoms.record _ApplicationType [+  _ApplicationType_function>>: function,+  _ApplicationType_argument>>: argument] -applicationTypeFunction :: TTerm (ApplicationType -> Type)-applicationTypeFunction = project _ApplicationType _ApplicationType_function+applicationTypeFunction :: TTerm ApplicationType -> TTerm Type+applicationTypeFunction app = Phantoms.project _ApplicationType _ApplicationType_function @@ app -applicationTypeArgument :: TTerm (ApplicationType -> Type)-applicationTypeArgument = project _ApplicationType _ApplicationType_argument+applicationTypeArgument :: TTerm ApplicationType -> TTerm Type+applicationTypeArgument app = Phantoms.project _ApplicationType _ApplicationType_argument @@ app -caseStatement :: TTerm Name -> TTerm (Maybe Term) -> TTerm [Field] -> TTerm (CaseStatement)-caseStatement typeName defaultTerm cases = Base.record _CaseStatement [-    _CaseStatement_typeName>>: typeName,-    _CaseStatement_default>>: defaultTerm,-    _CaseStatement_cases>>: cases]+caseStatement :: TTerm Name -> TTerm (Maybe Term) -> TTerm [Field] -> TTerm CaseStatement+caseStatement typeName defaultTerm cases = Phantoms.record _CaseStatement [+  _CaseStatement_typeName>>: typeName,+  _CaseStatement_default>>: defaultTerm,+  _CaseStatement_cases>>: cases] -caseStatementTypeName :: TTerm (CaseStatement -> Name)-caseStatementTypeName = project _CaseStatement _CaseStatement_typeName+caseStatementTypeName :: TTerm CaseStatement -> TTerm Name+caseStatementTypeName cs = Phantoms.project _CaseStatement _CaseStatement_typeName @@ cs -caseStatementDefault :: TTerm (CaseStatement -> Maybe Term)-caseStatementDefault = project _CaseStatement _CaseStatement_default+caseStatementDefault :: TTerm CaseStatement -> TTerm (Maybe Term)+caseStatementDefault cs = Phantoms.project _CaseStatement _CaseStatement_default @@ cs -caseStatementCases :: TTerm (CaseStatement -> [Field])-caseStatementCases = project _CaseStatement _CaseStatement_cases+caseStatementCases :: TTerm CaseStatement -> TTerm [Field]+caseStatementCases cs = Phantoms.project _CaseStatement _CaseStatement_cases @@ cs +eliminationProduct :: TTerm TupleProjection -> TTerm Elimination+eliminationProduct = variant _Elimination _Elimination_product++eliminationRecord :: TTerm Projection -> TTerm Elimination+eliminationRecord = variant _Elimination _Elimination_record++eliminationUnion :: TTerm CaseStatement -> TTerm Elimination+eliminationUnion = variant _Elimination _Elimination_union++eliminationWrap :: TTerm Name -> TTerm Elimination+eliminationWrap = variant _Elimination _Elimination_wrap+ field :: TTerm Name -> TTerm Term -> TTerm Field-field name term = Base.record _Field [-    _Field_name>>: name,-    _Field_term>>: term]+field name term = Phantoms.record _Field [+  _Field_name>>: name,+  _Field_term>>: term] -fieldName :: TTerm (Field -> Name)-fieldName = project _Field _Field_name+fieldName :: TTerm Field -> TTerm Name+fieldName f = Phantoms.project _Field _Field_name @@ f -fieldTerm :: TTerm (Field -> Term)-fieldTerm = project _Field _Field_term+fieldTerm :: TTerm Field -> TTerm Term+fieldTerm f = Phantoms.project _Field _Field_term @@ f -fieldType :: TTerm Name -> TTerm Type -> TTerm (FieldType)-fieldType name typ = Base.record _FieldType [-    _FieldType_name>>: name,-    _FieldType_type>>: typ]+fieldType :: TTerm Name -> TTerm Type -> TTerm FieldType+fieldType name typ = Phantoms.record _FieldType [+  _FieldType_name>>: name,+  _FieldType_type>>: typ] -fieldTypeName :: TTerm (FieldType -> Name)-fieldTypeName = project _FieldType _FieldType_name+fieldTypeName :: TTerm FieldType -> TTerm Name+fieldTypeName ft = Phantoms.project _FieldType _FieldType_name @@ ft -fieldTypeType :: TTerm (FieldType -> Type)-fieldTypeType = project _FieldType _FieldType_type+fieldTypeType :: TTerm FieldType -> TTerm Type+fieldTypeType ft = Phantoms.project _FieldType _FieldType_type @@ ft -functionType :: TTerm Type -> TTerm Type -> TTerm (FunctionType)-functionType domain codomain = Base.record _FunctionType [-    _FunctionType_domain>>: domain,-    _FunctionType_codomain>>: codomain]+floatTypeBigfloat :: TTerm FloatType+floatTypeBigfloat = unitVariant _FloatType _FloatType_bigfloat -functionTypeDomain :: TTerm (FunctionType -> Type)-functionTypeDomain = project _FunctionType _FunctionType_domain+floatTypeFloat32 :: TTerm FloatType+floatTypeFloat32 = unitVariant _FloatType _FloatType_float32 -functionTypeCodomain :: TTerm (FunctionType -> Type)-functionTypeCodomain = project _FunctionType _FunctionType_codomain+floatTypeFloat64 :: TTerm FloatType+floatTypeFloat64 = unitVariant _FloatType _FloatType_float64 +floatValueBigfloat :: TTerm Double -> TTerm FloatValue+floatValueBigfloat = inject _FloatValue _FloatValue_bigfloat++floatValueFloat32 :: TTerm Float -> TTerm FloatValue+floatValueFloat32 = inject _FloatValue _FloatValue_float32++floatValueFloat64 :: TTerm Double -> TTerm FloatValue+floatValueFloat64 = inject _FloatValue _FloatValue_float64++forallType :: TTerm Name -> TTerm Type -> TTerm ForallType+forallType parameter body = Phantoms.record _ForallType [+  _ForallType_parameter>>: parameter,+  _ForallType_body>>: body]++forallTypeParameter :: TTerm ForallType -> TTerm Name+forallTypeParameter ft = Phantoms.project _ForallType _ForallType_parameter @@ ft++forallTypeBody :: TTerm ForallType -> TTerm Type+forallTypeBody ft = Phantoms.project _ForallType _ForallType_body @@ ft++functionElimination :: TTerm Elimination -> TTerm Function+functionElimination = variant _Function _Function_elimination++functionLambda :: TTerm Lambda -> TTerm Function+functionLambda = variant _Function _Function_lambda++functionPrimitive :: TTerm Name -> TTerm Function+functionPrimitive = variant _Function _Function_primitive++functionType :: TTerm Type -> TTerm Type -> TTerm FunctionType+functionType domain codomain = Phantoms.record _FunctionType [+  _FunctionType_domain>>: domain,+  _FunctionType_codomain>>: codomain]++functionTypeDomain :: TTerm FunctionType -> TTerm Type+functionTypeDomain ft = Phantoms.project _FunctionType _FunctionType_domain @@ ft++functionTypeCodomain :: TTerm FunctionType -> TTerm Type+functionTypeCodomain ft = Phantoms.project _FunctionType _FunctionType_codomain @@ ft+ injection :: TTerm Name -> TTerm Field -> TTerm Injection-injection typeName field = Base.record _Injection [-    _Injection_typeName>>: typeName,-    _Injection_field>>: field]+injection typeName field = Phantoms.record _Injection [+  _Injection_typeName>>: typeName,+  _Injection_field>>: field] -injectionTypeName :: TTerm (Injection -> Name)-injectionTypeName = project _Injection _Injection_typeName+injectionTypeName :: TTerm Injection -> TTerm Name+injectionTypeName inj = Phantoms.project _Injection _Injection_typeName @@ inj -injectionField :: TTerm (Injection -> Field)-injectionField = project _Injection _Injection_field+injectionField :: TTerm Injection -> TTerm Field+injectionField inj = Phantoms.project _Injection _Injection_field @@ inj -lambda :: TTerm Name -> TTerm Term -> TTerm Lambda-lambda parameter body = Base.record _Lambda [-    _Lambda_parameter>>: parameter,-    _Lambda_body>>: body]+integerTypeBigint :: TTerm IntegerType+integerTypeBigint = unitVariant _IntegerType _IntegerType_bigint -lambdaParameter :: TTerm (Lambda -> Name)-lambdaParameter = project _Lambda _Lambda_parameter+integerTypeInt8 :: TTerm IntegerType+integerTypeInt8 = unitVariant _IntegerType _IntegerType_int8 -lambdaBody :: TTerm (Lambda -> Term)-lambdaBody = project _Lambda _Lambda_body+integerTypeInt16 :: TTerm IntegerType+integerTypeInt16 = unitVariant _IntegerType _IntegerType_int16 -lambdaDomain :: TTerm (Lambda -> Maybe Type)-lambdaDomain = project _Lambda _Lambda_domain+integerTypeInt32 :: TTerm IntegerType+integerTypeInt32 = unitVariant _IntegerType _IntegerType_int32 -lambdaType :: TTerm Name -> TTerm Type -> TTerm LambdaType-lambdaType parameter body = Base.record _LambdaType [-    _LambdaType_parameter>>: parameter,-    _LambdaType_body>>: body]+integerTypeInt64 :: TTerm IntegerType+integerTypeInt64 = unitVariant _IntegerType _IntegerType_int64 -lambdaTypeParameter :: TTerm (LambdaType -> Name)-lambdaTypeParameter = project _LambdaType _LambdaType_parameter+integerTypeUint8 :: TTerm IntegerType+integerTypeUint8 = unitVariant _IntegerType _IntegerType_uint8 -lambdaTypeBody :: TTerm (LambdaType -> Type)-lambdaTypeBody = project _LambdaType _LambdaType_body+integerTypeUint16 :: TTerm IntegerType+integerTypeUint16 = unitVariant _IntegerType _IntegerType_uint16 -letExpression :: TTerm [LetBinding] -> TTerm Term -> TTerm Let-letExpression bindings environment = Base.record _Let [-    _Let_bindings>>: bindings,-    _Let_environment>>: environment]+integerTypeUint32 :: TTerm IntegerType+integerTypeUint32 = unitVariant _IntegerType _IntegerType_uint32 -letBindings :: TTerm (Let -> [LetBinding])-letBindings = project _Let _Let_bindings+integerTypeUint64 :: TTerm IntegerType+integerTypeUint64 = unitVariant _IntegerType _IntegerType_uint64 -letBindingName :: TTerm (LetBinding -> Name)-letBindingName = project _LetBinding _LetBinding_name+integerValueBigint :: TTerm Integer -> TTerm IntegerValue+integerValueBigint = inject _IntegerValue _IntegerValue_bigint -letBindingTerm :: TTerm (LetBinding -> Term)-letBindingTerm = project _LetBinding _LetBinding_term+integerValueInt8 :: TTerm Int8 -> TTerm IntegerValue+integerValueInt8 = inject _IntegerValue _IntegerValue_int8 -letBindingType :: TTerm (LetBinding -> Y.Maybe TypeScheme)-letBindingType = project _LetBinding _LetBinding_type+integerValueInt16 :: TTerm Int16 -> TTerm IntegerValue+integerValueInt16 = inject _IntegerValue _IntegerValue_int16 -letEnvironment :: TTerm (Let -> Term)-letEnvironment = project _Let _Let_environment+integerValueInt32 :: TTerm Int -> TTerm IntegerValue+integerValueInt32 = inject _IntegerValue _IntegerValue_int32 +integerValueInt64 :: TTerm Int64 -> TTerm IntegerValue+integerValueInt64 = inject _IntegerValue _IntegerValue_int64++integerValueUint8 :: TTerm Int16 -> TTerm IntegerValue+integerValueUint8 = inject _IntegerValue _IntegerValue_uint8++integerValueUint16 :: TTerm Int -> TTerm IntegerValue+integerValueUint16 = inject _IntegerValue _IntegerValue_uint16++integerValueUint32 :: TTerm Int64 -> TTerm IntegerValue+integerValueUint32 = inject _IntegerValue _IntegerValue_uint32++integerValueUint64 :: TTerm Integer -> TTerm IntegerValue+integerValueUint64 = inject _IntegerValue _IntegerValue_uint64++lambda :: TTerm Name -> TTerm (Maybe Type) -> TTerm Term -> TTerm Lambda+lambda parameter mdom body = Phantoms.record _Lambda [+  _Lambda_parameter>>: parameter,+  _Lambda_domain>>: mdom,+  _Lambda_body>>: body]++lambdaParameter :: TTerm Lambda -> TTerm Name+lambdaParameter l = Phantoms.project _Lambda _Lambda_parameter @@ l++lambdaBody :: TTerm Lambda -> TTerm Term+lambdaBody l = Phantoms.project _Lambda _Lambda_body @@ l++lambdaDomain :: TTerm Lambda -> TTerm (Maybe Type)+lambdaDomain l = Phantoms.project _Lambda _Lambda_domain @@ l++let_ :: TTerm [Binding] -> TTerm Term -> TTerm Let+let_ bindings environment = Phantoms.record _Let [+  _Let_bindings>>: bindings,+  _Let_environment>>: environment]++binding :: TTerm Name -> TTerm Term -> TTerm (Maybe TypeScheme) -> TTerm Binding+binding name term mtype = Phantoms.record _Binding [+  _Binding_name>>: name,+  _Binding_term>>: term,+  _Binding_type>>: mtype]++letBindings :: TTerm Let -> TTerm [Binding]+letBindings l = Phantoms.project _Let _Let_bindings @@ l++bindingName :: TTerm Binding -> TTerm Name+bindingName lb = Phantoms.project _Binding _Binding_name @@ lb++bindingTerm :: TTerm Binding -> TTerm Term+bindingTerm lb = Phantoms.project _Binding _Binding_term @@ lb++bindingType :: TTerm Binding -> TTerm (Y.Maybe TypeScheme)+bindingType lb = Phantoms.project _Binding _Binding_type @@ lb++letEnvironment :: TTerm Let -> TTerm Term+letEnvironment l = Phantoms.project _Let _Let_environment @@ l+ literalBinary :: TTerm String -> TTerm Literal literalBinary = variant _Literal _Literal_binary @@ -167,122 +277,299 @@ literalInteger :: TTerm IntegerValue -> TTerm Literal literalInteger = variant _Literal _Literal_integer -mapType :: TTerm Type -> TTerm Type -> TTerm MapType-mapType keys values = Base.record _MapType [-    _MapType_keys>>: keys,-    _MapType_values>>: values]+literalString :: TTerm String -> TTerm Literal+literalString = variant _Literal _Literal_string -mapTypeKeys :: TTerm (MapType -> Type)-mapTypeKeys = project _MapType _MapType_keys+literalTypeBinary :: TTerm LiteralType+literalTypeBinary = unitVariant _LiteralType _LiteralType_binary -mapTypeValues :: TTerm (MapType -> Type)-mapTypeValues = project _MapType _MapType_values+literalTypeBoolean :: TTerm LiteralType+literalTypeBoolean = unitVariant _LiteralType _LiteralType_boolean -name :: Name -> TTerm Name-name nm = TTerm $ coreEncodeName nm+literalTypeFloat :: TTerm FloatType -> TTerm LiteralType+literalTypeFloat = variant _LiteralType _LiteralType_float -optionalCases :: TTerm Term -> TTerm Term -> TTerm OptionalCases-optionalCases nothing just = Base.record _OptionalCases [-    _OptionalCases_nothing>>: nothing,-    _OptionalCases_just>>: just]+literalTypeInteger :: TTerm IntegerType -> TTerm LiteralType+literalTypeInteger = variant _LiteralType _LiteralType_integer -optionalCasesNothing :: TTerm (OptionalCases -> Term)-optionalCasesNothing = project _OptionalCases _OptionalCases_nothing+literalTypeString :: TTerm LiteralType+literalTypeString = unitVariant _LiteralType _LiteralType_string -optionalCasesJust :: TTerm (OptionalCases -> Term)-optionalCasesJust = project _OptionalCases _OptionalCases_just+mapType :: TTerm Type -> TTerm Type -> TTerm MapType+mapType keys values = Phantoms.record _MapType [+  _MapType_keys>>: keys,+  _MapType_values>>: values] -projectionTypeName :: TTerm (Projection -> Name)-projectionTypeName = project _Projection _Projection_typeName+mapTypeKeys :: TTerm MapType -> TTerm Type+mapTypeKeys mt = Phantoms.project _MapType _MapType_keys @@ mt -projectionField :: TTerm (Projection -> Name)-projectionField = project _Projection _Projection_field+mapTypeValues :: TTerm MapType -> TTerm Type+mapTypeValues mt = Phantoms.project _MapType _MapType_values @@ mt +name :: TTerm String -> TTerm Name+name = wrap _Name++nameLift :: Name -> TTerm Name+nameLift (Name n) = wrap _Name $ Phantoms.string n++projection :: TTerm Name -> TTerm Name -> TTerm Projection+projection tname fname = Phantoms.record _Projection [+  _Projection_typeName>>: tname,+  _Projection_field>>: fname]++projectionTypeName :: TTerm Projection -> TTerm Name+projectionTypeName p = Phantoms.project _Projection _Projection_typeName @@ p++projectionField :: TTerm Projection -> TTerm Name+projectionField p = Phantoms.project _Projection _Projection_field @@ p+ record :: TTerm Name -> TTerm [Field] -> TTerm Record-record typeName fields = Base.record _Record [-    _Record_typeName>>: typeName,-    _Record_fields>>: fields]+record typeName fields = Phantoms.record _Record [+  _Record_typeName>>: typeName,+  _Record_fields>>: fields] -recordTypeName :: TTerm (Record -> Name)-recordTypeName = project _Record _Record_typeName+recordTypeName :: TTerm Record -> TTerm Name+recordTypeName r = Phantoms.project _Record _Record_typeName @@ r -recordFields :: TTerm (Record -> [Field])-recordFields = project _Record _Record_fields+recordFields :: TTerm Record -> TTerm [Field]+recordFields r = Phantoms.project _Record _Record_fields @@ r  rowType :: TTerm Name -> TTerm [FieldType] -> TTerm (RowType)-rowType typeName fields = Base.record _RowType [-    _RowType_typeName>>: typeName,-    _RowType_fields>>: fields]+rowType typeName fields = Phantoms.record _RowType [+  _RowType_typeName>>: typeName,+  _RowType_fields>>: fields] -rowTypeTypeName :: TTerm (RowType -> Name)-rowTypeTypeName = project _RowType _RowType_typeName+rowTypeTypeName :: TTerm RowType -> TTerm Name+rowTypeTypeName rt = Phantoms.project _RowType _RowType_typeName @@ rt -rowTypeFields :: TTerm (RowType -> [FieldType])-rowTypeFields = project _RowType _RowType_fields+rowTypeFields :: TTerm RowType -> TTerm [FieldType]+rowTypeFields rt = Phantoms.project _RowType _RowType_fields @@ rt  sum :: TTerm Int -> TTerm Int -> TTerm Term -> TTerm Sum-sum index size term = Base.record _Sum [-    _Sum_index>>: index,-    _Sum_size>>: size,-    _Sum_term>>: term]+sum index size term = Phantoms.record _Sum [+  _Sum_index>>: index,+  _Sum_size>>: size,+  _Sum_term>>: term] -sumIndex :: TTerm (Sum -> Int)-sumIndex = project _Sum _Sum_index+sumIndex :: TTerm Sum -> TTerm Int+sumIndex s = Phantoms.project _Sum _Sum_index @@ s -sumSize :: TTerm (Sum -> Int)-sumSize = project _Sum _Sum_size+sumSize :: TTerm Sum -> TTerm Int+sumSize s = Phantoms.project _Sum _Sum_size @@ s -sumTerm :: TTerm (Sum -> Term)-sumTerm = project _Sum _Sum_term+sumTerm :: TTerm Sum -> TTerm Term+sumTerm s = Phantoms.project _Sum _Sum_term @@ s  termAnnotated :: TTerm AnnotatedTerm -> TTerm Term termAnnotated = variant _Term _Term_annotated -tupleProjectionArity :: TTerm (TupleProjection -> Int)-tupleProjectionArity = project _TupleProjection _TupleProjection_arity+termApplication :: TTerm Application -> TTerm Term+termApplication = variant _Term _Term_application -tupleProjectionIndex :: TTerm (TupleProjection -> Int)-tupleProjectionIndex = project _TupleProjection _TupleProjection_index+termFunction :: TTerm Function -> TTerm Term+termFunction = variant _Term _Term_function -typeAbstractionParameter :: TTerm (TypeAbstraction -> Name)-typeAbstractionParameter = project _TypeAbstraction _TypeAbstraction_parameter+termLet :: TTerm Let -> TTerm Term+termLet = variant _Term _Term_let -typeAbstractionBody :: TTerm (TypeAbstraction -> Type)-typeAbstractionBody = project _TypeAbstraction _TypeAbstraction_body+termList :: TTerm [Term] -> TTerm Term+termList = variant _Term _Term_list -typeSchemeVariables :: TTerm (TypeScheme -> [Name])-typeSchemeVariables = project _TypeScheme _TypeScheme_variables+termLiteral :: TTerm Literal -> TTerm Term+termLiteral = variant _Term _Term_literal -typeSchemeType :: TTerm (TypeScheme -> Type)-typeSchemeType = project _TypeScheme _TypeScheme_type+termMap :: TTerm (M.Map Term Term) -> TTerm Term+termMap = variant _Term _Term_map -typedTermTerm :: TTerm (TypedTerm -> Term)-typedTermTerm = project _TypedTerm _TypedTerm_term+termOptional :: TTerm (Maybe Term) -> TTerm Term+termOptional = variant _Term _Term_optional -unName :: TTerm (Name -> String)-unName = unwrap _Name+termProduct :: TTerm [Term] -> TTerm Term+termProduct = variant _Term _Term_product -unNamespace :: TTerm (Namespace -> String)-unNamespace = unwrap _Namespace+termRecord :: TTerm Record -> TTerm Term+termRecord = variant _Term _Term_record +termSet :: TTerm (S.Set Term) -> TTerm Term+termSet = variant _Term _Term_set++termSum :: TTerm Sum -> TTerm Term+termSum = variant _Term _Term_sum++termTypeLambda :: TTerm TypeLambda -> TTerm Term+termTypeLambda = variant _Term _Term_typeLambda++termTypeApplication :: TTerm TypedTerm -> TTerm Term+termTypeApplication = variant _Term _Term_typeApplication++termUnion :: TTerm Injection -> TTerm Term+termUnion = variant _Term _Term_union++termUnit :: TTerm Term+termUnit = unitVariant _Term _Term_unit++termVariable :: TTerm Name -> TTerm Term+termVariable = variant _Term _Term_variable++termWrap :: TTerm WrappedTerm -> TTerm Term+termWrap = variant _Term _Term_wrap++tupleProjection :: TTerm Int -> TTerm Int -> TTerm (Maybe [Type]) -> TTerm TupleProjection+tupleProjection arity idx mdom = Phantoms.record _TupleProjection [+  _TupleProjection_arity>>: arity,+  _TupleProjection_index>>: idx,+  _TupleProjection_domain>>: mdom]++tupleProjectionArity :: TTerm TupleProjection -> TTerm Int+tupleProjectionArity tp = Phantoms.project _TupleProjection _TupleProjection_arity @@ tp++tupleProjectionIndex :: TTerm TupleProjection -> TTerm Int+tupleProjectionIndex tp = Phantoms.project _TupleProjection _TupleProjection_index @@ tp++tupleProjectionDomain :: TTerm TupleProjection -> TTerm (Maybe [Type])+tupleProjectionDomain tp = Phantoms.project _TupleProjection _TupleProjection_domain @@ tp++typeLambda :: TTerm Name -> TTerm Term -> TTerm TypeLambda+typeLambda parameter body = Phantoms.record _TypeLambda [+  _TypeLambda_parameter>>: parameter,+  _TypeLambda_body>>: body]++typeLambdaParameter :: TTerm TypeLambda -> TTerm Name+typeLambdaParameter ta = Phantoms.project _TypeLambda _TypeLambda_parameter @@ ta++typeLambdaBody :: TTerm TypeLambda -> TTerm Term+typeLambdaBody ta = Phantoms.project _TypeLambda _TypeLambda_body @@ ta++typeAnnotated :: TTerm AnnotatedType -> TTerm Type+typeAnnotated = variant _Type _Type_annotated++typeApplication :: TTerm ApplicationType -> TTerm Type+typeApplication = variant _Type _Type_application++typeForall :: TTerm ForallType -> TTerm Type+typeForall = variant _Type _Type_forall++typeFunction :: TTerm FunctionType -> TTerm Type+typeFunction = variant _Type _Type_function++typeList :: TTerm Type -> TTerm Type+typeList = variant _Type _Type_list++typeLiteral :: TTerm LiteralType -> TTerm Type+typeLiteral = variant _Type _Type_literal++typeMap :: TTerm MapType -> TTerm Type+typeMap = variant _Type _Type_map++typeOptional :: TTerm Type -> TTerm Type+typeOptional = variant _Type _Type_optional++typeProduct :: TTerm [Type] -> TTerm Type+typeProduct = variant _Type _Type_product++typeRecord :: TTerm RowType -> TTerm Type+typeRecord = variant _Type _Type_record++typeScheme :: TTerm [Name] -> TTerm Type -> TTerm TypeScheme+typeScheme variables body = Phantoms.record _TypeScheme [+  _TypeScheme_variables>>: variables,+  _TypeScheme_type>>: body]++typeSchemeVariables :: TTerm TypeScheme -> TTerm [Name]+typeSchemeVariables ts = Phantoms.project _TypeScheme _TypeScheme_variables @@ ts++typeSchemeType :: TTerm TypeScheme -> TTerm Type+typeSchemeType ts = Phantoms.project _TypeScheme _TypeScheme_type @@ ts++typeSet :: TTerm Type -> TTerm Type+typeSet = variant _Type _Type_set++typeSum :: TTerm [Type] -> TTerm Type+typeSum = variant _Type _Type_sum++typeUnion :: TTerm RowType -> TTerm Type+typeUnion = variant _Type _Type_union++typeUnit :: TTerm Type+typeUnit = unitVariant _Type _Type_unit++typeVariable :: TTerm Name -> TTerm Type+typeVariable = variant _Type _Type_variable++typeWrap :: TTerm WrappedType -> TTerm Type+typeWrap = variant _Type _Type_wrap++typedTerm :: TTerm Term -> TTerm Type -> TTerm TypedTerm+typedTerm term type_ = Phantoms.record _TypedTerm [+  _TypedTerm_term>>: term,+  _TypedTerm_type>>: type_]++typedTermTerm :: TTerm TypedTerm -> TTerm Term+typedTermTerm tt = Phantoms.project _TypedTerm _TypedTerm_term @@ tt++typedTermType :: TTerm TypedTerm -> TTerm Type+typedTermType tt = Phantoms.project _TypedTerm _TypedTerm_type @@ tt++unName :: TTerm Name -> TTerm String+unName n = unwrap _Name @@ n++unNamespace :: TTerm Namespace -> TTerm String+unNamespace ns = unwrap _Namespace @@ ns+ wrappedTerm :: TTerm Name -> TTerm Term -> TTerm WrappedTerm-wrappedTerm typeName object = Base.record _WrappedTerm [-    _WrappedTerm_typeName>>: typeName,-    _WrappedTerm_object>>: object]+wrappedTerm typeName object = Phantoms.record _WrappedTerm [+  _WrappedTerm_typeName>>: typeName,+  _WrappedTerm_object>>: object] -wrappedTermTypeName :: TTerm (WrappedTerm -> Name)-wrappedTermTypeName = project _WrappedTerm _WrappedTerm_typeName+wrappedTermTypeName :: TTerm WrappedTerm -> TTerm Name+wrappedTermTypeName wt = Phantoms.project _WrappedTerm _WrappedTerm_typeName @@ wt -wrappedTermObject :: TTerm (WrappedTerm -> Term)-wrappedTermObject = project _WrappedTerm _WrappedTerm_object+wrappedTermObject :: TTerm WrappedTerm -> TTerm Term+wrappedTermObject wt = Phantoms.project _WrappedTerm _WrappedTerm_object @@ wt  wrappedType :: TTerm Name -> TTerm Type -> TTerm WrappedType-wrappedType typeName object = Base.record _WrappedType [-    _WrappedType_typeName>>: typeName,-    _WrappedType_object>>: object]+wrappedType typeName object = Phantoms.record _WrappedType [+  _WrappedType_typeName>>: typeName,+  _WrappedType_object>>: object] -wrappedTypeTypeName :: TTerm (WrappedType -> Name)-wrappedTypeTypeName = project _WrappedType _WrappedType_typeName+wrappedTypeTypeName :: TTerm WrappedType -> TTerm Name+wrappedTypeTypeName wt = Phantoms.project _WrappedType _WrappedType_typeName @@ wt -wrappedTypeObject :: TTerm (WrappedType -> Type)-wrappedTypeObject = project _WrappedType _WrappedType_object+wrappedTypeObject :: TTerm WrappedType -> TTerm Type+wrappedTypeObject wt = Phantoms.project _WrappedType _WrappedType_object @@ wt++----------------------------------------+-- Non-schema helpers++equalName :: TTerm (Name -> Name -> Bool)+equalName = lambdas ["left", "right"] $ primitive _equality_equal+  @@ (Hydra.Dsl.Core.unName $ var "left")+  @@ (Hydra.Dsl.Core.unName $ var "right")++equalName_ :: TTerm Name -> TTerm Name -> TTerm Bool+equalName_ left right = Equality.equal (Hydra.Dsl.Core.unName left) (Hydra.Dsl.Core.unName right)++equalNameList :: TTerm ([Name] -> [Name] -> Bool)+equalNameList = lambdas ["lefts", "rights"] $ Logic.and+  (Equality.equal (Lists.length (var "lefts")) (Lists.length (var "rights")))+  (Logic.ands $ Lists.zipWith equalName (var "lefts") (var "rights"))++equalNameList_ :: TTerm [Name] -> TTerm [Name] -> TTerm Bool+equalNameList_ lefts rights = Logic.and+  (Equality.equal (Lists.length lefts) (Lists.length rights))+  (Logic.ands $ Lists.zipWith equalName lefts rights)++fieldWithTerm :: TTerm Term -> TTerm Field -> TTerm Field+fieldWithTerm t ft = Hydra.Dsl.Core.field (Hydra.Dsl.Core.fieldName ft) t++fieldTypeWithType :: TTerm FieldType -> TTerm Type -> TTerm FieldType+fieldTypeWithType ft t = Hydra.Dsl.Core.fieldType (Hydra.Dsl.Core.fieldTypeName ft) t++false :: TTerm Term+false = termLiteral $ literalBoolean $ Phantoms.false++int32 :: Int -> TTerm Term+int32 = termLiteral . literalInteger . integerValueInt32 . Phantoms.int32++string :: String -> TTerm Term+string = termLiteral . literalString . Phantoms.string
− src/main/haskell/Hydra/Dsl/Expect.hs 
@@ -1,321 +0,0 @@--- | A DSL for decoding Hydra terms--module Hydra.Dsl.Expect where--import Hydra.Compute-import Hydra.Core-import Hydra.Graph-import Hydra.Strip-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Lib.Flows as Flows--import Prelude hiding (map)-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Control.Monad as CM-import Data.Int---bigfloat :: Term -> Flow s Double-bigfloat t = literal t >>= floatLiteral >>= bigfloatValue--bigfloatValue :: FloatValue -> Flow s Double-bigfloatValue v = case v of-  FloatValueBigfloat f -> pure f-  _ -> unexpected "bigfloat" $ show v--bigint :: Term -> Flow s Integer-bigint t = literal t >>= integerLiteral >>= bigintValue--bigintValue :: IntegerValue -> Flow s Integer-bigintValue v = case v of-  IntegerValueBigint i -> pure i-  _ -> unexpected "bigint" $ show v--binary :: Term -> Flow s String-binary t = literal t >>= binaryLiteral--binaryLiteral :: Literal -> Flow s String-binaryLiteral v = case v of-  LiteralBinary b -> pure b-  _ -> unexpected "binary" $ show v--boolean :: Term -> Flow s Bool-boolean t = literal t >>= booleanLiteral--booleanLiteral :: Literal -> Flow s Bool-booleanLiteral v = case v of-  LiteralBoolean b -> pure b-  _ -> unexpected "boolean" $ show v--cases :: Name -> Term -> Flow s (CaseStatement)-cases name term = case strip term of-  TermFunction (FunctionElimination (EliminationUnion cs)) -> if caseStatementTypeName cs == name-    then pure cs-    else unexpected ("case statement for type " ++ unName name) $ show term-  _ -> unexpected "case statement" $ show term--casesCase :: Name -> String -> Term -> Flow s (Field)-casesCase name n term = do-  cs <- cases name term-  let matching = L.filter (\f -> fieldName f == Name n) $ caseStatementCases cs-  if L.null matching-    then fail $ "not enough cases"-    else pure $ L.head matching--field :: Name -> (Term -> Flow s x) -> [Field] -> Flow s x-field fname mapping fields = case L.filter (\f -> fieldName f == fname) fields of-  [] -> fail $ "field " ++ unName fname ++ " not found"-  [f] -> mapping $ fieldTerm f-  _ -> fail $ "multiple fields named " ++ unName fname--float32 :: Term -> Flow s Float-float32 t = literal t >>= floatLiteral >>= float32Value--float32Value :: FloatValue -> Flow s Float-float32Value v = case v of-  FloatValueFloat32 f -> pure f-  _ -> unexpected "float32" $ show v--float64 :: Term -> Flow s Double-float64 t = literal t >>= floatLiteral >>= float64Value--float64Value :: FloatValue -> Flow s Double-float64Value v = case v of-  FloatValueFloat64 f -> pure f-  _ -> unexpected "float64" $ show v--floatLiteral :: Literal -> Flow s FloatValue-floatLiteral lit = case lit of-  LiteralFloat v -> pure v-  _ -> unexpected "floating-point value" $ show lit--inject :: Name -> Term -> Flow s (Field)-inject name term = case strip term of-  TermUnion (Injection name' field) -> if name' == name-    then pure field-    else unexpected ("injection of type " ++ unName name) (unName name')-  _ -> unexpected "injection" $ show term--injection :: Term -> Flow s (Field)-injection term = case strip term of-  TermUnion (Injection _ field) -> pure field-  _ -> unexpected "injection" $ show term--injectionWithName :: Name -> Term -> Flow s (Field)-injectionWithName expected term = case strip term of-  TermUnion (Injection actual field) -> if actual == expected-    then pure field-    else unexpected ("injection of type " ++ unName expected) (unName actual)-  _ -> unexpected "injection" $ show term--int8 :: Term -> Flow s Int8-int8 t = literal t >>= integerLiteral >>= int8Value--int8Value :: IntegerValue -> Flow s Int8-int8Value v = case v of-  IntegerValueInt8 i -> pure i-  _ -> unexpected "int8" $ show v--int16 :: Term -> Flow s Int16-int16 t = literal t >>= integerLiteral >>= int16Value--int16Value :: IntegerValue -> Flow s Int16-int16Value v = case v of-  IntegerValueInt16 i -> pure i-  _ -> unexpected "int16" $ show v--int32 :: Term -> Flow s Int-int32 t = literal t >>= integerLiteral >>= int32Value--int32Value :: IntegerValue -> Flow s Int-int32Value v = case v of-  IntegerValueInt32 i -> pure i-  _ -> unexpected "int32" $ show v--int64 :: Term -> Flow s Int64-int64 t = literal t >>= integerLiteral >>= int64Value--int64Value :: IntegerValue -> Flow s Int64-int64Value v = case v of-  IntegerValueInt64 i -> pure i-  _ -> unexpected "int64" $ show v--integerLiteral :: Literal -> Flow s IntegerValue-integerLiteral lit = case lit of-  LiteralInteger v -> pure v-  _ -> unexpected "integer value" $ show lit--lambda :: Term -> Flow s (Lambda)-lambda term = case strip term of-  TermFunction (FunctionLambda l) -> pure l-  _ -> unexpected "lambda" $ show term--letBinding :: String -> Term -> Flow s (Term)-letBinding n term = do-  bindings <- letBindings <$> letTerm term-  case L.filter (\b -> letBindingName b == Name n) bindings of-    [] -> fail $ "no such binding: " ++ n-    [b] -> pure $ letBindingTerm b-    _ -> fail $ "multiple bindings named " ++ n--lambdaBody :: Term -> Flow s (Term)-lambdaBody term = Hydra.Core.lambdaBody <$> lambda term--letTerm :: Term -> Flow s (Let)-letTerm term = case strip term of-  TermLet lt -> pure lt-  _ -> unexpected "let term" $ show term--list :: (Term -> Flow s x) -> Term -> Flow s [x]-list f term = case strip term of-  TermList l -> CM.mapM f l-  _ -> unexpected "list" $ show term--listHead :: Term -> Flow s (Term)-listHead term = do-  l <- list pure term-  if L.null l-    then fail "empty list"-    else pure $ L.head l--literal :: Term -> Flow s Literal-literal term = case strip term of-  TermLiteral lit -> pure lit-  _ -> unexpected "literal" $ show term--map :: Ord k => (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (M.Map k v)-map fk fv term = case strip term of-  TermMap m -> M.fromList <$> CM.mapM pair (M.toList m)-    where-      pair (kterm, vterm) = do-        kval <- fk kterm-        vval <- fv vterm-        return (kval, vval)-  _ -> unexpected "map" $ show term--nArgs :: Int -> [Term] -> Flow s ()-nArgs n args = if L.length args /= n-  then unexpected (show n ++ " arguments") $ show (L.length args)-  else pure ()--optCases :: Term -> Flow s (OptionalCases)-optCases term = case strip term of-  TermFunction (FunctionElimination (EliminationOptional cs)) -> pure cs-  _ -> unexpected "optional cases" $ show term--optCasesJust :: Term -> Flow s (Term)-optCasesJust term = optionalCasesJust <$> optCases term--optCasesNothing :: Term -> Flow s (Term)-optCasesNothing term = optionalCasesNothing <$> optCases term--optional :: (Term -> Flow s x) -> Term -> Flow s (Y.Maybe x)-optional f term = case strip term of-  TermOptional mt -> case mt of-    Nothing -> pure Nothing-    Just t -> Just <$> f t-  _ -> unexpected "optional value" $ show term--pair :: (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (k, v)-pair kf vf term = case strip term of-  TermProduct terms -> case terms of-    [kTerm, vTerm] -> do-      kVal <- kf kTerm-      vVal <- vf vTerm-      return (kVal, vVal)-    _ -> unexpected "pair" $ show term-  _ -> unexpected "product" $ show term--record :: Term -> Flow s [Field]-record term = case strip term of-  TermRecord (Record _ fields) -> pure fields-  _ -> unexpected "record" $ show term--recordWithName :: Name -> Term -> Flow s [Field]-recordWithName expected term = case strip term of-  TermRecord (Record actual fields) -> if actual == expected-    then pure fields-    else unexpected ("record of type " ++ unName expected) (unName actual)-  _ -> unexpected "record" $ show term--set :: Ord x => (Term -> Flow s x) -> Term -> Flow s (S.Set x)-set f term = case strip term of-  TermSet s -> S.fromList <$> CM.mapM f (S.toList s)-  _ -> unexpected "set" $ show term--string :: Term -> Flow s String-string t = literal t >>= stringLiteral--stringLiteral :: Literal -> Flow s String-stringLiteral v = case v of-  LiteralString s -> pure s-  _ -> unexpected "string" $ show v--strip :: Term -> Term-strip term = case stripTerm term of-  TermTyped (TypedTerm term1 _) -> strip term1-  t -> t--uint8 :: Term -> Flow s Int16-uint8 t = literal t >>= integerLiteral >>= uint8Value--uint8Value :: IntegerValue -> Flow s Int16-uint8Value v = case v of-  IntegerValueUint8 i -> pure i-  _ -> unexpected "uint8" $ show v--uint16 :: Term -> Flow s Int-uint16 t = literal t >>= integerLiteral >>= uint16Value--uint16Value :: IntegerValue -> Flow s Int-uint16Value v = case v of-  IntegerValueUint16 i -> pure i-  _ -> unexpected "uint16" $ show v--uint32 :: Term -> Flow s Int64-uint32 t = literal t >>= integerLiteral >>= uint32Value--uint32Value :: IntegerValue -> Flow s Int64-uint32Value v = case v of-  IntegerValueUint32 i -> pure i-  _ -> unexpected "uint32" $ show v--uint64 :: Term -> Flow s Integer-uint64 t = literal t >>= integerLiteral >>= uint64Value--uint64Value :: IntegerValue -> Flow s Integer-uint64Value v = case v of-  IntegerValueUint64 i -> pure i-  _ -> unexpected "uint64" $ show v--unit :: Term -> Flow s ()-unit term = do-  fields <- recordWithName _Unit term-  if L.null fields-    then pure ()-    else unexpected "unit" $ show term--unitVariant :: Name -> Term -> Flow s Name-unitVariant tname term = do-  field <- variant tname term-  unit $ fieldTerm field-  pure $ fieldName field--variable :: Term -> Flow s Name-variable term = case strip term of-  TermVariable name -> pure name-  _ -> unexpected "variable" $ show term--variant :: Name -> Term -> Flow s (Field)-variant = injectionWithName--wrap :: Name -> Term -> Flow s (Term)-wrap expected term = case strip term of-  TermWrap (WrappedTerm actual term) -> if actual == expected-    then pure term-    else unexpected ("wrapper of type " ++ unName expected) (unName actual)-  _ -> unexpected ("wrap(" ++ unName expected ++ ")") $ show term
+ src/main/haskell/Hydra/Dsl/Grammar.hs view
@@ -0,0 +1,38 @@+module Hydra.Dsl.Grammar where++import Hydra.Kernel hiding (Pattern)+import Hydra.Dsl.Phantoms+import Hydra.Grammar++import qualified Data.Map as M+import qualified Data.Maybe as Y+++labeledPatternLabel :: TTerm LabeledPattern -> TTerm Label+labeledPatternLabel lp = project _LabeledPattern _LabeledPattern_label @@ lp++labeledPatternPattern :: TTerm LabeledPattern -> TTerm Pattern+labeledPatternPattern lp = project _LabeledPattern _LabeledPattern_pattern @@ lp++production :: TTerm Symbol -> TTerm Pattern -> TTerm Production+production sym pat = record _Production [+  _Production_symbol>>: sym,+  _Production_pattern>>: pat]++productionSymbol :: TTerm Production -> TTerm Symbol+productionSymbol p = project _Production _Production_symbol @@ p++productionPattern :: TTerm Production -> TTerm Pattern+productionPattern p = project _Production _Production_pattern @@ p++unConstant :: TTerm Constant -> TTerm String+unConstant c = unwrap _Constant @@ c++unGrammar :: TTerm Grammar -> TTerm [Production]+unGrammar g = unwrap _Grammar @@ g++unLabel :: TTerm Label -> TTerm String+unLabel l = unwrap _Label @@ l++unSymbol :: TTerm Symbol -> TTerm String+unSymbol s = unwrap _Symbol @@ s
src/main/haskell/Hydra/Dsl/Graph.hs view
@@ -1,15 +1,21 @@ module Hydra.Dsl.Graph where  import Hydra.Kernel-import Hydra.Dsl.Base as Base+import Hydra.Dsl.Phantoms  import qualified Data.Map as M  -elementName :: TTerm (Element -> Name)-elementName = project _Element _Element_name+comparisonLessThan :: TTerm Comparison+comparisonLessThan = unitVariant _Comparison _Comparison_lessThan -graph :: TTerm (M.Map Name Element)+comparisonEqualTo :: TTerm Comparison+comparisonEqualTo = unitVariant _Comparison _Comparison_equalTo++comparisonGreaterThan :: TTerm Comparison+comparisonGreaterThan = unitVariant _Comparison _Comparison_greaterThan++graph :: TTerm (M.Map Name Binding)     -> TTerm (M.Map Name (Maybe Term))     -> TTerm (M.Map Name TypeScheme)     -> TTerm Term@@ -24,29 +30,104 @@     _Graph_primitives>>: primitives,     _Graph_schema>>: schema] -graphElements :: TTerm (Graph -> M.Map Name Element)-graphElements = project _Graph _Graph_elements+graphElements :: TTerm Graph -> TTerm (M.Map Name Binding)+graphElements g = project _Graph _Graph_elements @@ g -graphEnvironment :: TTerm (Graph -> M.Map Name (Maybe Term))-graphEnvironment = project _Graph _Graph_environment+graphEnvironment :: TTerm Graph -> TTerm (M.Map Name (Maybe Term))+graphEnvironment g = project _Graph _Graph_environment @@ g -graphTypes :: TTerm (Graph -> M.Map Name TypeScheme)-graphTypes = project _Graph _Graph_types+graphTypes :: TTerm Graph -> TTerm (M.Map Name TypeScheme)+graphTypes g = project _Graph _Graph_types @@ g -graphBody :: TTerm (Graph -> Term)-graphBody = project _Graph _Graph_body+graphBody :: TTerm Graph -> TTerm Term+graphBody g = project _Graph _Graph_body @@ g -graphPrimitives :: TTerm (Graph -> M.Map Name Primitive)-graphPrimitives = project _Graph _Graph_primitives+graphPrimitives :: TTerm Graph -> TTerm (M.Map Name Primitive)+graphPrimitives g = project _Graph _Graph_primitives @@ g -graphSchema :: TTerm (Graph -> Maybe Graph)-graphSchema = project _Graph _Graph_schema+graphSchema :: TTerm Graph -> TTerm (Maybe Graph)+graphSchema g = project _Graph _Graph_schema @@ g -primitiveName :: TTerm (Primitive -> Name)-primitiveName = project _Primitive _Primitive_name+graphWithElements :: TTerm Graph -> TTerm (M.Map Name Binding) -> TTerm Graph+graphWithElements g newElements = graph+    newElements+    (Hydra.Dsl.Graph.graphEnvironment g)+    (Hydra.Dsl.Graph.graphTypes g)+    (Hydra.Dsl.Graph.graphBody g)+    (Hydra.Dsl.Graph.graphPrimitives g)+    (Hydra.Dsl.Graph.graphSchema g) -primitiveType :: TTerm (Primitive -> TypeScheme)-primitiveType = project _Primitive _Primitive_type+graphWithEnvironment :: TTerm Graph -> TTerm (M.Map Name (Maybe Term)) -> TTerm Graph+graphWithEnvironment g newEnvironment = graph+    (Hydra.Dsl.Graph.graphElements g)+    newEnvironment+    (Hydra.Dsl.Graph.graphTypes g)+    (Hydra.Dsl.Graph.graphBody g)+    (Hydra.Dsl.Graph.graphPrimitives g)+    (Hydra.Dsl.Graph.graphSchema g) -primitiveImplementation :: TTerm (Primitive -> ([Term] -> Flow Graph Term))-primitiveImplementation = project _Primitive _Primitive_type+graphWithTypes :: TTerm Graph -> TTerm (M.Map Name TypeScheme) -> TTerm Graph+graphWithTypes g newTypes = graph+    (Hydra.Dsl.Graph.graphElements g)+    (Hydra.Dsl.Graph.graphEnvironment g)+    newTypes+    (Hydra.Dsl.Graph.graphBody g)+    (Hydra.Dsl.Graph.graphPrimitives g)+    (Hydra.Dsl.Graph.graphSchema g)++graphWithBody :: TTerm Graph -> TTerm Term -> TTerm Graph+graphWithBody g newBody = graph+    (Hydra.Dsl.Graph.graphElements g)+    (Hydra.Dsl.Graph.graphEnvironment g)+    (Hydra.Dsl.Graph.graphTypes g)+    newBody+    (Hydra.Dsl.Graph.graphPrimitives g)+    (Hydra.Dsl.Graph.graphSchema g)++graphWithPrimitives :: TTerm Graph -> TTerm (M.Map Name Primitive) -> TTerm Graph+graphWithPrimitives g newPrimitives = graph+    (Hydra.Dsl.Graph.graphElements g)+    (Hydra.Dsl.Graph.graphEnvironment g)+    (Hydra.Dsl.Graph.graphTypes g)+    (Hydra.Dsl.Graph.graphBody g)+    newPrimitives+    (Hydra.Dsl.Graph.graphSchema g)++graphWithSchema :: TTerm Graph -> TTerm (Maybe Graph) -> TTerm Graph+graphWithSchema g newSchema = graph+    (Hydra.Dsl.Graph.graphElements g)+    (Hydra.Dsl.Graph.graphEnvironment g)+    (Hydra.Dsl.Graph.graphTypes g)+    (Hydra.Dsl.Graph.graphBody g)+    (Hydra.Dsl.Graph.graphPrimitives g)+    newSchema++primitive :: TTerm Name+    -> TTerm TypeScheme+    -> TTerm ([Term] -> Flow Graph Term)+    -> TTerm Primitive+primitive name typ implementation = record _Primitive [+    _Primitive_name>>: name,+    _Primitive_type>>: typ,+    _Primitive_implementation>>: implementation]++primitiveName :: TTerm Primitive -> TTerm Name+primitiveName p = project _Primitive _Primitive_name @@ p++primitiveType :: TTerm Primitive -> TTerm TypeScheme+primitiveType p = project _Primitive _Primitive_type @@ p++primitiveImplementation :: TTerm Primitive -> TTerm ([Term] -> Flow Graph Term)+primitiveImplementation p = project _Primitive _Primitive_implementation @@ p++primitiveWithType :: TTerm Primitive -> TTerm TypeScheme -> TTerm Primitive+primitiveWithType p newType = Hydra.Dsl.Graph.primitive+    (Hydra.Dsl.Graph.primitiveName p)+    newType+    (Hydra.Dsl.Graph.primitiveImplementation p)++typeClassEquality :: TTerm TypeClass+typeClassEquality = unitVariant _TypeClass _TypeClass_equality++typeClassOrdering :: TTerm TypeClass+typeClassOrdering = unitVariant _TypeClass _TypeClass_ordering
+ src/main/haskell/Hydra/Dsl/Json.hs view
@@ -0,0 +1,26 @@+module Hydra.Dsl.Json where++import Hydra.Kernel+import Hydra.Dsl.Phantoms+import Hydra.Json++import qualified Data.Map as M+++valueArray :: TTerm [Value] -> TTerm Value+valueArray = variant _Value _Value_array++valueBoolean :: TTerm Bool -> TTerm Value+valueBoolean = variant _Value _Value_boolean++valueNull :: TTerm Value+valueNull = unitVariant _Value _Value_null++valueNumber :: TTerm Double -> TTerm Value+valueNumber = variant _Value _Value_number++valueObject :: TTerm (M.Map String Value) -> TTerm Value+valueObject = variant _Value _Value_object++valueString :: TTerm String -> TTerm Value+valueString = variant _Value _Value_string
+ src/main/haskell/Hydra/Dsl/Lib/Chars.hs view
@@ -0,0 +1,31 @@+module Hydra.Dsl.Lib.Chars where++import Hydra.Dsl.Phantoms+import Hydra.Phantoms+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Terms as Terms+++-- Follow's GHC.s Data.Char.isAlphaNum+isAlphaNum :: TTerm Int -> TTerm Bool+isAlphaNum = primitive1 _chars_isAlphaNum++-- Follows GHC's Data.Char.isLower (GHC.Internal.Unicode.isLower)+isLower :: TTerm Int -> TTerm Bool+isLower = primitive1 _chars_isLower++-- Follow's GHC.s Data.Char.isSpace+isSpace :: TTerm Int -> TTerm Bool+isSpace = primitive1 _chars_isSpace++-- Follows GHC's Data.Char.isUpper (GHC.Internal.Unicode.isUpper)+isUpper :: TTerm Int -> TTerm Bool+isUpper = primitive1 _chars_isUpper++-- Follows GHC's toLower (GHC.Internal.Unicode.Char.UnicodeData.SimpleLowerCaseMapping.toSimpleLowerCase)+toLower :: TTerm Int -> TTerm Int+toLower = primitive1 _chars_toLower++-- Follows GHC's toUpper (GHC.Internal.Unicode.Char.UnicodeData.SimpleUpperCaseMapping.toSimpleUpperCase)+toUpper :: TTerm Int -> TTerm Int+toUpper = primitive1 _chars_toUpper
src/main/haskell/Hydra/Dsl/Lib/Equality.hs view
@@ -1,78 +1,38 @@ module Hydra.Dsl.Lib.Equality where  import Hydra.Core+import Hydra.Mantle import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  import Data.Int  -equal :: TTerm (a -> a -> Bool)-equal = TTerm $ Terms.primitive _equality_equal--equalBinary :: TTerm (String -> String -> Bool)-equalBinary = TTerm $ Terms.primitive _equality_equalBinary--equalBoolean :: TTerm (Bool -> Bool -> Bool)-equalBoolean = TTerm $ Terms.primitive _equality_equalBoolean--equalBigfloat :: TTerm (Double -> Double -> Bool)-equalBigfloat = TTerm $ Terms.primitive _equality_equalBigfloat--equalFloat32 :: TTerm (Float -> Float -> Bool)-equalFloat32 = TTerm $ Terms.primitive _equality_equalFloat32--equalFloat64 :: TTerm (Double -> Double -> Bool)-equalFloat64 = TTerm $ Terms.primitive _equality_equalFloat64--equalBigint :: TTerm (Integer -> Integer -> Bool)-equalBigint = TTerm $ Terms.primitive _equality_equalBigint--equalInt8 :: TTerm (Int8 -> Int8 -> Bool)-equalInt8 = TTerm $ Terms.primitive _equality_equalInt8--equalInt16 :: TTerm (Int16 -> Int16 -> Bool)-equalInt16 = TTerm $ Terms.primitive _equality_equalInt16--equalInt32 :: TTerm (Int -> Int -> Bool)-equalInt32 = TTerm $ Terms.primitive _equality_equalInt32--equalInt64 :: TTerm (Int64 -> Int64 -> Bool)-equalInt64 = TTerm $ Terms.primitive _equality_equalInt64--equalString :: TTerm (String -> String -> Bool)-equalString = TTerm $ Terms.primitive _equality_equalString--equalTerm :: TTerm (Term -> Term -> Bool)-equalTerm = TTerm $ Terms.primitive _equality_equalTerm--equalType :: TTerm (Type -> Type -> Bool)-equalType = TTerm $ Terms.primitive _equality_equalType--equalUint8 :: TTerm (Int16 -> Int16 -> Bool)-equalUint8 = TTerm $ Terms.primitive _equality_equalUint8+compare :: TTerm a -> TTerm a -> TTerm Comparison+compare = primitive2 _equality_compare -equalUint16 :: TTerm (Int -> Int -> Bool)-equalUint16 = TTerm $ Terms.primitive _equality_equalUint16+equal :: TTerm a -> TTerm a -> TTerm Bool+equal = primitive2 _equality_equal -equalUint32 :: TTerm (Int64 -> Int64 -> Bool)-equalUint32 = TTerm $ Terms.primitive _equality_equalUint32+gt :: TTerm a -> TTerm a -> TTerm Bool+gt = primitive2 _equality_gt -equalUint64 :: TTerm (Integer -> Integer -> Bool)-equalUint64 = TTerm $ Terms.primitive _equality_equalUint64+gte :: TTerm a -> TTerm a -> TTerm Bool+gte = primitive2 _equality_gte -identity :: TTerm (x -> x)-identity = TTerm $ Terms.primitive _equality_identity+identity :: TTerm a -> TTerm a+identity = primitive1 _equality_identity -gtInt32 :: TTerm (Int -> Int -> Bool)-gtInt32 = TTerm $ Terms.primitive _equality_gtInt32+lt :: TTerm a -> TTerm a -> TTerm Bool+lt = primitive2 _equality_lt -gteInt32 :: TTerm (Int -> Int -> Bool)-gteInt32 = TTerm $ Terms.primitive _equality_gteInt32+lte :: TTerm a -> TTerm a -> TTerm Bool+lte = primitive2 _equality_lte -ltInt32 :: TTerm (Int -> Int -> Bool)-ltInt32 = TTerm $ Terms.primitive _equality_ltInt32+max :: TTerm a -> TTerm a -> TTerm a+max = primitive2 _equality_max -lteInt32 :: TTerm (Int -> Int -> Bool)-lteInt32 = TTerm $ Terms.primitive _equality_lteInt32+min :: TTerm a -> TTerm a -> TTerm a+min = primitive2 _equality_min
src/main/haskell/Hydra/Dsl/Lib/Flows.hs view
@@ -1,6 +1,6 @@ module Hydra.Dsl.Lib.Flows where -import Hydra.Dsl.Base+import Hydra.Dsl.Phantoms import Hydra.Core import Hydra.Compute import Hydra.Phantoms@@ -9,62 +9,38 @@ import qualified Hydra.Dsl.Types as Types  import qualified Data.Map as M+import qualified Data.Set as S  --- Primitives--apply :: TTerm (Flow s (x -> y) -> Flow s x -> Flow s y)-apply = TTerm $ Terms.primitive _flows_apply--bind :: TTerm (Flow s x -> (x -> Flow s y) -> Flow s y)-bind = TTerm $ Terms.primitive _flows_bind--fail :: TTerm (String -> Flow s x)-fail = TTerm $ Terms.primitive _flows_fail--map :: TTerm ((x -> y) -> Flow s x -> Flow s y)-map = TTerm $ Terms.primitive _flows_map--mapList :: TTerm ((x -> Flow s y) -> [x] -> Flow s [y])-mapList = TTerm $ Terms.primitive _flows_mapList--pure :: TTerm (x -> Flow s x)-pure = TTerm $ Terms.primitive _flows_pure+apply :: TTerm (Flow s (x -> y)) -> TTerm (Flow s x) -> TTerm (Flow s y)+apply = primitive2 _flows_apply -sequence :: TTerm ([Flow s a] -> Flow s [a])-sequence = TTerm $ Terms.primitive _flows_sequence+bind :: TTerm (Flow s x) -> TTerm (x -> Flow s y) -> TTerm (Flow s y)+bind = primitive2 _flows_bind --- Accessors+fail :: TTerm String -> TTerm (Flow s x)+fail = primitive1 _flows_fail -flowState :: TTerm (Maybe x) -> TTerm s -> TTerm Trace -> TTerm (FlowState s x)-flowState value state trace = record _FlowState [-    _FlowState_value>>: value,-    _FlowState_state>>: state,-    _FlowState_trace>>: trace]+map :: TTerm (x -> y) -> TTerm (Flow s x) -> TTerm (Flow s y)+map = primitive2 _flows_map -flowStateState :: TTerm (FlowState s x -> s)-flowStateState = project _FlowState _FlowState_state+mapElems :: TTerm (v1 -> Flow s v2) -> TTerm (M.Map k v1) -> TTerm (Flow s (M.Map k v2))+mapElems = primitive2 _flows_mapElems -flowStateTrace :: TTerm (FlowState s x -> Trace)-flowStateTrace = project _FlowState _FlowState_trace+mapKeys :: TTerm (k1 -> Flow s k2) -> TTerm (M.Map k1 v) -> TTerm (Flow s (M.Map k2 v))+mapKeys = primitive2 _flows_mapKeys -flowStateValue :: TTerm (FlowState s x -> Maybe x)-flowStateValue = project _FlowState _FlowState_value+mapList :: TTerm (x -> Flow s y) -> TTerm [x] -> TTerm (Flow s [y])+mapList = primitive2 _flows_mapList -trace :: TTerm [String] -> TTerm [String] -> TTerm (M.Map String (Term)) -> TTerm Trace-trace stack messages other = record _Trace [-    _Trace_stack>>: stack,-    _Trace_messages>>: messages,-    _Trace_other>>: other]-    -traceStack :: TTerm (Trace -> [String])-traceStack = project _Trace _Trace_stack+mapOptional :: TTerm (x -> Flow s y) -> TTerm (Maybe x) -> TTerm (Flow s (Maybe y))+mapOptional = primitive2 _flows_mapOptional -traceMessages :: TTerm (Trace -> [String])-traceMessages = project _Trace _Trace_messages+mapSet :: TTerm (x -> Flow s y) -> TTerm (S.Set x) -> TTerm (Flow s (S.Set y))+mapSet = primitive2 _flows_mapSet -traceOther :: TTerm (Trace -> M.Map String (Term))-traceOther = project _Trace _Trace_other+pure :: TTerm x -> TTerm (Flow s x)+pure = primitive1 _flows_pure -unFlow :: TTerm (Flow s x -> s -> Trace -> FlowState s x)-unFlow = unwrap _Flow+sequence :: TTerm [Flow s a] -> TTerm (Flow s [a])+sequence = primitive1 _flows_sequence
− src/main/haskell/Hydra/Dsl/Lib/Io.hs 
@@ -1,13 +0,0 @@-module Hydra.Dsl.Lib.Io where--import Hydra.Core-import Hydra.Phantoms-import Hydra.Sources.Libraries-import qualified Hydra.Dsl.Terms as Terms---showTerm :: TTerm (Term -> String)-showTerm = TTerm $ Terms.primitive _io_showTerm--showType :: TTerm (Type -> String)-showType = TTerm $ Terms.primitive _io_showType
src/main/haskell/Hydra/Dsl/Lib/Lists.hs view
@@ -3,64 +3,107 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  -apply :: TTerm ([a -> b] -> [a] -> [b])-apply = TTerm $ Terms.primitive _lists_apply+apply :: TTerm [a -> b] -> TTerm [a] -> TTerm [b]+apply = primitive2 _lists_apply -at :: TTerm (Int -> [a] -> a)-at = TTerm $ Terms.primitive _lists_at+at :: TTerm Int -> TTerm [a] -> TTerm a+at = primitive2 _lists_at -bind :: TTerm ([a] -> (a -> [b]) -> [b])-bind = TTerm $ Terms.primitive _lists_bind+bind :: TTerm [a] -> TTerm (a -> [b]) -> TTerm [b]+bind = primitive2 _lists_bind -concat :: TTerm ([[a]] -> [a])-concat = TTerm $ Terms.primitive _lists_concat+concat :: TTerm [[a]] -> TTerm [a]+concat = primitive1 _lists_concat -concat2 :: TTerm ([a] -> [a] -> [a])-concat2 = TTerm $ Terms.primitive _lists_concat2+concat2 :: TTerm [a] -> TTerm [a] -> TTerm [a]+concat2 = primitive2 _lists_concat2 -cons :: TTerm (a -> [a] -> [a])-cons = TTerm $ Terms.primitive _lists_cons+cons :: TTerm a -> TTerm [a] -> TTerm [a]+cons = primitive2 _lists_cons -filter :: TTerm ((a -> Bool) -> [a] -> [a])-filter = TTerm $ Terms.primitive _lists_filter+drop :: TTerm Int -> TTerm [a] -> TTerm [a]+drop = primitive2 _lists_drop -foldl :: TTerm ((b -> a -> b) -> b -> [a] -> b)-foldl = TTerm $ Terms.primitive _lists_foldl+dropWhile :: TTerm (a -> Bool) -> TTerm [a] -> TTerm [a]+dropWhile = primitive2 _lists_dropWhile -head :: TTerm ([a] -> a)-head = TTerm $ Terms.primitive _lists_head+elem :: Eq a => TTerm a -> TTerm [a] -> TTerm Bool+elem = primitive2 _lists_elem -intercalate :: TTerm ([a] -> [[a]] -> [a])-intercalate = TTerm $ Terms.primitive _lists_intercalate+filter :: TTerm (a -> Bool) -> TTerm [a] -> TTerm [a]+filter = primitive2 _lists_filter -intersperse :: TTerm ([a] -> a -> [a])-intersperse = TTerm $ Terms.primitive _lists_intersperse+foldl :: TTerm (b -> a -> b) -> TTerm b -> TTerm [a] -> TTerm b+foldl = primitive3 _lists_foldl -last :: TTerm ([a] -> a)-last = TTerm $ Terms.primitive _lists_last+group :: Eq a => TTerm [a] -> TTerm [[a]]+group = primitive1 _lists_group -length :: TTerm ([a] -> Int)-length = TTerm $ Terms.primitive _lists_length+head :: TTerm [a] -> TTerm a+head = primitive1 _lists_head -map :: TTerm ((a -> b) -> [a] -> [b])-map = TTerm $ Terms.primitive _lists_map+init :: TTerm [a] -> TTerm [a]+init = primitive1 _lists_init -nub :: Eq a => TTerm ([a] -> [a])-nub = TTerm $ Terms.primitive _lists_nub+intercalate :: TTerm [a] -> TTerm [[a]] -> TTerm [a]+intercalate = primitive2 _lists_intercalate -null :: TTerm ([a] -> Bool)-null = TTerm $ Terms.primitive _lists_null+intersperse :: TTerm a -> TTerm [a] -> TTerm [a]+intersperse = primitive2 _lists_intersperse -pure :: TTerm (a -> [a])-pure = TTerm $ Terms.primitive _lists_pure+last :: TTerm [a] -> TTerm a+last = primitive1 _lists_last -reverse :: TTerm ([a] -> [a])-reverse = TTerm $ Terms.primitive _lists_reverse+length :: TTerm [a] -> TTerm Int+length = primitive1 _lists_length -safeHead :: TTerm ([a] -> Maybe a)-safeHead = TTerm $ Terms.primitive _lists_safeHead+map :: TTerm (a -> b) -> TTerm [a] -> TTerm [b]+map = primitive2 _lists_map -tail :: TTerm ([a] -> [a])-tail = TTerm $ Terms.primitive _lists_tail+nub :: Eq a => TTerm [a] -> TTerm [a]+nub = primitive1 _lists_nub++null :: TTerm [a] -> TTerm Bool+null = primitive1 _lists_null++pure :: TTerm a -> TTerm [a]+pure = primitive1 _lists_pure++replicate :: TTerm Int -> TTerm a -> TTerm [a]+replicate = primitive2 _lists_replicate++reverse :: TTerm [a] -> TTerm [a]+reverse = primitive1 _lists_reverse++safeHead :: TTerm [a] -> TTerm (Maybe a)+safeHead = primitive1 _lists_safeHead++singleton :: TTerm a -> TTerm [a]+singleton = primitive1 _lists_singleton++sort :: TTerm [a] -> TTerm [a]+sort = primitive1 _lists_sort++sortOn :: TTerm (a -> b) -> TTerm [a] -> TTerm [a]+sortOn = primitive2 _lists_sortOn++span :: TTerm (a -> Bool) -> TTerm [a] -> TTerm ([a], [a])+span = primitive2 _lists_span++tail :: TTerm [a] -> TTerm [a]+tail = primitive1 _lists_tail++take :: TTerm Int -> TTerm [a] -> TTerm [a]+take = primitive2 _lists_take++transpose :: TTerm [[a]] -> TTerm [[a]]+transpose = primitive1 _lists_transpose++zip :: TTerm [a] -> TTerm [b] -> TTerm [(a, b)]+zip = primitive2 _lists_zip++zipWith :: TTerm (a -> b -> c) -> TTerm [a] -> TTerm [b] -> TTerm [c]+zipWith = primitive3 _lists_zipWith
src/main/haskell/Hydra/Dsl/Lib/Literals.hs view
@@ -3,78 +3,142 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  import Data.Int  -bigfloatToBigint :: TTerm (Double -> Double)-bigfloatToBigint = TTerm $ Terms.primitive _literals_bigfloatToBigint+bigfloatToBigint :: TTerm Double -> TTerm Double+bigfloatToBigint = primitive1 _literals_bigfloatToBigint -bigfloatToFloat32 :: TTerm (Double -> Float)-bigfloatToFloat32 = TTerm $ Terms.primitive _literals_bigfloatToFloat32+bigfloatToFloat32 :: TTerm Double -> TTerm Float+bigfloatToFloat32 = primitive1 _literals_bigfloatToFloat32 -bigfloatToFloat64 :: TTerm (Double -> Double)-bigfloatToFloat64 = TTerm $ Terms.primitive _literals_bigfloatToFloat64+bigfloatToFloat64 :: TTerm Double -> TTerm Double+bigfloatToFloat64 = primitive1 _literals_bigfloatToFloat64 -bigintToBigfloat :: TTerm (Integer -> Double)-bigintToBigfloat = TTerm $ Terms.primitive _literals_bigintToBigfloat+bigintToBigfloat :: TTerm Integer -> TTerm Double+bigintToBigfloat = primitive1 _literals_bigintToBigfloat -bigintToInt8 :: TTerm (Integer -> Int8)-bigintToInt8 = TTerm $ Terms.primitive _literals_bigintToInt8+bigintToInt8 :: TTerm Integer -> TTerm Int8+bigintToInt8 = primitive1 _literals_bigintToInt8 -bigintToInt16 :: TTerm (Integer -> Int16)-bigintToInt16 = TTerm $ Terms.primitive _literals_bigintToInt16+bigintToInt16 :: TTerm Integer -> TTerm Int16+bigintToInt16 = primitive1 _literals_bigintToInt16 -bigintToInt32 :: TTerm (Integer -> Int)-bigintToInt32 = TTerm $ Terms.primitive _literals_bigintToInt32+bigintToInt32 :: TTerm Integer -> TTerm Int+bigintToInt32 = primitive1 _literals_bigintToInt32 -bigintToInt64 :: TTerm (Integer -> Int64)-bigintToInt64 = TTerm $ Terms.primitive _literals_bigintToInt64+bigintToInt64 :: TTerm Integer -> TTerm Int64+bigintToInt64 = primitive1 _literals_bigintToInt64 -bigintToUint8 :: TTerm (Integer -> Int16)-bigintToUint8 = TTerm $ Terms.primitive _literals_bigintToUint8+bigintToUint8 :: TTerm Integer -> TTerm Int16+bigintToUint8 = primitive1 _literals_bigintToUint8 -bigintToUint16 :: TTerm (Integer -> Int)-bigintToUint16 = TTerm $ Terms.primitive _literals_bigintToUint16+bigintToUint16 :: TTerm Integer -> TTerm Int+bigintToUint16 = primitive1 _literals_bigintToUint16 -bigintToUint32 :: TTerm (Integer -> Int64)-bigintToUint32 = TTerm $ Terms.primitive _literals_bigintToUint32+bigintToUint32 :: TTerm Integer -> TTerm Int64+bigintToUint32 = primitive1 _literals_bigintToUint32 -bigintToUint64 :: TTerm (Integer -> Integer)-bigintToUint64 = TTerm $ Terms.primitive _literals_bigintToUint64+bigintToUint64 :: TTerm Integer -> TTerm Integer+bigintToUint64 = primitive1 _literals_bigintToUint64 -float32ToBigfloat :: TTerm (Float -> Double)-float32ToBigfloat = TTerm $ Terms.primitive _literals_float32ToBigfloat+binaryToString :: TTerm String -> TTerm String+binaryToString = primitive1 _literals_binaryToString -float64ToBigfloat :: TTerm (Double -> Double)-float64ToBigfloat = TTerm $ Terms.primitive _literals_float64ToBigfloat+float32ToBigfloat :: TTerm Float -> TTerm Double+float32ToBigfloat = primitive1 _literals_float32ToBigfloat -int8ToBigint :: TTerm (Int8 -> Integer)-int8ToBigint = TTerm $ Terms.primitive _literals_int8ToBigint+float64ToBigfloat :: TTerm Double -> TTerm Double+float64ToBigfloat = primitive1 _literals_float64ToBigfloat -int16ToBigint :: TTerm (Int16 -> Integer)-int16ToBigint = TTerm $ Terms.primitive _literals_int16ToBigint+int8ToBigint :: TTerm Int8 -> TTerm Integer+int8ToBigint = primitive1 _literals_int8ToBigint -int32ToBigint :: TTerm (Int -> Integer)-int32ToBigint = TTerm $ Terms.primitive _literals_int32ToBigint+int16ToBigint :: TTerm Int16 -> TTerm Integer+int16ToBigint = primitive1 _literals_int16ToBigint -int64ToBigint :: TTerm (Int64 -> Integer)-int64ToBigint = TTerm $ Terms.primitive _literals_int64ToBigint+int32ToBigint :: TTerm Int -> TTerm Integer+int32ToBigint = primitive1 _literals_int32ToBigint -showInt32 :: TTerm (Int -> String)-showInt32 = TTerm $ Terms.primitive _literals_showInt32+int64ToBigint :: TTerm Int64 -> TTerm Integer+int64ToBigint = primitive1 _literals_int64ToBigint -showString :: TTerm (String -> String)-showString = TTerm $ Terms.primitive _literals_showString+readBigfloat :: TTerm String -> TTerm (Maybe Double)+readBigfloat = primitive1 _literals_readBigfloat -uint8ToBigint :: TTerm (Int16 -> Integer)-uint8ToBigint = TTerm $ Terms.primitive _literals_uint8ToBigint+readBoolean :: TTerm String -> TTerm (Maybe Bool)+readBoolean = primitive1 _literals_readBoolean -uint16ToBigint :: TTerm (Int -> Integer)-uint16ToBigint = TTerm $ Terms.primitive _literals_uint16ToBigint+readFloat32 :: TTerm String -> TTerm (Maybe Float)+readFloat32 = primitive1 _literals_readFloat32 -uint32ToBigint :: TTerm (Int64 -> Integer)-uint32ToBigint = TTerm $ Terms.primitive _literals_uint32ToBigint+readFloat64 :: TTerm String -> TTerm (Maybe Double)+readFloat64 = primitive1 _literals_readFloat64 -uint64ToBigint :: TTerm (Integer -> Integer)-uint64ToBigint = TTerm $ Terms.primitive _literals_uint64ToBigint+readInt32 :: TTerm String -> TTerm (Maybe Int)+readInt32 = primitive1 _literals_readInt32++readInt64 :: TTerm String -> TTerm (Maybe Int64)+readInt64 = primitive1 _literals_readInt64++readString :: TTerm String -> TTerm (Maybe String)+readString = primitive1 _literals_readString++showBigfloat :: TTerm Double -> TTerm String+showBigfloat = primitive1 _literals_showBigfloat++showBigint :: TTerm Integer -> TTerm String+showBigint = primitive1 _literals_showBigint++showBoolean :: TTerm Bool -> TTerm String+showBoolean = primitive1 _literals_showBoolean++showFloat32 :: TTerm Float -> TTerm String+showFloat32 = primitive1 _literals_showFloat32++showFloat64 :: TTerm Double -> TTerm String+showFloat64 = primitive1 _literals_showFloat64++showInt8 :: TTerm Int8 -> TTerm String+showInt8 = primitive1 _literals_showInt8++showInt16 :: TTerm Int16 -> TTerm String+showInt16 = primitive1 _literals_showInt16++showInt32 :: TTerm Int -> TTerm String+showInt32 = primitive1 _literals_showInt32++showInt64 :: TTerm Int64 -> TTerm String+showInt64 = primitive1 _literals_showInt64++showUint8 :: TTerm Int16 -> TTerm String+showUint8 = primitive1 _literals_showUint8++showUint16 :: TTerm Int -> TTerm String+showUint16 = primitive1 _literals_showUint16++showUint32 :: TTerm Int64 -> TTerm String+showUint32 = primitive1 _literals_showUint32++showUint64 :: TTerm Integer -> TTerm String+showUint64 = primitive1 _literals_showUint64++showString :: TTerm String -> TTerm String+showString = primitive1 _literals_showString++stringToBinary :: TTerm String -> TTerm String+stringToBinary = primitive1 _literals_stringToBinary++uint8ToBigint :: TTerm Int16 -> TTerm Integer+uint8ToBigint = primitive1 _literals_uint8ToBigint++uint16ToBigint :: TTerm Int -> TTerm Integer+uint16ToBigint = primitive1 _literals_uint16ToBigint++uint32ToBigint :: TTerm Int64 -> TTerm Integer+uint32ToBigint = primitive1 _literals_uint32ToBigint++uint64ToBigint :: TTerm Integer -> TTerm Integer+uint64ToBigint = primitive1 _literals_uint64ToBigint
src/main/haskell/Hydra/Dsl/Lib/Logic.hs view
@@ -4,16 +4,26 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms as Phantoms  -and :: TTerm (Bool -> Bool -> Bool)-and = TTerm $ Terms.primitive _logic_and+and :: TTerm Bool -> TTerm Bool -> TTerm Bool+and = primitive2 _logic_and -ifElse :: TTerm (a -> a -> Bool -> a)-ifElse = TTerm $ Terms.primitive _logic_ifElse+ifElse :: TTerm Bool -> TTerm a -> TTerm a -> TTerm a+ifElse = primitive3 _logic_ifElse -not :: TTerm (Bool -> Bool)-not = TTerm $ Terms.primitive _logic_not+not :: TTerm Bool -> TTerm Bool+not = primitive1 _logic_not -or :: TTerm (Bool -> Bool -> Bool)-or = TTerm $ Terms.primitive _logic_or+or :: TTerm Bool -> TTerm Bool -> TTerm Bool+or = primitive2 _logic_or++----------------------------------------+-- Helpers which are not primitives++ands :: TTerm [Bool] -> TTerm Bool+ands terms = Phantoms.fold (primitive _logic_and) @@ true @@ terms++ors :: TTerm [Bool] -> TTerm Bool+ors terms = Phantoms.fold (primitive _logic_or) @@ false @@ terms
src/main/haskell/Hydra/Dsl/Lib/Maps.hs view
@@ -3,45 +3,67 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  import Data.Map  +alter :: TTerm (Maybe v -> Maybe v) -> TTerm k -> TTerm (Map k v) -> TTerm (Map k v)+alter = primitive3 _maps_alter++bimap :: TTerm (k1 -> k2) -> TTerm (v1 -> v2) -> TTerm (Map k1 v1) -> TTerm (Map k2 v2)+bimap = primitive3 _maps_bimap++elems :: TTerm (Map k v) -> TTerm [v]+elems = primitive1 _maps_elems+ empty :: TTerm (Map k v)-empty = TTerm $ Terms.primitive _maps_empty+empty = primitive _maps_empty -fromList :: TTerm ([(k, v)] -> Map k v)-fromList = TTerm $ Terms.primitive _maps_fromList+filter :: TTerm (v -> Bool) -> TTerm (Map k v) -> TTerm (Map k v)+filter = primitive2 _maps_filter -insert :: TTerm (k -> v -> Map k v -> Map k v)-insert = TTerm $ Terms.primitive _maps_insert+filterWithKey :: TTerm (k -> v -> Bool) -> TTerm (Map k v) -> TTerm (Map k v)+filterWithKey = primitive2 _maps_filterWithKey -isEmpty :: TTerm (Map k v -> Bool)-isEmpty = TTerm $ Terms.primitive _maps_isEmpty+findWithDefault :: TTerm v -> TTerm k -> TTerm (Map k v) -> TTerm v+findWithDefault = primitive3 _maps_findWithDefault -keys :: TTerm (Map k v -> [k])-keys = TTerm $ Terms.primitive _maps_keys+fromList :: TTerm [(k, v)] -> TTerm (Map k v)+fromList = primitive1 _maps_fromList -lookup :: TTerm (k -> Map k v -> Maybe v)-lookup = TTerm $ Terms.primitive _maps_lookup+insert :: TTerm k -> TTerm v -> TTerm (Map k v) -> TTerm (Map k v)+insert = primitive3 _maps_insert -map :: TTerm ((v1 -> v2) -> Map k v1 -> Map k v2)-map = TTerm $ Terms.primitive _maps_map+keys :: TTerm (Map k v) -> TTerm [k]+keys = primitive1 _maps_keys -mapKeys :: TTerm ((k1 -> k2) -> Map k1 v -> Map k2 v)-mapKeys = TTerm $ Terms.primitive _maps_mapKeys+lookup :: TTerm k -> TTerm (Map k v) -> TTerm (Maybe v)+lookup = primitive2 _maps_lookup -remove :: TTerm (k -> Map k v -> Map k v)-remove = TTerm $ Terms.primitive _maps_remove+map :: TTerm (v1 -> v2) -> TTerm (Map k v1) -> TTerm (Map k v2)+map = primitive2 _maps_map -singleton :: TTerm (k -> v -> Map k v)-singleton = TTerm $ Terms.primitive _maps_singleton+mapKeys :: TTerm (k1 -> k2) -> TTerm (Map k1 v) -> TTerm (Map k2 v)+mapKeys = primitive2 _maps_mapKeys -size :: TTerm (Map k v -> Int)-size = TTerm $ Terms.primitive _maps_size+member :: TTerm k -> TTerm (Map k v) -> TTerm Bool+member = primitive2 _maps_member -toList :: TTerm (Map k v -> [(k, v)])-toList = TTerm $ Terms.primitive _maps_toList+null :: TTerm (Map k v) -> TTerm Bool+null = primitive1 _maps_null -values :: TTerm (Map k v -> [v])-values = TTerm $ Terms.primitive _maps_values+remove :: TTerm k -> TTerm (Map k v) -> TTerm (Map k v)+remove = primitive2 _maps_remove++singleton :: TTerm k -> TTerm v -> TTerm (Map k v)+singleton = primitive2 _maps_singleton++size :: TTerm (Map k v) -> TTerm Int+size = primitive1 _maps_size++toList :: TTerm (Map k v) -> TTerm [(k, v)]+toList = primitive1 _maps_toList++union :: TTerm (Map k v) -> TTerm (Map k v) -> TTerm (Map k v)+union = primitive2 _maps_union
src/main/haskell/Hydra/Dsl/Lib/Math.hs view
@@ -3,25 +3,29 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  -add :: TTerm (Int -> Int -> Int)-add = TTerm $ Terms.primitive _math_add+add :: TTerm a -> TTerm a -> TTerm a+add = primitive2 _math_add -div :: TTerm (Int -> Int -> Int)-div = TTerm $ Terms.primitive _math_div+div :: TTerm a -> TTerm a -> TTerm a+div = primitive2 _math_div -mod :: TTerm (Int -> Int -> Int)-mod = TTerm $ Terms.primitive _math_mod+mod :: TTerm a -> TTerm a -> TTerm a+mod = primitive2 _math_mod -mul :: TTerm (Int -> Int -> Int)-mul = TTerm $ Terms.primitive _math_mul+mul :: TTerm a -> TTerm a -> TTerm a+mul = primitive2 _math_mul -neg :: TTerm (Int -> Int)-neg = TTerm $ Terms.primitive _math_neg+neg :: TTerm a -> TTerm a+neg = primitive1 _math_neg -rem :: TTerm (Int -> Int -> Int)-rem = TTerm $ Terms.primitive _math_rem+range :: TTerm a -> TTerm a -> TTerm [a]+range start end = primitive2 _math_range start end -sub :: TTerm (Int -> Int -> Int)-sub = TTerm $ Terms.primitive _math_sub+rem :: TTerm a -> TTerm a -> TTerm a+rem = primitive2 _math_rem++sub :: TTerm a -> TTerm a -> TTerm a+sub = primitive2 _math_sub
src/main/haskell/Hydra/Dsl/Lib/Optionals.hs view
@@ -3,34 +3,44 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  -apply :: TTerm (Maybe (a -> b) -> Maybe a -> Maybe b)-apply = TTerm $ Terms.primitive _optionals_apply+apply :: TTerm (Maybe (a -> b)) -> TTerm (Maybe a) -> TTerm (Maybe b)+apply = primitive2 _optionals_apply -bind :: TTerm (Maybe a -> (a -> Maybe b) -> Maybe b)-bind = TTerm $ Terms.primitive _optionals_bind+bind :: TTerm (Maybe a) -> TTerm (a -> Maybe b) -> TTerm (Maybe b)+bind = primitive2 _optionals_bind -cat :: TTerm ([Maybe a] -> [a])-cat = TTerm $ Terms.primitive _optionals_cat+cases :: TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b+cases = primitive3 _optionals_cases -compose :: TTerm ((a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c))-compose = TTerm $ Terms.primitive _optionals_compose+cat :: TTerm [Maybe a] -> TTerm [a]+cat = primitive1 _optionals_cat -fromMaybe :: TTerm (a -> Maybe a -> a)-fromMaybe = TTerm $ Terms.primitive _optionals_fromMaybe+compose :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (a -> Maybe c)+compose = primitive2 _optionals_compose -isJust :: TTerm (Maybe a -> Bool)-isJust = TTerm $ Terms.primitive _optionals_isJust+fromJust :: TTerm (Maybe a) -> TTerm a+fromJust = primitive1 _optionals_fromJust -isNothing :: TTerm (Maybe a -> Bool)-isNothing = TTerm $ Terms.primitive _optionals_isNothing+fromMaybe :: TTerm a -> TTerm (Maybe a) -> TTerm a+fromMaybe = primitive2 _optionals_fromMaybe -map :: TTerm ((a -> b) -> Maybe a -> Maybe b)-map = TTerm $ Terms.primitive _optionals_map+isJust :: TTerm (Maybe a) -> TTerm Bool+isJust = primitive1 _optionals_isJust -maybe :: TTerm (b -> (a -> b) -> Maybe a -> b)-maybe = TTerm $ Terms.primitive _optionals_maybe+isNothing :: TTerm (Maybe a) -> TTerm Bool+isNothing = primitive1 _optionals_isNothing -pure :: TTerm (a -> Maybe a)-pure = TTerm $ Terms.primitive _optionals_pure+map :: TTerm (a -> b) -> TTerm (Maybe a) -> TTerm (Maybe b)+map = primitive2 _optionals_map++mapMaybe :: TTerm (a -> Maybe b) -> TTerm [a] -> TTerm [b]+mapMaybe = primitive2 _optionals_mapMaybe++maybe :: TTerm b -> TTerm (a -> b) -> TTerm (Maybe a) -> TTerm b+maybe = primitive3 _optionals_maybe++pure :: TTerm a -> TTerm (Maybe a)+pure = primitive1 _optionals_pure
src/main/haskell/Hydra/Dsl/Lib/Sets.hs view
@@ -3,45 +3,49 @@ import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms  import Data.Set  -contains :: TTerm (a -> Set a -> Bool)-contains = TTerm $ Terms.primitive _sets_contains+delete :: TTerm a -> TTerm (Set a) -> TTerm (Set a)+delete = primitive2 _sets_delete -difference :: TTerm (Set a -> Set a -> Set a)-difference = TTerm $ Terms.primitive _sets_difference+difference :: TTerm (Set a) -> TTerm (Set a) -> TTerm (Set a)+difference = primitive2 _sets_difference  empty :: TTerm (Set a)-empty = TTerm $ Terms.primitive _sets_empty+empty = primitive _sets_empty -fromList :: TTerm ([a] -> Set a)-fromList = TTerm $ Terms.primitive _sets_fromList+fromList :: TTerm [a] -> TTerm (Set a)+fromList = primitive1 _sets_fromList -insert :: TTerm (a -> Set a -> Set a)-insert = TTerm $ Terms.primitive _sets_insert+insert :: TTerm a -> TTerm (Set a) -> TTerm (Set a)+insert = primitive2 _sets_insert -intersection :: TTerm (Set a -> Set a -> Set a)-intersection = TTerm $ Terms.primitive _sets_intersection+intersection :: TTerm (Set a) -> TTerm (Set a) -> TTerm (Set a)+intersection = primitive2 _sets_intersection -isEmpty :: TTerm (Set a -> Bool)-isEmpty = TTerm $ Terms.primitive _sets_isEmpty+map :: TTerm (a -> b) -> TTerm (Set a) -> TTerm (Set b)+map = primitive2 _sets_map -map :: TTerm ((a -> b) -> Set a -> Set b)-map = TTerm $ Terms.primitive _sets_map+member :: TTerm a -> TTerm (Set a) -> TTerm Bool+member = primitive2 _sets_member -remove :: TTerm (a -> Set a -> Set a)-remove = TTerm $ Terms.primitive _sets_remove+null :: TTerm (Set a) -> TTerm Bool+null = primitive1 _sets_null -singleton :: TTerm (a -> Set a)-singleton = TTerm $ Terms.primitive _sets_singleton+singleton :: TTerm a -> TTerm (Set a)+singleton = primitive1 _sets_singleton -size :: TTerm (Set a -> Int)-size = TTerm $ Terms.primitive _sets_size+size :: TTerm (Set a) -> TTerm Int+size = primitive1 _sets_size -toList :: TTerm (Set a -> [a])-toList = TTerm $ Terms.primitive _sets_toList+toList :: TTerm (Set a) -> TTerm [a]+toList = primitive1 _sets_toList -union :: TTerm (Set a -> Set a -> Set a)-union = TTerm $ Terms.primitive _sets_union+union :: TTerm (Set a) -> TTerm (Set a) -> TTerm (Set a)+union = primitive2 _sets_union++unions :: TTerm [Set a] -> TTerm (Set a)+unions = primitive1 _sets_unions
src/main/haskell/Hydra/Dsl/Lib/Strings.hs view
@@ -1,45 +1,55 @@ module Hydra.Dsl.Lib.Strings where -import Hydra.Dsl.Base+import Hydra.Dsl.Phantoms import Hydra.Phantoms import Hydra.Sources.Libraries import qualified Hydra.Dsl.Terms as Terms+import Hydra.Dsl.Phantoms   (++) :: TTerm String -> TTerm String -> TTerm String-l ++ r = (TTerm $ Terms.primitive _strings_cat) @@ (list [l, r])+l ++ r = (primitive _strings_cat) @@ (list [l, r]) -cat :: TTerm ([String] -> String)-cat = TTerm $ Terms.primitive _strings_cat+cat :: TTerm [String] -> TTerm String+cat = primitive1 _strings_cat -cat2 :: TTerm (String -> String -> String)-cat2 = TTerm $ Terms.primitive _strings_cat2+cat2 :: TTerm String -> TTerm String -> TTerm String+cat2 = primitive2 _strings_cat2 -fromList :: TTerm ([Int] -> String)-fromList = TTerm $ Terms.primitive _strings_fromList+charAt :: TTerm Int -> TTerm String -> TTerm Int+charAt = primitive2 _strings_charAt -intercalate :: TTerm (String -> [String] -> String)-intercalate = TTerm $ Terms.primitive _strings_intercalate+fromList :: TTerm [Int] -> TTerm String+fromList = primitive1 _strings_fromList -isEmpty :: TTerm (String -> Bool)-isEmpty = TTerm $ Terms.primitive _strings_isEmpty+intercalate :: TTerm String -> TTerm [String] -> TTerm String+intercalate = primitive2 _strings_intercalate -length :: TTerm (String -> Int)-length = TTerm $ Terms.primitive _strings_length+length :: TTerm String -> TTerm Int+length = primitive1 _strings_length -splitOn :: TTerm (String -> String -> [String])-splitOn = TTerm $ Terms.primitive _strings_splitOn+lines :: TTerm String -> TTerm [String]+lines = primitive1 _strings_lines -toList :: TTerm (String -> [Int])-toList = TTerm $ Terms.primitive _strings_toList+null :: TTerm String -> TTerm Bool+null = primitive1 _strings_null -toLower :: TTerm (String -> String)-toLower = TTerm $ Terms.primitive _strings_toLower+splitOn :: TTerm String -> TTerm String -> TTerm [String]+splitOn = primitive2 _strings_splitOn -toUpper :: TTerm (String -> String)-toUpper = TTerm $ Terms.primitive _strings_toUpper+toList :: TTerm String -> TTerm [Int]+toList = primitive1 _strings_toList +toLower :: TTerm String -> TTerm String+toLower = primitive1 _strings_toLower++toUpper :: TTerm String -> TTerm String+toUpper = primitive1 _strings_toUpper++unlines :: TTerm [String] -> TTerm String+unlines = primitive1 _strings_unlines+ -- Helpers  concat :: [TTerm String] -> TTerm String-concat strings = (TTerm $ Terms.primitive _strings_cat) @@ list strings+concat strings = primitive _strings_cat @@ list strings
src/main/haskell/Hydra/Dsl/LiteralTypes.hs view
@@ -1,57 +1,91 @@--- | A DSL of short names for literal types+-- | A DSL for Hydra literal types in Haskell  module Hydra.Dsl.LiteralTypes where  import Hydra.Core  +-- | Arbitrary-precision floating point type+-- Example: bigfloat bigfloat :: LiteralType bigfloat = float FloatTypeBigfloat +-- | Arbitrary-precision integer type+-- Example: bigint bigint :: LiteralType bigint = LiteralTypeInteger IntegerTypeBigint +-- | Binary data type+-- Example: binary binary :: LiteralType binary = LiteralTypeBinary +-- | Boolean type+-- Example: boolean boolean :: LiteralType boolean = LiteralTypeBoolean +-- | 32-bit floating point type+-- Example: float32 float32 :: LiteralType float32 = float FloatTypeFloat32 +-- | 64-bit floating point type+-- Example: float64 float64 :: LiteralType float64 = float FloatTypeFloat64 +-- | Create a floating point type with the specified precision+-- Example: float FloatTypeFloat32 float :: FloatType -> LiteralType float = LiteralTypeFloat +-- | 16-bit signed integer type+-- Example: int16 int16 :: LiteralType int16 = integer IntegerTypeInt16 +-- | 32-bit signed integer type+-- Example: int32 int32 :: LiteralType int32 = integer IntegerTypeInt32 +-- | 64-bit signed integer type+-- Example: int64 int64 :: LiteralType int64 = integer IntegerTypeInt64 +-- | 8-bit signed integer type+-- Example: int8 int8 :: LiteralType int8 = integer IntegerTypeInt8 +-- | Create an integer type with the specified bit width+-- Example: integer IntegerTypeInt32 integer :: IntegerType -> LiteralType integer = LiteralTypeInteger +-- | String type+-- Example: string string :: LiteralType string = LiteralTypeString +-- | 16-bit unsigned integer type+-- Example: uint16 uint16 :: LiteralType uint16 = integer IntegerTypeUint16 +-- | 32-bit unsigned integer type+-- Example: uint32 uint32 :: LiteralType uint32 = integer IntegerTypeUint32 +-- | 64-bit unsigned integer type+-- Example: uint64 uint64 :: LiteralType uint64 = integer IntegerTypeUint64 +-- | 8-bit unsigned integer type+-- Example: uint8 uint8 :: LiteralType uint8 = integer IntegerTypeUint8
src/main/haskell/Hydra/Dsl/Literals.hs view
@@ -1,4 +1,4 @@--- | A DSL for constructing literal values+-- | A DSL for constructing Hydra literal values in Haskell  module Hydra.Dsl.Literals where @@ -7,53 +7,87 @@ import Data.Int  +-- | Create an arbitrary-precision floating point literal+-- Example: bigfloat 3.14159265359 bigfloat :: Double -> Literal bigfloat = float . FloatValueBigfloat +-- | Create an arbitrary-precision integer literal+-- Example: bigint 9223372036854775808 bigint :: Integer -> Literal bigint = integer . IntegerValueBigint . fromIntegral +-- | Create a binary data literal+-- Example: binary "\x48\x65\x6C\x6C\x6F" binary :: String -> Literal binary = LiteralBinary +-- | Create a boolean literal+-- Example: boolean True boolean :: Bool -> Literal boolean = LiteralBoolean +-- | Create a 32-bit floating point literal+-- Example: float32 3.14 float32 :: Float -> Literal float32 = float . FloatValueFloat32 +-- | Create a 64-bit floating point literal+-- Example: float64 3.14159265359 float64 :: Double -> Literal float64 = float . FloatValueFloat64 +-- | Create a floating-point literal with specified precision+-- Example: float (FloatValueFloat32 3.14) float :: FloatValue -> Literal float = LiteralFloat +-- | Create a 16-bit signed integer literal+-- Example: int16 32767 int16 :: Int16 -> Literal int16 = integer . IntegerValueInt16 . fromIntegral +-- | Create a 32-bit signed integer literal+-- Example: int32 42 int32 :: Int -> Literal int32 = integer . IntegerValueInt32 +-- | Create a 64-bit signed integer literal+-- Example: int64 9223372036854775807 int64 :: Int64 -> Literal int64 = integer . IntegerValueInt64 . fromIntegral +-- | Create an 8-bit signed integer literal+-- Example: int8 127 int8 :: Int8 -> Literal int8 = integer . IntegerValueInt8 . fromIntegral +-- | Create an integer literal with specified bit width+-- Example: integer (IntegerValueInt32 42) integer :: IntegerValue -> Literal integer = LiteralInteger +-- | Create a string literal+-- Example: string "hello world" string :: String -> Literal string = LiteralString +-- | Create a 16-bit unsigned integer literal+-- Example: uint16 65535 uint16 :: Int -> Literal uint16 = integer . IntegerValueUint16 . fromIntegral +-- | Create a 32-bit unsigned integer literal+-- Example: uint32 4294967295 uint32 :: Int64 -> Literal uint32 = integer . IntegerValueUint32 . fromIntegral +-- | Create a 64-bit unsigned integer literal+-- Example: uint64 18446744073709551615 uint64 :: Integer -> Literal uint64 = integer . IntegerValueUint64 . fromIntegral +-- | Create an 8-bit unsigned integer literal+-- Example: uint8 255 uint8 :: Int16 -> Literal uint8 = integer . IntegerValueUint8 . fromIntegral
src/main/haskell/Hydra/Dsl/Mantle.hs view
@@ -1,13 +1,118 @@ module Hydra.Dsl.Mantle where  import Hydra.Kernel-import Hydra.Dsl.Base as Base-import Hydra.Dsl.Core+import Hydra.Dsl.Phantoms+import Hydra.Mantle  import qualified Data.Map as M import qualified Data.Maybe as Y  +accessorEdge :: TTerm AccessorNode -> TTerm AccessorPath -> TTerm AccessorNode -> TTerm AccessorEdge+accessorEdge source path target = record _AccessorEdge [+  _AccessorEdge_source>>: source,+  _AccessorEdge_path>>: path,+  _AccessorEdge_target>>: target]++accessorEdgeSource = unitVariant _AccessorEdge _AccessorEdge_source+accessorEdgePath = unitVariant _AccessorEdge _AccessorEdge_path+accessorEdgeTarget = unitVariant _AccessorEdge _AccessorEdge_target++accessorGraph :: TTerm [AccessorNode] -> TTerm [AccessorEdge] -> TTerm AccessorGraph+accessorGraph nodes edges = record _AccessorGraph [+  _AccessorGraph_nodes>>: nodes,+  _AccessorGraph_edges>>: edges]++accessorGraphNodes = unitVariant _AccessorGraph _AccessorGraph_nodes+accessorGraphEdges = unitVariant _AccessorGraph _AccessorGraph_edges++accessorNode :: TTerm Name -> TTerm String -> TTerm String -> TTerm AccessorNode+accessorNode name label id = record _AccessorNode [+  _AccessorNode_name>>: name,+  _AccessorNode_label>>: label,+  _AccessorNode_id>>: id]++accessorNodeName = unitVariant _AccessorNode _AccessorNode_name+accessorNodeLabel = unitVariant _AccessorNode _AccessorNode_label+accessorNodeId = unitVariant _AccessorNode _AccessorNode_id++accessorPath :: TTerm [TermAccessor] -> TTerm AccessorPath+accessorPath path = wrap _AccessorPath path++caseConventionCamel = unitVariant _CaseConvention _CaseConvention_camel+caseConventionPascal = unitVariant _CaseConvention _CaseConvention_pascal+caseConventionLowerSnake = unitVariant _CaseConvention _CaseConvention_lowerSnake+caseConventionUpperSnake = unitVariant _CaseConvention _CaseConvention_upperSnake++eitherLeft :: TTerm a -> TTerm (Hydra.Mantle.Either a b)+eitherLeft = variant _Either _Either_left++eitherRight :: TTerm b -> TTerm (Hydra.Mantle.Either a b)+eitherRight = variant _Either _Either_right++eliminationVariant :: EliminationVariant -> TTerm EliminationVariant+eliminationVariant v = unitVariant _EliminationVariant $ case v of+  EliminationVariantProduct -> _EliminationVariant_product+  EliminationVariantRecord -> _EliminationVariant_record+  EliminationVariantUnion -> _EliminationVariant_union+  EliminationVariantWrap -> _EliminationVariant_wrap++eliminationVariantProduct :: TTerm EliminationVariant+eliminationVariantProduct = unitVariant _EliminationVariant _EliminationVariant_product++eliminationVariantRecord :: TTerm EliminationVariant+eliminationVariantRecord = unitVariant _EliminationVariant _EliminationVariant_record++eliminationVariantUnion :: TTerm EliminationVariant+eliminationVariantUnion = unitVariant _EliminationVariant _EliminationVariant_union++eliminationVariantWrap :: TTerm EliminationVariant+eliminationVariantWrap = unitVariant _EliminationVariant _EliminationVariant_wrap++functionVariant :: FunctionVariant -> TTerm FunctionVariant+functionVariant v = unitVariant _FunctionVariant $ case v of+  FunctionVariantElimination -> _FunctionVariant_elimination+  FunctionVariantLambda -> _FunctionVariant_lambda+  FunctionVariantPrimitive -> _FunctionVariant_primitive++functionVariantElimination :: TTerm FunctionVariant+functionVariantElimination = unitVariant _FunctionVariant _FunctionVariant_elimination++functionVariantLambda :: TTerm FunctionVariant+functionVariantLambda = unitVariant _FunctionVariant _FunctionVariant_lambda++functionVariantPrimitive :: TTerm FunctionVariant+functionVariantPrimitive = unitVariant _FunctionVariant _FunctionVariant_primitive++literalVariant :: LiteralVariant -> TTerm LiteralVariant+literalVariant v = unitVariant _LiteralVariant $ case v of+  LiteralVariantBinary -> _LiteralVariant_binary+  LiteralVariantBoolean -> _LiteralVariant_boolean+  LiteralVariantFloat -> _LiteralVariant_float+  LiteralVariantInteger -> _LiteralVariant_integer+  LiteralVariantString -> _LiteralVariant_string++literalVariantBinary :: TTerm LiteralVariant+literalVariantBinary = unitVariant _LiteralVariant _LiteralVariant_binary++literalVariantBoolean :: TTerm LiteralVariant+literalVariantBoolean = unitVariant _LiteralVariant _LiteralVariant_boolean++literalVariantFloat :: TTerm LiteralVariant+literalVariantFloat = unitVariant _LiteralVariant _LiteralVariant_float++literalVariantInteger :: TTerm LiteralVariant+literalVariantInteger = unitVariant _LiteralVariant _LiteralVariant_integer++literalVariantString :: TTerm LiteralVariant+literalVariantString = unitVariant _LiteralVariant _LiteralVariant_string++precisionArbitrary :: TTerm Precision+precisionArbitrary = unitVariant _Precision _Precision_arbitrary++precisionBits :: TTerm Int -> TTerm Precision+precisionBits = variant _Precision _Precision_bits+ termAccessorAnnotatedSubject :: TTerm TermAccessor termAccessorAnnotatedSubject = unitVariant _TermAccessor _TermAccessor_annotatedSubject @@ -20,15 +125,6 @@ termAccessorLambdaBody :: TTerm TermAccessor termAccessorLambdaBody = unitVariant _TermAccessor _TermAccessor_lambdaBody -termAccessorListFold :: TTerm TermAccessor-termAccessorListFold = unitVariant _TermAccessor _TermAccessor_listFold--termAccessorOptionalCasesNothing :: TTerm TermAccessor-termAccessorOptionalCasesNothing = unitVariant _TermAccessor _TermAccessor_optionalCasesNothing--termAccessorOptionalCasesJust :: TTerm TermAccessor-termAccessorOptionalCasesJust = unitVariant _TermAccessor _TermAccessor_optionalCasesJust- termAccessorUnionCasesDefault :: TTerm TermAccessor termAccessorUnionCasesDefault = unitVariant _TermAccessor _TermAccessor_unionCasesDefault @@ -65,17 +161,158 @@ termAccessorSumTerm :: TTerm TermAccessor termAccessorSumTerm = unitVariant _TermAccessor _TermAccessor_sumTerm -termAccessorTypeAbstractionBody :: TTerm TermAccessor-termAccessorTypeAbstractionBody = unitVariant _TermAccessor _TermAccessor_typeAbstractionBody+termAccessorTypeLambdaBody :: TTerm TermAccessor+termAccessorTypeLambdaBody = unitVariant _TermAccessor _TermAccessor_typeLambdaBody  termAccessorTypeApplicationTerm :: TTerm TermAccessor termAccessorTypeApplicationTerm = unitVariant _TermAccessor _TermAccessor_typeApplicationTerm -termAccessorTypedTerm :: TTerm TermAccessor-termAccessorTypedTerm = unitVariant _TermAccessor _TermAccessor_typedTerm- termAccessorInjectionTerm :: TTerm TermAccessor termAccessorInjectionTerm = unitVariant _TermAccessor _TermAccessor_injectionTerm  termAccessorWrappedTerm :: TTerm TermAccessor termAccessorWrappedTerm = unitVariant _TermAccessor _TermAccessor_wrappedTerm++termVariant :: TermVariant -> TTerm TermVariant+termVariant v = unitVariant _TermVariant $ case v of+  TermVariantAnnotated -> _TermVariant_annotated+  TermVariantApplication -> _TermVariant_application+  TermVariantFunction -> _TermVariant_function+  TermVariantLet -> _TermVariant_let+  TermVariantList -> _TermVariant_list+  TermVariantLiteral -> _TermVariant_literal+  TermVariantMap -> _TermVariant_map+  TermVariantOptional -> _TermVariant_optional+  TermVariantProduct -> _TermVariant_product+  TermVariantRecord -> _TermVariant_record+  TermVariantSet -> _TermVariant_set+  TermVariantSum -> _TermVariant_sum+  TermVariantTypeLambda -> _TermVariant_typeLambda+  TermVariantTypeApplication -> _TermVariant_typeApplication+  TermVariantUnion -> _TermVariant_union+  TermVariantUnit -> _TermVariant_unit+  TermVariantVariable -> _TermVariant_variable+  TermVariantWrap -> _TermVariant_wrap++termVariantAnnotated :: TTerm TermVariant+termVariantAnnotated = unitVariant _TermVariant _TermVariant_annotated++termVariantApplication :: TTerm TermVariant+termVariantApplication = unitVariant _TermVariant _TermVariant_application++termVariantFunction :: TTerm TermVariant+termVariantFunction = unitVariant _TermVariant _TermVariant_function++termVariantLet :: TTerm TermVariant+termVariantLet = unitVariant _TermVariant _TermVariant_let++termVariantList :: TTerm TermVariant+termVariantList = unitVariant _TermVariant _TermVariant_list++termVariantLiteral :: TTerm TermVariant+termVariantLiteral = unitVariant _TermVariant _TermVariant_literal++termVariantMap :: TTerm TermVariant+termVariantMap = unitVariant _TermVariant _TermVariant_map++termVariantOptional :: TTerm TermVariant+termVariantOptional = unitVariant _TermVariant _TermVariant_optional++termVariantProduct :: TTerm TermVariant+termVariantProduct = unitVariant _TermVariant _TermVariant_product++termVariantRecord :: TTerm TermVariant+termVariantRecord = unitVariant _TermVariant _TermVariant_record++termVariantSet :: TTerm TermVariant+termVariantSet = unitVariant _TermVariant _TermVariant_set++termVariantSum :: TTerm TermVariant+termVariantSum = unitVariant _TermVariant _TermVariant_sum++termVariantTypeLambda :: TTerm TermVariant+termVariantTypeLambda = unitVariant _TermVariant _TermVariant_typeLambda++termVariantTypeApplication :: TTerm TermVariant+termVariantTypeApplication = unitVariant _TermVariant _TermVariant_typeApplication++termVariantUnion :: TTerm TermVariant+termVariantUnion = unitVariant _TermVariant _TermVariant_union++termVariantUnit :: TTerm TermVariant+termVariantUnit = unitVariant _TermVariant _TermVariant_unit++termVariantVariable :: TTerm TermVariant+termVariantVariable = unitVariant _TermVariant _TermVariant_variable++termVariantWrap :: TTerm TermVariant+termVariantWrap = unitVariant _TermVariant _TermVariant_wrap++typeVariant :: TypeVariant -> TTerm TypeVariant+typeVariant v = unitVariant _TypeVariant $ case v of+  TypeVariantAnnotated -> _TypeVariant_annotated+  TypeVariantApplication -> _TypeVariant_application+  TypeVariantFunction -> _TypeVariant_function+  TypeVariantForall -> _TypeVariant_forall+  TypeVariantList -> _TypeVariant_list+  TypeVariantLiteral -> _TypeVariant_literal+  TypeVariantMap -> _TypeVariant_map+  TypeVariantOptional -> _TypeVariant_optional+  TypeVariantProduct -> _TypeVariant_product+  TypeVariantRecord -> _TypeVariant_record+  TypeVariantSet -> _TypeVariant_set+  TypeVariantUnion -> _TypeVariant_union+  TypeVariantUnit -> _TypeVariant_unit+  TypeVariantVariable -> _TypeVariant_variable+  TypeVariantWrap -> _TypeVariant_wrap++typeVariantAnnotated :: TTerm TypeVariant+typeVariantAnnotated = unitVariant _TypeVariant _TypeVariant_annotated++typeVariantApplication :: TTerm TypeVariant+typeVariantApplication = unitVariant _TypeVariant _TypeVariant_application++typeVariantFunction :: TTerm TypeVariant+typeVariantFunction = unitVariant _TypeVariant _TypeVariant_function++typeVariantForall :: TTerm TypeVariant+typeVariantForall = unitVariant _TypeVariant _TypeVariant_forall++typeVariantList :: TTerm TypeVariant+typeVariantList = unitVariant _TypeVariant _TypeVariant_list++typeVariantLiteral :: TTerm TypeVariant+typeVariantLiteral = unitVariant _TypeVariant _TypeVariant_literal++typeVariantMap :: TTerm TypeVariant+typeVariantMap = unitVariant _TypeVariant _TypeVariant_map++typeVariantOptional :: TTerm TypeVariant+typeVariantOptional = unitVariant _TypeVariant _TypeVariant_optional++typeVariantProduct :: TTerm TypeVariant+typeVariantProduct = unitVariant _TypeVariant _TypeVariant_product++typeVariantRecord :: TTerm TypeVariant+typeVariantRecord = unitVariant _TypeVariant _TypeVariant_record++typeVariantSet :: TTerm TypeVariant+typeVariantSet = unitVariant _TypeVariant _TypeVariant_set++typeVariantSum :: TTerm TypeVariant+typeVariantSum = unitVariant _TypeVariant _TypeVariant_sum++typeVariantUnion :: TTerm TypeVariant+typeVariantUnion = unitVariant _TypeVariant _TypeVariant_union++typeVariantUnit :: TTerm TypeVariant+typeVariantUnit = unitVariant _TypeVariant _TypeVariant_unit++typeVariantVariable :: TTerm TypeVariant+typeVariantVariable = unitVariant _TypeVariant _TypeVariant_variable++typeVariantWrap :: TTerm TypeVariant+typeVariantWrap = unitVariant _TypeVariant _TypeVariant_wrap++unAccessorPath :: TTerm AccessorPath -> TTerm [TermAccessor]+unAccessorPath path = unwrap _AccessorPath @@ path
src/main/haskell/Hydra/Dsl/Module.hs view
@@ -1,19 +1,93 @@ module Hydra.Dsl.Module where  import Hydra.Kernel-import Hydra.Dsl.Base as Base+import Hydra.Dsl.Phantoms +import qualified Data.Map as M ++definitionTerm :: TTerm TermDefinition -> TTerm Definition+definitionTerm = variant _Definition _Definition_term++definitionType :: TTerm TypeDefinition -> TTerm Definition+definitionType = variant _Definition _Definition_type++module_ :: TTerm Namespace -> TTerm [Binding] -> TTerm [Module] -> TTerm [Module] -> TTerm (Maybe String) -> TTerm Module+module_ ns elems termDeps typeDeps desc = record _Module [+  _Module_namespace>>: ns,+  _Module_elements>>: elems,+  _Module_termDependencies>>: termDeps,+  _Module_typeDependencies>>: typeDeps,+  _Module_description>>: desc]++moduleNamespace :: TTerm Module -> TTerm Namespace+moduleNamespace m = project _Module _Module_namespace @@ m++moduleElements :: TTerm Module -> TTerm [Binding]+moduleElements m = project _Module _Module_elements @@ m++moduleTermDependencies :: TTerm Module -> TTerm [Module]+moduleTermDependencies m = project _Module _Module_termDependencies @@ m++moduleTypeDependencies :: TTerm Module -> TTerm [Module]+moduleTypeDependencies m = project _Module _Module_typeDependencies @@ m++moduleDescription :: TTerm Module -> TTerm (Maybe String)+moduleDescription m = project _Module _Module_description @@ m++namespace :: TTerm String -> TTerm Namespace+namespace ns = wrap _Namespace ns++namespaces :: TTerm (Namespace, n) -> TTerm (M.Map Namespace n) -> TTerm (Namespaces n)+namespaces focus mapping = record _Namespaces [+  _Namespaces_focus>>: focus,+  _Namespaces_mapping>>: mapping]++namespacesFocus :: TTerm (Namespaces n) -> TTerm (Namespace, n)+namespacesFocus ns = project _Namespaces _Namespaces_focus @@ ns++namespacesMapping :: TTerm (Namespaces n) -> TTerm (M.Map Namespace n)+namespacesMapping ns = project _Namespaces _Namespaces_mapping @@ ns+ qualifiedName :: TTerm (Maybe Namespace) -> TTerm String -> TTerm QualifiedName qualifiedName ns local = record _QualifiedName [   _QualifiedName_namespace>>: ns,   _QualifiedName_local>>: local] -qualifiedNameLocal :: TTerm (QualifiedName -> String)-qualifiedNameLocal = project _QualifiedName _QualifiedName_local+qualifiedNameLocal :: TTerm QualifiedName -> TTerm String+qualifiedNameLocal qn = project _QualifiedName _QualifiedName_local @@ qn -qualifiedNameNamespace :: TTerm (QualifiedName -> Maybe Namespace)-qualifiedNameNamespace = project _QualifiedName _QualifiedName_namespace+qualifiedNameNamespace :: TTerm QualifiedName -> TTerm (Maybe Namespace)+qualifiedNameNamespace qn = project _QualifiedName _QualifiedName_namespace @@ qn -unFileExtension :: TTerm (FileExtension -> String)-unFileExtension = unwrap _FileExtension+termDefinition :: TTerm Name -> TTerm Term -> TTerm Type -> TTerm TermDefinition+termDefinition name term type_ = record _TermDefinition [+  _TermDefinition_name>>: name,+  _TermDefinition_term>>: term,+  _TermDefinition_type>>: type_]++termDefinitionName :: TTerm TermDefinition -> TTerm Name+termDefinitionName td = project _TermDefinition _TermDefinition_name @@ td++termDefinitionTerm :: TTerm TermDefinition -> TTerm Term+termDefinitionTerm td = project _TermDefinition _TermDefinition_term @@ td++termDefinitionType :: TTerm TermDefinition -> TTerm Type+termDefinitionType td = project _TermDefinition _TermDefinition_type @@ td++typeDefinition :: TTerm Name -> TTerm Type -> TTerm TypeDefinition+typeDefinition name typ = record _TypeDefinition [+  _TypeDefinition_name>>: name,+  _TypeDefinition_type>>: typ]++typeDefinitionName :: TTerm TypeDefinition -> TTerm Name+typeDefinitionName td = project _TypeDefinition _TypeDefinition_name @@ td++typeDefinitionType :: TTerm TypeDefinition -> TTerm Type+typeDefinitionType td = project _TypeDefinition _TypeDefinition_type @@ td++unFileExtension :: TTerm FileExtension -> TTerm String+unFileExtension fe = unwrap _FileExtension @@ fe++unNamespace :: TTerm Namespace -> TTerm String+unNamespace ns = unwrap _Namespace @@ ns
src/main/haskell/Hydra/Dsl/PhantomLiterals.hs view
@@ -30,6 +30,9 @@ boolean :: Bool -> TTerm Bool boolean = bool +char :: Char -> TTerm Int+char = TTerm . Terms.char+ double :: Double -> TTerm Double double = float64 @@ -66,13 +69,14 @@ true :: TTerm Bool true = bool True --- Note: untyped integers are not yet properly supported by the DSL,---       because they are not properly supported by code generation.-uint8 :: Int8 -> TTerm Int8-uint8 = int8-uint16 :: Int16 -> TTerm Int16-uint16 = int16-uint32 :: Int -> TTerm Int-uint32 = int-uint64 :: Int64 -> TTerm Int64-uint64 = int64+uint8 :: Int16 -> TTerm Int16+uint8 = TTerm . Terms.uint8++uint16 :: Int -> TTerm Int+uint16 = TTerm . Terms.uint16++uint32 :: Int64 -> TTerm Int64+uint32 = TTerm . Terms.uint32++uint64 :: Integer -> TTerm Integer+uint64 = TTerm . Terms.uint64
+ src/main/haskell/Hydra/Dsl/Phantoms.hs view
@@ -0,0 +1,351 @@+-- | Term-level DSL which makes use of phantom types. Use this DSL for defining programs as opposed to data type definitions.+-- The phantom types provide static type checking in Haskell prior to Hydra's runtime type checking.+module Hydra.Dsl.Phantoms (+  module Hydra.Dsl.Phantoms,+  module Hydra.Dsl.PhantomLiterals,+) where++import Hydra.Kernel+import Hydra.Dsl.Common+import Hydra.Dsl.PhantomLiterals+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Annotations as Ann+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Show.Core as ShowCore++import Prelude hiding ((++))+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++-- * Operators++infixr 0 ~>+(~>) :: String -> TTerm x -> TTerm (a -> b)+name ~> body = lambda name body++infixl 1 <~+(<~) :: String -> TTerm a -> TTerm b -> TTerm b+name <~ value = let1 name value++infixl 1 <<~+(<<~) :: String -> TTerm (Flow s a) -> TTerm (Flow s b) -> TTerm (Flow s b)+name <<~ def = bind name def++-- | Function composition operator: f <.> g creates a function that applies g then f+-- Example: toString <.> increment+(<.>) :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)+f <.> g = compose f g++-- | Function application operator: function @@ argument+-- Example: add @@ int32 1+(@@) :: TTerm (a -> b) -> TTerm a -> TTerm b+fun @@ arg = apply fun arg++-- | Field definition operator for records: name>: value+-- Example: "name">: string "John"+infixr 0 >:+(>:) :: String -> TTerm a -> Field+name>: term = Field (Name name) (unTTerm term)++-- | Field definition operator with pre-constructed name: fname>>: value+-- Example: _Person_name>>: string "John"+infixr 0 >>:+(>>:) :: Name -> TTerm a -> Field+fname >>: d = Field fname (unTTerm d)++-- * Fundamentals++-- | Apply a function to an argument+-- Example: apply (var "add") (int32 1)+apply :: TTerm (a -> b) -> TTerm a -> TTerm b+apply (TTerm lhs) (TTerm rhs) = TTerm $ Terms.apply lhs rhs++let1 :: String -> TTerm a -> TTerm b -> TTerm b+let1 name (TTerm value) (TTerm env) = TTerm $ TermLet $ Let [Binding (Name name) value Nothing] env++-- | Create a let expression with multiple bindings+-- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y")+lets :: [Field] -> TTerm a -> TTerm a+lets fields (TTerm env) = TTerm $ TermLet $ Let (toBinding <$> fields) env+  where+     toBinding (Field name value) = Binding name value Nothing++-- | Create a variable reference+-- Example: var "x"+var :: String -> TTerm a+var v = TTerm $ Terms.var v++bind :: String -> TTerm (Flow s a) -> TTerm (Flow s b) -> TTerm (Flow s b)+bind v def body = primitive2 _flows_bind def $ lambda v $ body++binds :: [Field] -> TTerm (Flow s a) -> TTerm (Flow s a)+binds fields rhs = L.foldr withField rhs fields+  where+    withField (Field (Name fname) fterm) b = bind fname (TTerm fterm) b++exec :: TTerm (Flow s a) -> TTerm (Flow s b) -> TTerm (Flow s b)+exec f b = primitive2 _flows_bind f (lambda ignoredVariable b)++produce :: TTerm a -> TTerm (Flow s a)+produce = primitive1 _flows_pure++trace :: TTerm String -> TTerm (Flow s a) -> TTerm (Flow s a)+trace msg flow = var "hydra.monads.withTrace" @@ msg @@ flow++-- * Functions++unaryFunction :: (TTerm a -> TTerm b) -> TTerm (a -> b)+unaryFunction f = case (unTTerm $ f $ var "x") of+  TermApplication (Application lhs _) -> TTerm lhs+  TermOptional (Just _) -> primitive _optionals_pure+  TermUnion (Injection tname (Field fname _)) -> lambda "x" $ inject tname fname $ var "x"+  TermWrap (WrappedTerm tname _) -> lambda "x" $ wrap tname $ var "x"++binaryFunction :: (TTerm a -> TTerm b -> TTerm c) -> TTerm (a -> b -> c)+binaryFunction f = case (unTTerm $ f (var "x") (var "y")) of+  TermApplication (Application (TermApplication (Application lhs _)) _) -> TTerm lhs+  t -> TTerm $ Terms.string $ "unexpected term as binary function: " <> ShowCore.term t++-- | Compose two functions (g then f)+-- Example: compose (var "stringLength") (var "toString")+compose :: TTerm (b -> c) -> TTerm (a -> b) -> TTerm (a -> c)+compose (TTerm f) (TTerm g) = TTerm $ Terms.compose f g++-- | Create a constant function that always returns the same value+-- Example: constant true+constant :: TTerm a -> TTerm (b -> a)+constant (TTerm term) = TTerm $ Terms.constant term++-- | Identity function that returns its argument unchanged+-- Example: identity+identity :: TTerm (a -> a)+identity = TTerm Terms.identity++-- | Create a lambda function with one parameter+-- Example: lambda "x" (var "add" @@ var "x" @@ int32 1)+lambda :: String -> TTerm x -> TTerm (a -> b)+lambda v (TTerm body) = TTerm $ Terms.lambda v body++-- | Create a multi-parameter lambda function+-- Example: lambdas ["x", "y"] (add @@ var "x" @@ var "y")+lambdas :: [String] -> TTerm x -> TTerm (a -> b)+lambdas params (TTerm body) = TTerm $ Terms.lambdas params body++-- | Primitive function by name+-- Example: primitive (Name "hydra.lib.strings.length")+primitive :: Name -> TTerm a+primitive = TTerm . Terms.primitive++-- | Apply a primitive function to one argument+-- Example: primitive1 _math_abs (int32 (-5))+primitive1 :: Name -> TTerm a -> TTerm b+primitive1 primName (TTerm a) = TTerm $ Terms.primitive primName Terms.@@ a++-- | Apply a primitive function to two arguments+-- Example: primitive2 _math_add (int32 2) (int32 3)+primitive2 :: Name -> TTerm a -> TTerm b -> TTerm c+primitive2 primName (TTerm a) (TTerm b) = TTerm $ Terms.primitive primName Terms.@@ a Terms.@@ b++-- | Apply a primitive function to three arguments+-- Example: primitive3 _string_replace (string "hello") (string "e") (string "a")+primitive3 :: Name -> TTerm a -> TTerm b -> TTerm c -> TTerm d+primitive3 primName (TTerm a) (TTerm b) (TTerm c) = TTerm $ Terms.primitive primName Terms.@@ a Terms.@@ b Terms.@@ c++-- * Collections++-- | Create a fold function to process lists+-- Example: fold (lambda "acc" (lambda "x" (add @@ var "acc" @@ var "x")))+fold :: TTerm (b -> a -> b) -> TTerm (b -> [a] -> b)+fold f = (primitive _lists_foldl) @@ f++-- | Create a 'Just' optional value+-- Example: just (string "found")+just :: TTerm a -> TTerm (Maybe a)+just (TTerm term) = TTerm $ Terms.just term++-- | Function that wraps a value in 'Just'+-- Example: just_ @@ myValue+just_ :: TTerm (a -> Maybe a)+just_ = TTerm $ Terms.lambda "just_" $ Terms.just $ Terms.var "just_"++-- | Create a list of terms+-- Example: list [int32 1, int32 2, int32 3]+list :: [TTerm a] -> TTerm [a]+list els = TTerm $ Terms.list (unTTerm <$> els)++-- | Create a map/dictionary term+-- Example: map (M.fromList [(string "a", int32 1), (string "b", int32 2)])+map :: M.Map (TTerm a) (TTerm b) -> TTerm (M.Map a b)+map = TTerm . Terms.map . M.fromList . fmap fromTTerm . M.toList+  where+    fromTTerm (TTerm k, TTerm v) = (k, v)++-- | Create a 'Nothing' optional value+-- Example: nothing+nothing :: TTerm (Maybe a)+nothing = TTerm Terms.nothing++-- | Create an optional value from a Maybe+-- Example: opt (Just myValue)+opt :: Maybe (TTerm a) -> TTerm (Maybe a)+opt mc = TTerm $ Terms.optional (unTTerm <$> mc)++-- | Create a set of terms+-- Example: set [string "a", string "b", string "c"]+set :: [TTerm a] -> TTerm (S.Set a)+set = TTerm . Terms.set . S.fromList . fmap unTTerm++-- * Products and tuples++-- | First element projection function for pairs+-- Example: first $ pair (string "foo") (string "bar")+first :: TTerm (a, b) -> TTerm a+first pair = TTerm (Terms.untuple 2 0) @@ pair++-- | Create a pair (2-tuple)+-- Example: pair (string "age") (int32 32)+pair :: (TTerm a) -> (TTerm b) -> TTerm (a, b)+pair (TTerm l) (TTerm r) = TTerm $ Terms.pair l r++-- | Second element projection function for pairs+-- Example: second $ pair (string "foo") (string "bar")+second :: TTerm (a, b) -> TTerm b+second pair = TTerm (Terms.untuple 2 1) @@ pair++triple :: TTerm a -> TTerm b -> TTerm c -> TTerm (a, b, c)+triple (TTerm a) (TTerm b) (TTerm c) = TTerm $ Terms.triple a b c++tuple4 :: TTerm a -> TTerm b -> TTerm c -> TTerm d -> TTerm (a, b, c, d)+tuple4 (TTerm a) (TTerm b) (TTerm c) (TTerm d) = TTerm $ Terms.tuple4 a b c d++tuple5 :: TTerm a -> TTerm b -> TTerm c -> TTerm d -> TTerm e -> TTerm (a, b, c, d, e)+tuple5 (TTerm a) (TTerm b) (TTerm c) (TTerm d) (TTerm e) = TTerm $ Terms.tuple5 a b c d e++-- | Create a tuple projection function+-- Example: untuple 3 1 extracts the second element of a 3-tuple+untuple :: Int -> Int -> TTerm (a -> b)+untuple arity idx = TTerm $ Terms.untuple arity idx++-- * Records, unions and newtypes++-- | Create a field with the given name and value+-- Example: field (Name "age") (int32 30)+field :: Name -> TTerm a -> Field+field fname (TTerm val) = Field fname val++-- | Create a union injection+-- Example: inject (Name "Result") (Name "success") (string "ok")+inject :: Name -> Name -> TTerm a -> TTerm b+inject name fname (TTerm term) = TTerm $ Terms.inject name (Field fname term)++-- | Create a function that injects its argument into a union variant+-- Example: injectLambda (Name "Result") (Name "success")+injectLambda :: Name -> Name -> TTerm (a -> b)+injectLambda name fname = lambda "injected_" $ inject name fname $ var "injected_"++-- | Extract a field from a record+-- Example: project (Name "Person") (Name "name")+project :: Name -> Name -> TTerm (a -> b)+project name fname = TTerm $ Terms.project name fname++-- | Create a record with named fields+-- Example: record (Name "Person") [field (Name "name") (string "John"), field (Name "age") (int32 30)]+record :: Name -> [Field] -> TTerm a+record name fields = TTerm $ Terms.record name fields++-- | Unit value (empty record)+unit :: TTerm a+unit = TTerm Terms.unit++-- | Create a unit variant of a union+-- Example: unitVariant (Name "Result") (Name "success")+unitVariant :: Name -> Name -> TTerm a+unitVariant name fname = TTerm $ Terms.inject name $ Field fname Terms.unit++-- | Create an unwrap function for a wrapped type+-- Example: unwrap (Name "Email")+unwrap :: Name -> TTerm (a -> b)+unwrap = TTerm . Terms.unwrap++-- | Create a union variant+-- Example: variant (Name "Result") (Name "success") (string "ok")+variant :: Name -> Name -> TTerm a -> TTerm b+variant name fname (TTerm term) = TTerm $ Terms.inject name $ Field fname term++-- | Create a wrapped term (instance of a newtype)+-- Example: wrap (Name "Email") (string "user@example.com")+-- Note: the phantom types provide no guarantee of type safety in this case+wrap :: Name -> TTerm a -> TTerm b+wrap name (TTerm term) = TTerm $ Terms.wrap name term++-- * Pattern matching++-- | Apply a named case match to an argument+-- Example: cases resultTypeName myResult Nothing [onSuccess, onError]+-- See also: 'match'+cases :: Name -> TTerm a -> Maybe (TTerm b) -> [Field] -> TTerm b+cases name arg dflt fields = TTerm $ Terms.apply (Terms.match name (unTTerm <$> dflt) fields) (unTTerm arg)++-- | Create a pattern match on a union term+-- Example: match (Name "Result") (Just $ string "what?") ["success">: string "yay", "error">: string "boo"]+match :: Name -> Maybe (TTerm b) -> [Field] -> TTerm (a -> b)+match name dflt fields = TTerm $ Terms.match name (unTTerm <$> dflt) fields++optCases :: TTerm (Maybe a) -> TTerm b -> TTerm (a -> b) -> TTerm b+optCases arg ifNothing ifJust = primitive3 (Name "hydra.lib.optionals.maybe") ifNothing ifJust arg++-- * Definitions and modules++-- | Create a definition in a module+-- Example: definitionInModule myModule "addInts" (lambda "x" (lambda "y" (add @@ var "x" @@ var "y")))+definitionInModule :: Module -> String -> TTerm a -> TBinding a+definitionInModule mod = definitionInNamespace $ moduleNamespace mod++-- | Create a definition in a namespace+-- Example: definitionInNamespace (Namespace "com.example") "addInts" myFunction+definitionInNamespace :: Namespace -> String -> TTerm a -> TBinding a+definitionInNamespace ns lname = TBinding $ unqualifyName $ QualifiedName (Just ns) lname++-- | Convert a typed element to an untyped element+-- Example: el (definitionInModule myModule "addInts" myFunction)+el :: TBinding a -> Binding+el (TBinding name (TTerm term)) = Binding name term Nothing++-- | Reference a defined element+-- Example: ref (definitionInModule myModule "addInts")+ref :: TBinding a -> TTerm a+ref (TBinding name _) = TTerm (TermVariable name)++-- * Metadata and annotations++-- | Add an annotation to a term+-- Example: annot (Name "deprecated") (Just (boolean True)) myFunction+annot :: Name -> Maybe Term -> TTerm a -> TTerm a+annot key mvalue (TTerm term) = TTerm $ Ann.annotateTerm key mvalue term++-- | Add documentation to a term+-- Example: doc "Adds two integers" addFunction+doc :: String -> TTerm a -> TTerm a+doc s (TTerm term) = TTerm $ setTermDescription (Just s) term++-- | Add documentation with line wrapping at the specified width+-- Example: docWrapped 80 "This is a long documentation string that will be wrapped..." myFunction+docWrapped :: Int -> String -> TTerm a -> TTerm a+docWrapped len = doc . wrapLine len++-- | Mark a type as first-class+-- Example: firstClassType (record ...)+firstClassType :: TTerm Type -> TTerm Type+firstClassType typ = annot key_firstClassType (Just $ Terms.boolean True) typ++-- | Associate the Ord type class with the inferred type of a term+-- Example: withOrd "t0" myTerm+withOrd :: String -> TTerm a -> TTerm a+withOrd v = withTypeClasses $ M.fromList [(Name v, S.singleton TypeClassOrdering)]++-- | Associate type classes with the inferred type of a term+-- Example: withTypeClasses (M.fromList [(Name "t0", S.singleton TypeClassOrdering)]) myTerm+withTypeClasses :: M.Map Name (S.Set TypeClass) -> TTerm a -> TTerm a+withTypeClasses classes (TTerm term) = TTerm $ setTypeClasses classes term
src/main/haskell/Hydra/Dsl/Prims.hs view
@@ -6,11 +6,14 @@ import Hydra.Compute import Hydra.Core import Hydra.Graph-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import qualified Hydra.Dsl.Expect as Expect+import Hydra.Mantle+import qualified Hydra.Encode.Core as EncodeCore+import qualified Hydra.Decode.Core as DecodeCore+import qualified Hydra.Extract.Core as ExtractCore+import qualified Hydra.Extract.Mantle as ExtractMantle import qualified Hydra.Dsl.Terms as Terms import qualified Hydra.Dsl.Types as Types+import qualified Hydra.Show.Core as ShowCore  import Data.Int import qualified Data.List as L@@ -20,42 +23,60 @@ import Hydra.Rewriting (removeTermAnnotations) import Data.String(IsString(..)) -instance IsString (TermCoder (Term)) where fromString = variable+instance IsString (TermCoder Term) where fromString = variable  bigfloat :: TermCoder Double bigfloat = TermCoder Types.bigfloat $ Coder encode decode   where-    encode = Expect.bigfloat+    encode = ExtractCore.bigfloat     decode = pure . Terms.bigfloat  bigint :: TermCoder Integer bigint = TermCoder Types.bigint $ Coder encode decode   where-    encode = Expect.bigint+    encode = ExtractCore.bigint     decode = pure . Terms.bigint  binary :: TermCoder String binary = TermCoder Types.binary $ Coder encode decode   where-    encode = Expect.binary+    encode = ExtractCore.binary     decode = pure . Terms.binary  boolean :: TermCoder Bool boolean = TermCoder Types.boolean $ Coder encode decode   where-    encode = Expect.boolean+    encode = ExtractCore.boolean     decode = pure . Terms.boolean +comparison :: TermCoder Comparison+comparison = TermCoder (TypeVariable _Comparison) $ Coder encode decode+  where+    encode = ExtractMantle.comparison+    decode = pure . Terms.comparison++floatType :: TermCoder FloatType+floatType = TermCoder (TypeVariable _FloatType) $ Coder encode decode+  where+    encode = DecodeCore.floatType+    decode = pure . EncodeCore.floatType++floatValue :: TermCoder FloatValue+floatValue = TermCoder (TypeVariable _FloatValue) $ Coder encode decode+  where+    encode = ExtractCore.floatValue+    decode = pure . Terms.float+ float32 :: TermCoder Float float32 = TermCoder Types.float32 $ Coder encode decode   where-    encode = Expect.float32+    encode = ExtractCore.float32     decode = pure . Terms.float32  float64 :: TermCoder Double float64 = TermCoder Types.float64 $ Coder encode decode   where-    encode = Expect.float64+    encode = ExtractCore.float64     decode = pure . Terms.float64  flow :: TermCoder s -> TermCoder x -> TermCoder (Flow s x)@@ -68,43 +89,67 @@ function :: TermCoder x -> TermCoder y -> TermCoder (x -> y) function dom cod = TermCoder (Types.function (termCoderType dom) (termCoderType cod)) $ Coder encode decode   where-    encode term = fail $ "cannot encode terms to functions"+    encode term = fail $ "cannot encode term to a function: " ++ ShowCore.term term     decode _ = fail $ "cannot decode functions to terms" +integerType :: TermCoder IntegerType+integerType = TermCoder (TypeVariable _IntegerType) $ Coder encode decode+  where+    encode = DecodeCore.integerType+    decode = pure . EncodeCore.integerType++integerValue :: TermCoder IntegerValue+integerValue = TermCoder (TypeVariable _IntegerValue) $ Coder encode decode+  where+    encode = ExtractCore.integerValue+    decode = pure . Terms.integer+ int8 :: TermCoder Int8 int8 = TermCoder Types.int8 $ Coder encode decode   where-    encode = Expect.int8+    encode = ExtractCore.int8     decode = pure . Terms.int8  int16 :: TermCoder Int16 int16 = TermCoder Types.int16 $ Coder encode decode   where-    encode = Expect.int16+    encode = ExtractCore.int16     decode = pure . Terms.int16  int32 :: TermCoder Int int32 = TermCoder Types.int32 $ Coder encode decode   where-    encode = Expect.int32+    encode = ExtractCore.int32     decode = pure . Terms.int32  int64 :: TermCoder Int64 int64 = TermCoder Types.int64 $ Coder encode decode   where-    encode = Expect.int64+    encode = ExtractCore.int64     decode = pure . Terms.int64  list :: TermCoder x -> TermCoder [x] list els = TermCoder (Types.list $ termCoderType els) $ Coder encode decode   where-    encode = Expect.list (coderEncode $ termCoderCoder els)+    encode = ExtractCore.listOf (coderEncode $ termCoderCoder els)     decode l = Terms.list <$> mapM (coderDecode $ termCoderCoder els) l +literal :: TermCoder Literal+literal = TermCoder (TypeVariable _Literal) $ Coder encode decode+  where+    encode = ExtractCore.literal+    decode = pure . Terms.literal++literalType :: TermCoder LiteralType+literalType = TermCoder (TypeVariable _LiteralType) $ Coder encode decode+  where+    encode = DecodeCore.literalType+    decode = pure . EncodeCore.literalType+ map :: Ord k => TermCoder k -> TermCoder v -> TermCoder (M.Map k v) map keys values = TermCoder (Types.map (termCoderType keys) (termCoderType values)) $ Coder encode decode   where-    encode = Expect.map (coderEncode $ termCoderCoder keys) (coderEncode $ termCoderCoder values)+    encode = ExtractCore.map (coderEncode $ termCoderCoder keys) (coderEncode $ termCoderCoder values)     decode m = Terms.map . M.fromList <$> mapM decodePair (M.toList m)       where         decodePair (k, v) = do@@ -112,10 +157,13 @@           ve <- (coderDecode $ termCoderCoder values) v           return (ke, ve) +noInterpretedForm :: Name -> Flow Graph Term+noInterpretedForm name = fail $ "primitive " ++ unName name ++ " does not have an interpreted form; it can only be used in compiled code"+ optional :: TermCoder x -> TermCoder (Y.Maybe x) optional mel = TermCoder (Types.optional $ termCoderType mel) $ Coder encode decode   where-    encode = Expect.optional (coderEncode $ termCoderCoder mel)+    encode = ExtractCore.optional (coderEncode $ termCoderCoder mel)     decode mv = Terms.optional <$> case mv of       Nothing -> pure Nothing       Just v -> Just <$> (coderDecode $ termCoderCoder mel) v@@ -123,113 +171,131 @@ pair :: TermCoder k -> TermCoder v -> TermCoder (k, v) pair kCoder vCoder = TermCoder (Types.product [termCoderType kCoder, termCoderType vCoder]) $ Coder encode decode   where-    encode = Expect.pair (coderEncode $ termCoderCoder kCoder) (coderEncode $ termCoderCoder vCoder)+    encode = ExtractCore.pair (coderEncode $ termCoderCoder kCoder) (coderEncode $ termCoderCoder vCoder)     decode (k, v) = do       kTerm <- coderDecode (termCoderCoder kCoder) k       vTerm <- coderDecode (termCoderCoder vCoder) v-      return $ Terms.product [kTerm, vTerm]+      return $ Terms.tuple [kTerm, vTerm] -prim0 :: [String] -> Name -> TermCoder x -> x -> Primitive-prim0 vars name output value = Primitive name typ impl+prim0 :: Name -> x -> [String]  -> TermCoder x -> Primitive+prim0 name value vars output = Primitive name typ impl   where-    typ = TypeScheme (Name <$> vars) $-      termCoderType output+    typ = Types.poly vars $ termCoderType output     impl _ = coderDecode (termCoderCoder output) value -prim1 :: [String] -> Name -> TermCoder x -> TermCoder y -> (x -> y) -> Primitive-prim1 vars name input1 output compute = Primitive name typ impl+prim1 :: Name -> (x -> y) -> [String] -> TermCoder x -> TermCoder y -> Primitive+prim1 name compute vars input1 output = Primitive name typ impl   where-    typ = TypeScheme (Name <$> vars) $-      TypeFunction $ FunctionType (termCoderType input1) $ termCoderType output+    typ = Types.poly vars $ Types.functionMany [+      termCoderType input1,+      termCoderType output]     impl args = do-      Expect.nArgs 1 args+      ExtractCore.nArgs name 1 args       arg1 <- coderEncode (termCoderCoder input1) (args !! 0)       coderDecode (termCoderCoder output) $ compute arg1 -prim2 :: [String] -> Name -> TermCoder x -> TermCoder y -> TermCoder z -> (x -> y -> z) -> Primitive-prim2 vars name input1 input2 output compute = Primitive name typ impl+prim2 :: Name -> (x -> y -> z) -> [String] -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive+prim2 name compute vars input1 input2 output = Primitive name typ impl   where-    typ = TypeScheme (Name <$> vars) $-      TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output))+    typ = Types.poly vars $ Types.functionMany [+      termCoderType input1,+      termCoderType input2,+      termCoderType output]     impl args = do-      Expect.nArgs 2 args+      ExtractCore.nArgs name 2 args       arg1 <- coderEncode (termCoderCoder input1) (args !! 0)       arg2 <- coderEncode (termCoderCoder input2) (args !! 1)       coderDecode (termCoderCoder output) $ compute arg1 arg2 -prim2Interp :: [String] -> Name -> TermCoder x -> TermCoder y -> TermCoder z -> (Term -> Term -> Flow (Graph) (Term)) -> Primitive-prim2Interp vars name input1 input2 output compute = Primitive name typ impl+prim2Interp :: Name -> Maybe (Term -> Term -> Flow Graph Term) -> [String] -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive+prim2Interp name mcompute vars input1 input2 output = Primitive name typ impl   where-    typ = TypeScheme (Name <$> vars) $-      TypeFunction $ FunctionType (termCoderType input1) (Types.function (termCoderType input2) (termCoderType output))+    compute = Y.fromMaybe (\a b -> noInterpretedForm name) mcompute+    typ = Types.poly vars $ Types.functionMany [+      termCoderType input1,+      termCoderType input2,+      termCoderType output]     impl args = do-      Expect.nArgs 2 args+      ExtractCore.nArgs name 2 args       compute (args !! 0) (args !! 1) -prim3 :: [String] -> Name -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> (w -> x -> y -> z) -> Primitive-prim3 vars name input1 input2 input3 output compute = Primitive name typ impl+prim3 :: Name -> (w -> x -> y -> z) -> [String] -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive+prim3 name compute vars input1 input2 input3 output = Primitive name typ impl   where-    typ = TypeScheme (Name <$> vars) $-      TypeFunction $ FunctionType-        (termCoderType input1)-        (Types.function (termCoderType input2)-        (Types.function (termCoderType input3) (termCoderType output)))+    typ = Types.poly vars $ Types.functionMany [+      termCoderType input1,+      termCoderType input2,+      termCoderType input3,+      termCoderType output]     impl args = do-      Expect.nArgs 2 args+      ExtractCore.nArgs name 3 args       arg1 <- coderEncode (termCoderCoder input1) (args !! 0)       arg2 <- coderEncode (termCoderCoder input2) (args !! 1)       arg3 <- coderEncode (termCoderCoder input3) (args !! 2)       coderDecode (termCoderCoder output) $ compute arg1 arg2 arg3 +prim3Interp :: Name -> Maybe (Term -> Term -> Term -> Flow Graph Term) -> [String] -> TermCoder w -> TermCoder x -> TermCoder y -> TermCoder z -> Primitive+prim3Interp name mcompute vars input1 input2 input3 output = Primitive name typ impl+  where+    compute = Y.fromMaybe (\a b c -> noInterpretedForm name) mcompute+    typ = Types.poly vars $ Types.functionMany [+      termCoderType input1,+      termCoderType input2,+      termCoderType input3,+      termCoderType output]+    impl args = do+      ExtractCore.nArgs name 3 args+      compute (args !! 0) (args !! 1) (args !! 2)+ set :: Ord x => TermCoder x -> TermCoder (S.Set x) set els = TermCoder (Types.set $ termCoderType els) $ Coder encode decode   where-    encode = Expect.set (coderEncode $ termCoderCoder els)+    encode = ExtractCore.setOf (coderEncode $ termCoderCoder els)     decode s = Terms.set . S.fromList <$> mapM (coderDecode $ termCoderCoder els) (S.toList s)  string :: TermCoder String string = TermCoder Types.string $ Coder encode decode   where-    encode = Expect.string+    encode = ExtractCore.string     decode = pure . Terms.string -term :: TermCoder (Term)-term = TermCoder (Types.apply (TypeVariable _Term) (Types.var "a")) $ Coder encode decode+term :: TermCoder Term+term = TermCoder (TypeVariable _Term) $ Coder encode decode   where     encode = pure     decode = pure -type_ :: TermCoder (Type)-type_ = TermCoder (Types.apply (TypeVariable _Type) (Types.var "a")) $ Coder encode decode+type_ :: TermCoder Type+type_ = TermCoder (TypeVariable _Type) $ Coder encode decode   where-    encode = coreDecodeType-    decode = pure . coreEncodeType+    encode = DecodeCore.type_+    decode = pure . EncodeCore.type_  uint8 :: TermCoder Int16 uint8 = TermCoder Types.uint8 $ Coder encode decode   where-    encode = Expect.uint8+    encode = ExtractCore.uint8     decode = pure . Terms.uint8  uint16 :: TermCoder Int uint16 = TermCoder Types.uint16 $ Coder encode decode   where-    encode = Expect.uint16+    encode = ExtractCore.uint16     decode = pure . Terms.uint16  uint32 :: TermCoder Int64 uint32 = TermCoder Types.uint32 $ Coder encode decode   where-    encode = Expect.uint32+    encode = ExtractCore.uint32     decode = pure . Terms.uint32  uint64 :: TermCoder Integer uint64 = TermCoder Types.uint64 $ Coder encode decode   where-    encode = Expect.uint64+    encode = ExtractCore.uint64     decode = pure . Terms.uint64 -variable :: String -> TermCoder (Term)+variable :: String -> TermCoder Term variable v = TermCoder (Types.var v) $ Coder encode decode   where     encode = pure
src/main/haskell/Hydra/Dsl/ShorthandTypes.hs view
@@ -1,5 +1,6 @@ module Hydra.Dsl.ShorthandTypes where +import Hydra.Accessors import Hydra.Coders import Hydra.Core import Hydra.Compute@@ -12,76 +13,95 @@ import qualified Data.Set as S  +-- Typeclass references eqA = (M.fromList [(Name "a", S.fromList [TypeClassEquality])]) ordA = (M.fromList [(Name "a", S.fromList [TypeClassOrdering])]) -aT = Types.var "a" :: Type+-- Type constructors+tA = tVar "a"+tApply = Types.apply+tApplyN = Types.applyMany+tB = tVar "b"+tBigfloat = Types.bigfloat+tBigint = Types.bigint+tBinary = Types.binary+tBoolean = Types.boolean+tC = tVar "c"+tD = tVar "d"+tE = tVar "e"+tFloat32 = Types.float32+tFloat64 = Types.float64+tFlow s x = tApplyN [flowT, s, x]+tFlowS1A = tFlow (tVar "s1") tA+tFlowS2A = tFlow (tVar "s2") tA+tFlowSA = tFlow tS tA+tFlowSS = tFlow tS tS+tFlowState s x = tApplyN [flowStateT, s, x]+tFun = Types.function+tFunN = Types.functionMany+tInt8 = Types.int8+tInt16 = Types.int16+tInt32 = Types.int32+tInt64 = Types.int64+tList = Types.list+tMap = Types.map+tMono = Types.mono+tOpt = Types.optional+tPair = Types.pair+tS = tVar "s"+tSet = TypeSet+tString = Types.string+tSum = Types.sum+tUint8 = Types.uint8+tUint16 = Types.uint16+tUint32 = Types.uint32+tUint64 = Types.uint64+tUnit = Types.unit+tVar = Types.var+tX = tVar "x"++-- Type references annotatedTermT = TypeVariable _AnnotatedTerm :: Type annotatedTypeT = TypeVariable _AnnotatedType :: Type applicationT = TypeVariable _Application :: Type applicationTypeT = TypeVariable _ApplicationType :: Type-bT = Types.var "b" :: Type-bigfloatT = Types.bigfloat-bigintT = Types.bigint-binaryT = Types.binary-booleanT = Types.boolean-cT = Types.var "c" :: Type+caseConventionT = TypeVariable _CaseConvention :: Type caseStatementT = TypeVariable _CaseStatement :: Type-elementT = TypeVariable _Element :: Type+elementT = TypeVariable _Binding :: Type eliminationT = TypeVariable _Elimination :: Type eliminationVariantT = TypeVariable _EliminationVariant :: Type fieldT = TypeVariable _Field :: Type fieldNameT = TypeVariable _Name :: Type fieldTypeT = TypeVariable _FieldType :: Type fileExtensionT = TypeVariable _FileExtension :: Type-float32T = Types.float32-float64T = Types.float64 floatTypeT = TypeVariable _FloatType :: Type floatValueT = TypeVariable _FloatValue :: Type-flowS1AT = flowT (Types.var "s1") aT :: Type-flowS2AT = flowT (Types.var "s2") aT :: Type-flowSAT = flowT sT aT :: Type-flowSST = flowT sT sT :: Type-flowStateT s x = Types.apply (Types.apply (TypeVariable _FlowState) s) x-flowT s x = Types.apply (Types.apply (TypeVariable _Flow) s) x-funT = Types.function+flowStateT = TypeVariable _FlowState :: Type+flowT = TypeVariable _Flow :: Type functionT = TypeVariable _Function :: Type functionTypeT = TypeVariable _FunctionType :: Type functionVariantT = TypeVariable _FunctionVariant :: Type graphT = TypeVariable _Graph :: Type injectionT = TypeVariable _Injection :: Type-int8T = Types.int8-int16T = Types.int16-int32T = Types.int32-int64T = Types.int64 integerTypeT = TypeVariable _IntegerType :: Type integerValueT = TypeVariable _IntegerValue :: Type-kvT = mapT nameT termT :: Type lambdaT = TypeVariable _Lambda :: Type-lambdaTypeT = TypeVariable _LambdaType :: Type+forallTypeT = TypeVariable _ForallType :: Type languageT = TypeVariable _Language :: Type letT = TypeVariable _Let :: Type-letBindingT = TypeVariable _LetBinding :: Type-listT = Types.list+letBindingT = TypeVariable _Binding :: Type literalT = TypeVariable _Literal :: Type literalTypeT = TypeVariable _LiteralType :: Type literalVariantT = TypeVariable _LiteralVariant :: Type-mapT = Types.map mapTypeT = TypeVariable _MapType :: Type nameT = TypeVariable _Name namespaceT = TypeVariable _Namespace-optionalT = Types.optional-optionalCasesT = TypeVariable _OptionalCases :: Type-pairT = Types.pair precisionT = TypeVariable _Precision :: Type primitiveT = TypeVariable _Primitive :: Type projectionT = TypeVariable _Projection :: Type qualifiedNameT = TypeVariable _QualifiedName recordT = TypeVariable _Record :: Type rowTypeT = TypeVariable _RowType :: Type-sT = Types.var "s" :: Type-setT = TypeSet-stringT = Types.string :: Type sumT = TypeVariable _Sum :: Type termT = TypeVariable _Term :: Type termAccessorT = TypeVariable _TermAccessor :: Type@@ -89,15 +109,9 @@ traceT = TypeVariable _Trace tupleProjectionT = TypeVariable _TupleProjection :: Type typeT = TypeVariable _Type :: Type-typeAbstractionT = TypeVariable _TypeAbstraction :: Type+typeLambdaT = TypeVariable _TypeLambda :: Type typeSchemeT = TypeVariable _TypeScheme :: Type typedTermT = TypeVariable _TypedTerm :: Type typeVariantT = TypeVariable _TypeVariant :: Type-uint8T = Types.uint8-uint16T = Types.uint16-uint32T = Types.uint32-uint64T = Types.uint64-unitT = Types.unit :: Type wrappedTermT = TypeVariable _WrappedTerm :: Type wrappedTypeT = TypeVariable _WrappedType :: Type-xT = Types.var "x" :: Type
+ src/main/haskell/Hydra/Dsl/TBase.hs view
@@ -0,0 +1,26 @@+-- | A basis for other DSLs which deal with term-encoded expressions.++module Hydra.Dsl.TBase (+  module Hydra.Dsl.Phantoms,+  module Hydra.Dsl.ShorthandTypes,+  module Hydra.Dsl.TBase,+  module Hydra.Sources.Libraries,+) where++import Hydra.Kernel+import Hydra.Dsl.ShorthandTypes+import Hydra.Dsl.Phantoms(definitionInModule, el, firstClassType, opt, ref, variant)+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Core as Core+import Hydra.Sources.Libraries++import qualified Data.Map as M+import qualified Data.Maybe as Y+++infixr 0 >:+(>:) :: String -> a -> (TTerm Name, a)+n >: d = (name n, d)++name :: String -> TTerm Name+name s = Core.nameLift $ Name s
+ src/main/haskell/Hydra/Dsl/TTerms.hs view
@@ -0,0 +1,352 @@+-- | A domain-specific language for constructing term-encoded Hydra terms in Haskell;+--   these functions enable you to build terms (programs) which build terms.+module Hydra.Dsl.TTerms (+  module Hydra.Dsl.TBase,+  module Hydra.Dsl.TTerms,+) where++import Hydra.Kernel+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Core as Core+import qualified Hydra.Encode.Core as EncodeCore+import Hydra.Dsl.TBase+import qualified Hydra.Dsl.Phantoms as Phantoms++import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import Data.Int+import Prelude hiding (map, product, sum)+++-- * Operators++-- | Function application operator for term-encoded terms+-- Example: fun @@ arg+(@@) :: TTerm Term -> TTerm Term -> TTerm Term+f @@ x = apply f x++-- * Fundamentals++-- | Apply a term-encoded function to a term-encoded argument+-- Example: apply (var "add") (int32 1)+apply :: TTerm Term -> TTerm Term -> TTerm Term+apply func arg = Core.termApplication $ Core.application func arg++-- | Create a term-encoded field with the given name and term-encoded value+-- Example: field "age" (int32 30)+field :: String -> TTerm Term -> TTerm Field+field s = Core.field (name s)++-- | Create a term-encoded let expression with multiple bindings+-- Example: lets ["x">: int32 1, "y">: int32 2] (var "add" @@ var "x" @@ var "y")+lets :: [(TTerm Name, TTerm Term)] -> TTerm Term -> TTerm Term+lets pairs body = Core.termLet $ Core.let_ (Phantoms.list $ toBinding pairs) body+  where+    toBinding = fmap (\(n, t) -> Core.binding n t Phantoms.nothing)++-- | Create a term-encoded variable reference from a string+-- Example: var "x"+var :: String -> TTerm Term+var = Core.termVariable . name++-- | Create a term-encoded variable reference from a Name+-- Example: varName (Name "x")+varName :: Name -> TTerm Term+varName (Name n) = Core.termVariable $ TTerm $ Terms.string n++-- | Maps a string to a phantom-typed variable term+-- Example: varPhantom "x" :: TTerm Int+varPhantom :: String -> TTerm a+varPhantom = TTerm . TermVariable . Name++-- | Create a phantom-typed variable reference from a Name+-- Example: varNamePhantom (Name "x") :: TTerm Int+varNamePhantom :: Name -> TTerm a+varNamePhantom = TTerm . TermVariable++-- * Functions++-- | Create a term-encoded constant function that always returns the same term-encoded value+-- Example: constant (int32 42)+constant :: TTerm Term -> TTerm Term+constant = lambda ignoredVariable++-- | Create a term-encoded lambda function with one parameter+-- Example: lambda "x" (var "add" @@ var "x" @@ int32 1)+lambda :: String -> TTerm Term -> TTerm Term+lambda var body = Core.termFunction $ Core.functionLambda $ Core.lambda (name var) Phantoms.nothing body++-- | Create a term-encoded multi-parameter lambda function (curried form)+-- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y")+lambdas :: [String] -> TTerm Term -> TTerm Term+lambdas params body = case params of+  [] -> body+  (h:rest) -> Core.termFunction $ Core.functionLambda $ Core.lambda (name h) Phantoms.nothing $ lambdas rest body++-- | Create a term-encoded primitive function reference+-- Example: primitive (Name "hydra.lib.strings.length")+primitive :: Name -> TTerm Term+primitive = primitiveLift . TTerm . EncodeCore.name++primitiveLift :: TTerm Name -> TTerm Term+primitiveLift = Core.termFunction . Core.functionPrimitive++-- | Create a term-encoded field projection function+-- Example: project (name "Person") (name "firstName")+project :: TTerm Name -> TTerm Name -> TTerm Term+project tname fname = Core.termFunction $ Core.functionElimination $ Core.eliminationRecord+  $ Core.projection tname fname++-- | Create a term-encoded unwrap function for a wrapped type+-- Example: unwrap (name "Email")+unwrap :: TTerm Name -> TTerm Term+unwrap = Core.termFunction . Core.functionElimination . Core.eliminationWrap++-- * Literal values++-- | Create a term-encoded unlimited precision integer+-- Example: bigint 42+bigint :: Integer -> TTerm Term+bigint = bigintLift . TTerm . Terms.bigint++-- | Lift a TTerm Integer to a term-encoded bigint literal+-- Example: bigintLift (varPhantom "x" :: TTerm Integer)+bigintLift :: TTerm Integer -> TTerm Term+bigintLift = Core.termLiteral . Core.literalInteger . Core.integerValueBigint++-- | Create a term-encoded boolean literal+-- Example: boolean True+boolean :: Bool -> TTerm Term+boolean = booleanLift . TTerm . Terms.boolean++-- | Lift a TTerm Bool to a term-encoded boolean literal+-- Example: booleanLift $ Phantoms.true+booleanLift :: TTerm Bool -> TTerm Term+booleanLift = Core.termLiteral . Core.literalBoolean++-- | Term-encoded boolean false literal+false :: TTerm Term+false = boolean False++-- | Create a term-encoded unlimited precision floating point literal+-- Example: bigfloat 3.14159+bigfloat :: Double -> TTerm Term+bigfloat = bigfloatLift . TTerm . Terms.bigfloat++-- | Lift a TTerm Double to a term-encoded bigfloat literal+bigfloatLift :: TTerm Double -> TTerm Term+bigfloatLift = Core.termLiteral . Core.literalFloat . Core.floatValueBigfloat++-- | Create a term-encoded 32-bit floating point literal+-- Example: float32 3.14+float32 :: Float -> TTerm Term+float32 = float32Lift . TTerm . Terms.float32++-- | Lift a TTerm Float to a term-encoded float32 literal+-- Example: float32Lift (varPhantom "x" :: TTerm Float)+float32Lift :: TTerm Float -> TTerm Term+float32Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat32++-- | Create a term-encoded 64-bit floating point literal+-- Example: float64 3.14159+float64 :: Double -> TTerm Term+float64 = float64Lift . TTerm . Terms.float64++-- | Lift a TTerm Float to a term-encoded float64 literal+-- Example: float64Lift (varPhantom "x" :: TTerm Float)+float64Lift :: TTerm Double -> TTerm Term+float64Lift = Core.termLiteral . Core.literalFloat . Core.floatValueFloat64++-- | Create a term-encoded 8-bit signed integer literal+-- Example: int8 127+int8 :: Int8 -> TTerm Term+int8 = int8Lift . TTerm . Terms.int8++-- | Lift a TTerm Int8 to a term-encoded int8 literal+-- Example: int8Lift (varPhantom "x" :: TTerm Int8)+int8Lift :: TTerm Int8 -> TTerm Term+int8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt8++-- | Create a term-encoded 16-bit signed integer literal+-- Example: int16 32767+int16 :: Int16 -> TTerm Term+int16 = int16Lift . TTerm . Terms.int16++-- | Lift a TTerm Int16 to a term-encoded int16 literal+-- Example: int16Lift (varPhantom "x" :: TTerm Int16)+int16Lift :: TTerm Int16 -> TTerm Term+int16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt16++-- | Create a term-encoded 32-bit signed integer literal+-- Example: int32 42+int32 :: Int -> TTerm Term+int32 = int32Lift . TTerm . Terms.int32++-- | Lift a TTerm Int to a term-encoded int32 literal+-- Example: int32Lift (varPhantom "x" :: TTerm Int)+int32Lift :: TTerm Int -> TTerm Term+int32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt32++-- | Create a term-encoded 64-bit signed integer literal+-- Example: int64 9223372036854775807+int64 :: Int64 -> TTerm Term+int64 = int64Lift . TTerm . Terms.int64++-- | Lift a TTerm Int64 to a term-encoded int64 literal+-- Example: int64Lift (varPhantom "x" :: TTerm Int64)+int64Lift :: TTerm Int64 -> TTerm Term+int64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueInt64++-- | Create a term-encoded string literal+-- Example: string "hello world"+string :: String -> TTerm Term+string = stringLift . TTerm . Terms.string++-- | Lift a TTerm String to a term-encoded string literal+-- Example: stringLift $ Phantoms.string "hello world"+stringLift :: TTerm String -> TTerm Term+stringLift = Core.termLiteral . Core.literalString++-- | Term-encoded boolean true literal+true :: TTerm Term+true = boolean True++-- | Create a term-encoded 8-bit unsigned integer literal+-- Example: uint8 255+uint8 :: Int16 -> TTerm Term+uint8 = uint8Lift . TTerm . Terms.uint8++uint8Lift :: TTerm Int16 -> TTerm Term+uint8Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint8++-- | Create a term-encoded 16-bit unsigned integer literal+-- Example: uint16 65535+uint16 :: Int -> TTerm Term+uint16 = uint16Lift . TTerm . Terms.uint16++-- | Lift a TTerm Int to a term-encoded uint16 literal+-- Example: uint16Lift (varPhantom "x" :: TTerm Int)+uint16Lift :: TTerm Int -> TTerm Term+uint16Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint16++-- | Create a term-encoded 32-bit unsigned integer literal+-- Example: uint32 4294967295+uint32 :: Int64 -> TTerm Term+uint32 = uint32Lift . TTerm . Terms.uint32++-- | Lift a TTerm Int64 to a term-encoded uint32 literal+uint32Lift :: TTerm Int64 -> TTerm Term+uint32Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint32++-- | Create a term-encoded 64-bit unsigned integer literal+-- Example: uint64 18446744073709551615+uint64 :: Integer -> TTerm Term+uint64 = uint64Lift . TTerm . Terms.uint64++-- | Lift a TTerm Integer to a term-encoded uint64 literal+-- Example: uint64Lift (varPhantom "x" :: TTerm Integer)+uint64Lift :: TTerm Integer -> TTerm Term+uint64Lift = Core.termLiteral . Core.literalInteger . Core.integerValueUint64++-- * Collections++-- | Create a term-encoded 'Just' optional value+-- Example: just (string "found")+just :: TTerm Term -> TTerm (Maybe Term)+just = Phantoms.just++-- | Create a term-encoded list+-- Example: list [int32 1, int32 2, int32 3]+list :: [TTerm Term] -> TTerm Term+list = Core.termList . Phantoms.list++-- | Create a term-encoded map/dictionary+-- Example: map (fromList [(string "key", int32 42)])+map :: TTerm (M.Map Term Term) -> TTerm Term+map = Core.termMap++-- | Create a term-encoded 'Nothing' optional value+nothing :: TTerm (Maybe Term)+nothing = Phantoms.nothing++-- | Create a term-encoded optional value from a Maybe+-- Example: optional (just (int32 42))+optional :: TTerm (Maybe Term) -> TTerm Term+optional = Core.termOptional++-- | Create a term-encoded set+-- Example: set [string "a", string "b", string "c"]+set :: [TTerm Term] -> TTerm Term+set els = Core.termSet $ TTerm $ TermSet $ S.fromList (unTTerm <$> els)++-- * Products and tuples++--first :: TTerm Term -> TTerm Term+--first t = Core.termFunction $ Core.functionElimination $ Core.eliminationProduct $ Core.tupleProjection 2 0 $++first :: TTerm Term -> TTerm Term+first pair = untuple 2 0 @@ pair++-- | Create a term-encoded pair (2-tuple)+-- Example: pair (string "name") (int32 42)+pair :: TTerm Term -> TTerm Term -> TTerm Term+pair t1 t2 = tuple [t1, t2]++---- | Create a term-encoded product (tuple) with multiple components+---- Example: product [string "name", int32 42, boolean True]+--product :: [TTerm Term] -> TTerm Term+--product terms = Core.termProduct $ TTerm $ TermList (unTTerm <$> terms)++second :: TTerm Term -> TTerm Term+second pair = untuple 2 1 @@ pair++-- | Create a term-encoded tuple with multiple components+-- Example: tuple [string "name", int32 42, boolean True]+tuple :: [TTerm Term] -> TTerm Term+tuple = Core.termProduct . Phantoms.list++-- | Create a term-encoded tuple projection function+-- Example: untuple 3 1 extracts the second element of a 3-tuple+untuple :: Int -> Int -> TTerm Term+untuple arity idx = Core.termFunction $ Core.functionElimination $ Core.eliminationProduct+  $ Core.tupleProjection (Phantoms.int32 arity) (Phantoms.int32 idx) Phantoms.nothing++-- * Records and unions++-- | Create a term-encoded union injection+-- Example: inject (name "Result") "success" (int32 42)+inject :: TTerm Name -> String -> TTerm Term -> TTerm Term+inject tname fname = Core.termUnion . Core.injection tname . Core.field (name fname)++-- | Create a term-encoded pattern match on a union+-- Example: match (name "Result") nothing ["success">: int32 42, "error">: string "fail"]+match :: TTerm Name -> TTerm (Maybe Term) -> [(TTerm Name, TTerm Term)] -> TTerm Term+match tname def pairs = Core.termFunction $ Core.functionElimination $ Core.eliminationUnion+    $ Core.caseStatement tname def $ Phantoms.list $ toField pairs+  where+    toField = fmap (\(n, t) -> Core.field n t)++-- | Create a term-encoded record with named fields+-- Example: record (name "Person") ["name">: string "John", "age">: int32 30]+record :: TTerm Name -> [(TTerm Name, TTerm Term)] -> TTerm Term+record name pairs = Core.termRecord $ Core.record name $ Phantoms.list (toField <$> pairs)+  where+    toField (n, t) = Core.field n t++-- | Create a term-encoded sum type instance+-- Example: sum 0 3 (int32 1) represents the first element of a 3-element sum+sum :: Int -> Int -> TTerm Term -> TTerm Term+sum i s = Core.termSum . Core.sum (Phantoms.int32 i) (Phantoms.int32 s)++unitVariantPhantom :: Name -> Name -> TTerm Term+unitVariantPhantom tname fname = variantPhantom tname fname Core.termUnit++variantPhantom :: Name -> Name -> TTerm Term -> TTerm Term+variantPhantom tname fname term = Core.termUnion $ Core.injection (Core.nameLift tname) $ Core.field (Core.nameLift fname) term++-- | Create a term-encoded wrapped term (newtype)+-- Example: wrap (name "Email") (string "user@example.com")+wrap :: TTerm Name -> TTerm Term -> TTerm Term+wrap name = Core.termWrap . Core.wrappedTerm name
+ src/main/haskell/Hydra/Dsl/TTypes.hs view
@@ -0,0 +1,201 @@+-- | A domain-specific language for constructing term-encoded Hydra types in Haskell;+--   these functions enable you to build terms (programs) which build types.++module Hydra.Dsl.TTypes (+  module Hydra.Dsl.TBase,+  module Hydra.Dsl.TTypes,+) where++import Hydra.Kernel+import qualified Hydra.Dsl.Phantoms as Phantoms+import Hydra.Dsl.Core as Core hiding (name, unName)+import Hydra.Dsl.TBase++import qualified Data.Map as M+import qualified Data.Maybe as Y+import Prelude hiding (map, product, sum)+++-- * Operators++-- | Type application operator+-- Example: typeConstructor @@ typeArg+(@@) :: TTerm Type -> TTerm Type -> TTerm Type+(@@) = apply++-- | Function type constructor operator+-- Example: int32 --> string+(-->) :: TTerm Type -> TTerm Type -> TTerm Type+(-->) = function++-- * Fundamentals++-- | Apply a term-encoded type to a type argument+-- Example: apply (var "Maybe") int32+apply :: TTerm Type -> TTerm Type -> TTerm Type+apply l r = typeApplication $ applicationType l r++-- | Create a term-encoded field with the given name and type+-- Example: field "age" int32+field :: String -> TTerm Type -> TTerm FieldType+field s = fieldType (name s)++-- | Create a term-encoded universal quantification (polymorphic type)+-- Example: forAll "a" (var "a" --> var "a")+forAll :: String -> TTerm Type -> TTerm Type+forAll var body = typeForall $ forallType (name var) body++-- | Create a term-encoded function type+-- Example: function int32 string+function :: TTerm Type -> TTerm Type -> TTerm Type+function dom cod = typeFunction $ functionType dom cod++-- | Create a term-encoded multi-parameter function type+-- Example: functionMany [int32, string, boolean]+functionMany :: [TTerm Type] -> TTerm Type+functionMany types = case types of+  [t] -> t+  t:ts -> function t $ functionMany ts++-- | Create a term-encoded monomorphic type scheme+-- Example: mono int32+mono :: TTerm Type -> TTerm TypeScheme+mono t = Phantoms.record _TypeScheme [+  Phantoms.field _TypeScheme_variables $ Phantoms.list [],+  Phantoms.field _TypeScheme_type t]++-- | Create a term-encoded polymorphic type scheme+-- Example: poly ["a", "b"] (var "a" --> var "b")+poly :: [String] -> TTerm Type -> TTerm TypeScheme+poly params t = Phantoms.record _TypeScheme [+  Phantoms.field _TypeScheme_variables (Phantoms.list (name <$> params)),+  Phantoms.field _TypeScheme_type t]++-- | Create a term-encoded type variable+-- Example: var "a"+var :: String -> TTerm Type+var = typeVariable . name++-- * Literals++-- | Create a term-encoded boolean type+-- Example: boolean+boolean :: TTerm Type+boolean = typeLiteral literalTypeBoolean++-- | Create a term-encoded FloatType representation+-- Example: float FloatTypeFloat64+float :: FloatType -> TTerm FloatType+float t = Phantoms.unitVariant _FloatType $ case t of+  FloatTypeBigfloat -> _FloatType_bigfloat+  FloatTypeFloat32 -> _FloatType_float32+  FloatTypeFloat64 -> _FloatType_float64++-- | Create a term-encoded 32-bit floating point type+-- Example: float32+float32 :: TTerm Type+float32 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat32++-- | Create a term-encoded 64-bit floating point type+-- Example: float64+float64 :: TTerm Type+float64 = typeLiteral $ literalTypeFloat $ float FloatTypeFloat64++-- | Create a term-encoded 16-bit signed integer type+-- Example: int16+int16 :: TTerm Type+int16 = typeLiteral $ literalTypeInteger integerTypeInt16++-- | Create a term-encoded 32-bit signed integer type+-- Example: int32+int32 :: TTerm Type+int32 = typeLiteral $ literalTypeInteger integerTypeInt32++-- | Create a term-encoded 64-bit signed integer type+-- Example: int64+int64 :: TTerm Type+int64 = typeLiteral $ literalTypeInteger integerTypeInt64++-- | Create a term-encoded IntegerType representation+-- Example: integer IntegerTypeInt32+integer :: IntegerType -> TTerm IntegerType+integer t = Phantoms.unitVariant _IntegerType $ case t of+  IntegerTypeBigint -> _IntegerType_bigint+  IntegerTypeInt8 -> _IntegerType_int8+  IntegerTypeInt16 -> _IntegerType_int16+  IntegerTypeInt32 -> _IntegerType_int32+  IntegerTypeInt64 -> _IntegerType_int64+  IntegerTypeUint8 -> _IntegerType_uint8+  IntegerTypeUint16 -> _IntegerType_uint16+  IntegerTypeUint32 -> _IntegerType_uint32+  IntegerTypeUint64 -> _IntegerType_uint64++-- | Create a term-encoded string type+-- Example: string+string :: TTerm Type+string = typeLiteral literalTypeString++-- | Create a term-encoded 64-bit unsigned integer type+-- Example: uint64+uint64 :: TTerm Type+uint64 = typeLiteral $ literalTypeInteger integerTypeUint64++-- * Collections++-- | Create a term-encoded list type+-- Example: list string+list :: TTerm Type -> TTerm Type+list = typeList++-- | Create a term-encoded map/dictionary type+-- Example: map string int32+map :: TTerm Type -> TTerm Type -> TTerm Type+map k v = typeMap $ mapType k v++-- | Create a term-encoded optional (nullable) type+-- Example: optional string+optional :: TTerm Type -> TTerm Type+optional = typeOptional++-- | Create a term-encoded set type+-- Example: set string+set :: TTerm Type -> TTerm Type+set = typeSet++-- * Records and unions++-- | Create a term-encoded record type with named fields+-- Example: record (name "Person") ["name">: string, "age">: int32]+record :: TTerm Name -> [(TTerm Name, TTerm Type)] -> TTerm Type+record name pairs = typeRecord $ rowType name $ Phantoms.list (toField <$> pairs)+  where+    toField (n, t) = fieldType n t++-- | Create a term-encoded union type with named variants+-- Example: union (name "Result") ["success">: int32, "error">: string]+union :: TTerm Name -> [(TTerm Name, TTerm Type)] -> TTerm Type+union name pairs = typeUnion $ rowType name $ Phantoms.list (toField <$> pairs)+  where+    toField (n, t) = fieldType n t++-- | Term-encoded unit type (empty record type)+-- Example: unit+unit :: TTerm Type+unit = typeUnit++-- * Products and sums++-- | Create a term-encoded pair (2-tuple) type+-- Example: pair string int32+pair :: TTerm Type -> TTerm Type -> TTerm Type+pair l r = product [l, r]++-- | Create a term-encoded product type (tuple) with multiple components+-- Example: product [string, int32, boolean]+product :: [TTerm Type] -> TTerm Type+product types = Core.typeProduct $ TTerm $ TermList (unTTerm <$> types)++-- | Create a term-encoded sum type (disjoint union) with multiple variants+-- Example: sum [string, int32, boolean]+sum :: [TTerm Type] -> TTerm Type+sum types = Core.typeSum $ TTerm $ TermList (unTTerm <$> types)
+ src/main/haskell/Hydra/Dsl/Tabular.hs view
@@ -0,0 +1,19 @@+module Hydra.Dsl.Tabular where++import Hydra.Core+import Hydra.Relational+++data ColumnType = ColumnType {+  columnTypeName ::  ColumnName,+  columnTypeType :: Type} deriving (Eq, Ord, Show)++data TableType = TableType {+  tableTypeName :: RelationName,+  tableTypeColumns :: [ColumnType]} deriving (Eq, Ord, Show)++columnType :: String -> Type -> ColumnType+columnType name typ = ColumnType (ColumnName name) typ++tableType :: String -> [ColumnType] -> TableType+tableType name columns = TableType (RelationName name) columns
src/main/haskell/Hydra/Dsl/Terms.hs view
@@ -1,228 +1,381 @@--- | A DSL for constructing Hydra terms--{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for IsString Term+-- | A domain-specific language for constructing Hydra terms in Haskell. module Hydra.Dsl.Terms where -import Hydra.Compute import Hydra.Constants import Hydra.Core import Hydra.Graph+import Hydra.Mantle+import Hydra.Dsl.Common import qualified Hydra.Dsl.Literals as Literals -import Prelude hiding (map)+import Prelude hiding (map, product, sum)+import Data.Int+import qualified Data.Char as C import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Control.Monad as CM-import Data.Int-import Data.String(IsString(..))  -instance IsString Term where fromString = string---- Two alternative symbols for term application-(@@) :: Term -> Term -> Term-f @@ x = apply f x-($$) :: Term -> Term -> Term-f $$ x = apply f x----(<$>) :: Term -> Term -> Term---f <$> x = apply f x+-- * Operators +-- | Function composition operator: f <.> g creates a function that applies g then f+-- Example: var "stringLength" <.> var "toString" (<.>) :: Term -> Term -> Term f <.> g = compose f g +-- | Term application operator: function @@ argument+-- Example: var "add" @@ int32 1+(@@) :: Term -> Term -> Term+fun @@ arg = apply fun arg++-- | Field definition operator: name>: value+-- Example: "name">: string "John" infixr 0 >: (>:) :: String -> Term -> Field-n >: t = field n t+name>: term = field name term +-- * Fundamentals++-- | Attach an annotation to a term+-- Example: annot (M.fromList [(Name "comment", string "A User ID")]) (var "userId") annot :: M.Map Name Term -> Term -> Term-annot ann t = TermAnnotated $ AnnotatedTerm t ann+annot ann term = TermAnnotated $ AnnotatedTerm term ann +-- | Attach an annotation to a term+-- Example: annotated (var "userId") (M.fromList [(Name "comment", string "A User ID")])+annotated :: Term -> M.Map Name Term -> Term+annotated term ann = TermAnnotated $ AnnotatedTerm term ann++-- | Apply a function term to an argument+-- Example: apply (var "capitalize") (string "arthur") apply :: Term -> Term -> Term-apply func arg = TermApplication $ Application func arg+apply fun arg = TermApplication $ Application fun arg -bigfloat :: Double -> Term-bigfloat = literal . Literals.bigfloat+applyAll :: Term -> [Term] -> Term+applyAll fun args = foldl apply fun args -bigint :: Integer -> Term-bigint = literal . Literals.bigint+-- | Create a let term with any number of bindings+-- Example: lets ["x">: int32 1, "y">: int32 2] (pair (var "x") (var "y"))+lets :: [Field] -> Term -> Term+lets bindings env = TermLet $ Let (toBinding <$> bindings) env+  where+    toBinding (Field name value) = Binding name value Nothing -binary :: String -> Term-binary = literal . Literals.binary+-- | Create a variable reference+-- Example: var "x"+var :: String -> Term+var = TermVariable . Name -boolean :: Bool -> Term-boolean = literal . Literals.boolean+-- * Functions +-- | Compose two functions (apply g then f) to create a new function+-- Example: compose (var "stringLength") (var "toString")+-- This creates a function equivalent to \x -> stringLength(toString(x))+-- Function composition applies right-to-left: (f ∘ g)(x) = f(g(x)) compose :: Term -> Term -> Term-compose f g = lambda "x" $ apply f (apply g $ var "x")+compose f g = lambda "arg_" $ apply f (apply g $ var "arg_") +-- | Create a constant function that always returns the same value+-- Example: constant true constant :: Term -> Term constant = lambda ignoredVariable -elimination :: Elimination -> Term-elimination = TermFunction . FunctionElimination+-- | Identity function+identity :: Term+identity = lambda "x_" $ var "x_" -false :: Term-false = boolean False+-- | Create a lambda function with one parameter+-- Example: lambda "x" (var "x" @@ int32 1)+lambda :: String -> Term -> Term+lambda param body = TermFunction $ FunctionLambda $ Lambda (Name param) Nothing body -field :: String -> Term -> Field-field n = Field (Name n)+-- | Create a multi-parameter lambda function (curried)+-- Example: lambdas ["x", "y"] (var "add" @@ var "x" @@ var "y")+-- This creates the function \x.\y.add x y+lambdas :: [String] -> Term -> Term+lambdas params body = case params of+  [] -> body+  (h:r) -> lambda h $ lambdas r body -fieldsToMap :: [Field] -> M.Map Name Term-fieldsToMap fields = M.fromList $ (\(Field name term) -> (name, term)) <$> fields+-- | Create a lambda function with a given domain+-- Example: lambdaTyped "x" Types.int32 (list [var "x"])+lambdaTyped :: String -> Type -> Term -> Term+lambdaTyped param dom body = TermFunction $ FunctionLambda $ Lambda (Name param) (Just dom) body -first :: Term-first = untuple 2 0+-- | Create a primitive function+-- Example: primitive (Name "hydra.lib.strings.length")+primitive :: Name -> Term+primitive = TermFunction . FunctionPrimitive +-- * Polymorphism (System F)++-- | Create a type abstraction (universal quantification)+-- Example: typeLambda [Name "a", Name "b"] (lambdaTyped "f" (Types.function (Types.var "a") (Types.var "b"))+--                                               (lambdaTyped "x" (Types.var "a") (var "f" @@ var "x")))+-- This creates a polymorphic term with type variables.+-- The example creates a higher-order function with type 'forall a b. (a -> b) -> a -> b',+-- which is the polymorphic apply function that works for any types a and b.+typeLambda :: [Name] -> Term -> Term+typeLambda vars body = L.foldl (\b v -> TermTypeLambda $ TypeLambda v b) body vars++-- | Apply type arguments to a polymorphic term+-- Example: typeApplication (var "map") [Types.int32, Types.string]+-- This instantiates a polymorphic function with concrete types.+-- For instance, if 'map' has type 'forall a b. (a -> b) -> list a -> list b',+-- the example would instantiate it to '(int32 -> string) -> list int32 -> list string'.+typeApplication :: Term -> [Type] -> Term+typeApplication term types = L.foldl (\t ty -> TermTypeApplication $ TypedTerm t ty) term types++-- * Literal values++-- | Create a binary data literal. The encoding scheme is currently application-dependent.+-- Example: binary ""\x48\x65\x00\xff\x20\x7a\x1b\x80"+binary :: String -> Term+binary = literal . Literals.binary++-- | Create a bigfloat literal. Note: in practice, precision is limited to 64 bits (same as Double) in Haskell.+-- Example: bigfloat 3.14159265359+bigfloat :: Double -> Term+bigfloat = literal . Literals.bigfloat++-- | Create a bigint literal+-- Example: bigint 9223372036854775808+bigint :: Integer -> Term+bigint = literal . Literals.bigint++-- | Create a boolean literal+-- Example: boolean True+boolean :: Bool -> Term+boolean = literal . Literals.boolean++char :: Char -> Term+char = int32 . C.ord++-- | Boolean false literal+false :: Term+false = boolean False++-- | Create a float32 literal+-- Example: float32 3.14 float32 :: Float -> Term float32 = literal . Literals.float32 +-- | Create a float64 literal+-- Example: float64 3.14159265359 float64 :: Double -> Term float64 = literal . Literals.float64 +-- | Create a floating-point literal with specified precision+-- Example: float (FloatValueFloat32 3.14) float :: FloatValue -> Term float = literal . Literals.float -fold :: Term -> Term-fold = TermFunction . FunctionElimination . EliminationList--identity :: Term-identity = lambda "x" $ var "x"--inject :: Name -> Field -> Term-inject tname = TermUnion . Injection tname+-- | Create an int8 literal+-- Example: int8 127+int8 :: Int8 -> Term+int8 = literal . Literals.int8 +-- | Create an int16 literal+-- Example: int16 32767 int16 :: Int16 -> Term int16 = literal . Literals.int16 +-- | Create an int32 literal+-- Example: int32 42 int32 :: Int -> Term int32 = literal . Literals.int32 +-- | Create an int64 literal+-- Example: int64 9223372036854775807 int64 :: Int64 -> Term int64 = literal . Literals.int64 -int8 :: Int8 -> Term-int8 = literal . Literals.int8-+-- | Create an integer literal with specified bit width+-- Example: integer (IntegerValueInt32 42) integer :: IntegerValue -> Term integer = literal . Literals.integer -just :: Term -> Term-just = optional . Just+-- | Create a term from a literal value+-- Example: literal (LiteralString "hello")+literal :: Literal -> Term+literal = TermLiteral -lambda :: String -> Term -> Term-lambda param body = TermFunction $ FunctionLambda $ Lambda (Name param) Nothing body+-- | Create a string literal+-- Example: string "hello world"+string :: String -> Term+string = TermLiteral . LiteralString -letMulti :: [(String, Term)] -> Term -> Term-letMulti bindings body = TermLet $ Let (toBinding <$> bindings) body-  where-    toBinding (name, term) = LetBinding (Name name) term Nothing+-- | Boolean true literal+true :: Term+true = boolean True --- Construct a 'let' term with a single binding-letTerm :: Name -> Term -> Term -> Term-letTerm v t1 t2 = TermLet $ Let [LetBinding v t1 Nothing] t2+-- | Create a uint8 literal+-- Example: uint8 255+uint8 :: Int16 -> Term+uint8 = literal . Literals.uint8 -list :: [Term] -> Term-list = TermList+-- | Create a uint16 literal+-- Example: uint16 65535+uint16 :: Int -> Term+uint16 = literal . Literals.uint16 -literal :: Literal -> Term-literal = TermLiteral+-- | Create a uint32 literal+-- Example: uint32 4294967295+uint32 :: Int64 -> Term+uint32 = literal . Literals.uint32 -map :: M.Map Term Term -> Term-map = TermMap+-- | Create a uint64 literal+-- Example: uint64 18446744073709551615+uint64 :: Integer -> Term+uint64 = literal . Literals.uint64 -mapTerm :: M.Map Term Term -> Term-mapTerm = TermMap+-- * Collections -match :: Name -> Maybe Term -> [Field] -> Term-match tname def fields = TermFunction $ FunctionElimination $ EliminationUnion $ CaseStatement tname def fields+-- | Create a 'Just' optional value+-- Example: just (string "found")+just :: Term -> Term+just = optional . Just -matchOpt :: Term -> Term -> Term-matchOpt n j = TermFunction $ FunctionElimination $ EliminationOptional $ OptionalCases n j+-- | Create a list of terms+-- Example: list [int32 1, int32 2, int32 3]+list :: [Term] -> Term+list = TermList -matchWithVariants :: Name -> Maybe Term -> [(Name, Name)] -> Term-matchWithVariants tname def pairs = match tname def (toField <$> pairs)-  where-    toField (from, to) = Field from $ constant $ unitVariant tname to+-- | Create a map/dictionary term+-- Example: map (M.fromList [(string "January", int32 31), (string "February", int32 28)])+map :: M.Map Term Term -> Term+map = TermMap +-- | Create a 'Nothing' optional value nothing :: Term nothing = optional Nothing -optional :: Y.Maybe Term -> Term+-- | Create an optional (nullable) term+-- Example: optional (Just (string "found"))+optional :: Maybe Term -> Term optional = TermOptional -pair :: Term -> Term -> Term-pair a b = TermProduct [a, b]+-- | Create a set of terms+-- Example: set (S.fromList [string "a", string "b", string "c"])+set :: S.Set Term -> Term+set = TermSet -primitive :: Name -> Term-primitive = TermFunction . FunctionPrimitive+-- * Records, unions and newtypes -product :: [Term] -> Term-product = TermProduct+-- | Create a field with the given name and value+-- Example: field "age" (int32 30)+field :: String -> Term -> Field+field n = Field (Name n) +-- | Create a union value by injecting a value into a specific variant+-- Example: inject (Name "Result") ("success">: int32 42)+-- This creates a "Result" union with the "success" variant containing value 42+-- Use this to construct values of union types at runtime+inject :: Name -> Field -> Term+inject tname = TermUnion . Injection tname++-- | Create a pattern match on a union type+-- Example: match (Name "Result") (Just (string "unknown"))+--               ["success">: lambda "s" (var "processSuccess" @@ var "s"),+--                "error">: lambda "e" (var "handleError" @@ var "e")]+-- This allows handling different cases of a union type with specific logic for each variant.+-- The optional second parameter provides a default case for any unmatched variants.+match :: Name -> Maybe Term -> [Field] -> Term+match tname def fields = TermFunction $ FunctionElimination $ EliminationUnion $ CaseStatement tname def fields++-- | Create a pattern match using variant name pairs+-- Example: matchWithVariants (Name "Result") Nothing [(Name "success", Name "handleSuccess"), (Name "error", Name "handleError")]+matchWithVariants :: Name -> Maybe Term -> [(Name, Name)] -> Term+matchWithVariants tname def pairs = match tname def (toField <$> pairs)+  where+    toField (from, to) = Field from $ constant $ unitVariant tname to++-- | Create a field projection function+-- Example: project (Name "Person") (Name "firstName") project :: Name -> Name -> Term project tname fname = TermFunction $ FunctionElimination $ EliminationRecord $ Projection tname fname +-- | Create a record with named fields of the specified type+-- Example: record (Name "Person") [+--            "name">: string "John",+--            "age">: int32 30,+--            "email">: string "john@example.com"]+-- Records are products of named fields with values that can be accessed by field name record :: Name -> [Field] -> Term record tname fields = TermRecord $ Record tname fields -second :: Term-second = untuple 2 1--set :: S.Set Term -> Term-set = TermSet+-- | Unit value (empty record)+unit :: Term+unit = TermUnit -string :: String -> Term-string = TermLiteral . LiteralString+-- | Create a unit variant of a union+-- Example: unitVariant (Name "Result") (Name "success")+unitVariant :: Name -> Name -> Term+unitVariant tname fname = variant tname fname unit -sum :: Int -> Int -> Term -> Term-sum i s term = TermSum $ Sum i s term+-- | Create a union variant+-- Example: variant (Name "Result") (Name "success") (string "ok")+variant :: Name -> Name -> Term -> Term+variant tname fname term = TermUnion $ Injection tname $ Field fname term -true :: Term-true = boolean True+-- | Create a constant function that produces a unit variant+-- Example: withVariant (Name "Result") (Name "success")+withVariant :: Name -> Name -> Term+withVariant tname = constant . unitVariant tname -typed :: Type -> Term -> Term-typed typ term = TermTyped $ TypedTerm term typ+-- | Create a wrapped term+-- Example: wrap (Name "Email") (string "user@example.com")+wrap :: Name -> Term -> Term+wrap name term = TermWrap $ WrappedTerm name term -uint16 :: Int -> Term-uint16 = literal . Literals.uint16+-- | Create an unwrap function for a wrapped type+-- Example: unwrap (Name "Email")+unwrap :: Name -> Term+unwrap = TermFunction . FunctionElimination . EliminationWrap -uint32 :: Int64 -> Term-uint32 = literal . Literals.uint32+-- * Products and sums -uint64 :: Integer -> Term-uint64 = literal . Literals.uint64+-- | First element projection function for pairs+first :: Term+first = untuple 2 0 -uint8 :: Int16 -> Term-uint8 = literal . Literals.uint8+-- | Create a pair (2-tuple)+-- Example: pair (string "name") (int32 42)+pair :: Term -> Term -> Term+pair a b = TermProduct [a, b] -unit :: Term-unit = TermRecord $ Record _Unit []+-- | Second element projection function for pairs+second :: Term+second = untuple 2 1 -unitVariant :: Name -> Name -> Term-unitVariant tname fname = variant tname fname unit+-- | Create a sum term+-- Example: sum 0 3 (int32 1) represents the first element of a 3-element sum+sum :: Int -> Int -> Term -> Term+sum idx arity term = TermSum $ Sum idx arity term -untuple :: Int -> Int -> Term-untuple arity idx = TermFunction $ FunctionElimination $ EliminationProduct $ TupleProjection arity idx+triple :: Term -> Term -> Term -> Term+triple a b c = tuple [a, b, c] -unwrap :: Name -> Term-unwrap = TermFunction . FunctionElimination . EliminationWrap+-- | Create a product (tuple) with multiple components+-- Example: product [string "name", int32 42, true]+tuple :: [Term] -> Term+tuple = TermProduct -var :: String -> Term-var = TermVariable . Name+tuple4 :: Term -> Term -> Term -> Term -> Term+tuple4 a b c d = tuple [a, b, c, d] -variant :: Name -> Name -> Term -> Term-variant tname fname term = TermUnion $ Injection tname $ Field fname term+tuple5 :: Term -> Term -> Term -> Term -> Term -> Term+tuple5 a b c d e = tuple [a, b, c, d, e] -with :: Term -> [Field] -> Term-env `with` bindings = TermLet $ Let (toBinding <$> bindings) env-  where-     toBinding (Field name value) = LetBinding name value Nothing+-- | Create a untyped tuple projection function+-- Example: untuple 3 1 Nothing extracts the second element of a 3-tuple+untuple :: Int -> Int -> Term+untuple arity idx = TermFunction $ FunctionElimination $ EliminationProduct $ TupleProjection arity idx Nothing -withVariant :: Name -> Name -> Term-withVariant tname = constant . unitVariant tname+-- | Other -wrap :: Name -> Term -> Term-wrap name term = TermWrap $ WrappedTerm name term+comparison :: Comparison -> Term+comparison t = case t of+  ComparisonEqualTo -> unitVariant _Comparison _Comparison_equalTo+  ComparisonLessThan -> unitVariant _Comparison _Comparison_lessThan+  ComparisonGreaterThan -> unitVariant _Comparison _Comparison_greaterThan
+ src/main/haskell/Hydra/Dsl/Testing.hs view
@@ -0,0 +1,142 @@+-- TODO: merge with Hydra.Dsl.Tests+module Hydra.Dsl.Testing where++import Hydra.Kernel+import Hydra.Testing as Testing+import Hydra.Dsl.Phantoms as Phantoms+import qualified Hydra.Encode.Core as EncodeCore+import qualified Hydra.Dsl.Core as Core+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T++import qualified Data.List as L+import qualified Data.Map as M+++tag_disabled = Tag "disabled"+tag_disabledForMinimalInference = Tag "disabledForMinimalInference"++expectFailure i tags term = infFailureTest ("#" ++ show i) tags term++expectMono i tags term typ = infTest ("#" ++ show i) tags term $ T.mono typ++expectPoly i tags term params typ = infTest ("#" ++ show i) tags term $ T.poly params typ++groupRef = TTerms.varNamePhantom . bindingName++infFailureTest :: String -> [Tag] -> TTerm Term -> TTerm TestCaseWithMetadata+infFailureTest name tags term = testCaseWithMetadata (Phantoms.string name)+  (testCaseInferenceFailure $ inferenceFailureTestCase term) nothing (Phantoms.list $ tag . unTag <$> tags)++infTest :: String -> [Tag] -> TTerm Term -> TTerm TypeScheme -> TTerm TestCaseWithMetadata+infTest name tags term ts = testCaseWithMetadata (Phantoms.string name)+  (testCaseInference $ inferenceTestCase term ts) nothing (Phantoms.list $ tag . unTag <$> tags)++isDisabled tcase = tag_disabled `L.elem` Testing.testCaseWithMetadataTags tcase+isDisabledForMinimalInference tcase = tag_disabledForMinimalInference `L.elem` Testing.testCaseWithMetadataTags tcase++-- Note: this is a cheat for an encoded map term; consider using the TTerms DSL+mapTermCheat :: [(Term, Term)] -> TTerm Term+mapTermCheat = TTerm . EncodeCore.term . Terms.map . M.fromList++subgroup :: String -> [TTerm TestCaseWithMetadata] -> TTerm TestGroup+subgroup name = tgroup name Nothing []++supergroup :: String -> [TTerm TestGroup] -> TTerm TestGroup+supergroup name subgroups = tgroup name Nothing subgroups []++tag :: String -> TTerm Tag+tag = Phantoms.wrap _Tag . Phantoms.string++tgroup :: String -> Maybe String -> [TTerm TestGroup] -> [TTerm TestCaseWithMetadata] -> TTerm TestGroup+tgroup name mdesc subgroups cases = testGroup (Phantoms.string name) (opt (Phantoms.string <$> mdesc)) (Phantoms.list subgroups) (Phantoms.list cases)++----------------------------------------++encodeGroup (TestGroup name desc groups cases) = Terms.record _TestGroup [+  Field _TestGroup_name $ Terms.string name,+  Field _TestGroup_description $ Terms.optional (Terms.string <$> desc),+  Field _TestGroup_subgroups $ Terms.list (encodeGroup <$> groups),+  Field _TestGroup_cases $ Terms.list (encodeCaseWithMetadata <$> cases)]+encodeCaseWithMetadata (TestCaseWithMetadata name tcase mdesc tags) = Terms.record _TestCaseWithMetadata [+  Field _TestCaseWithMetadata_name $ Terms.string name,+  Field _TestCaseWithMetadata_case $ encodeCase tcase,+  Field _TestCaseWithMetadata_description $ Terms.optional (Terms.string <$> mdesc),+  Field _TestCaseWithMetadata_tags $ Terms.list (Terms.string . unTag <$> tags)]+encodeCase tcase = case tcase of+  TestCaseCaseConversion ccase -> Terms.variant _TestCase _TestCase_caseConversion $ encodeCaseConversionTestCase ccase+  TestCaseEvaluation ecase -> Terms.variant _TestCase _TestCase_evaluation $ encodeEvaluationTestCase ecase+  TestCaseInference icase -> Terms.variant _TestCase _TestCase_inference $ encodeInferenceTestCase icase+encodeCaseConvention c = Terms.unitVariant _CaseConvention $ case c of+  CaseConventionLowerSnake -> _CaseConvention_lowerSnake+  CaseConventionUpperSnake -> _CaseConvention_upperSnake+  CaseConventionCamel -> _CaseConvention_camel+  CaseConventionPascal -> _CaseConvention_pascal+encodeCaseConversionTestCase (CaseConversionTestCase fromConvention toConvention fromString toString) = Terms.record _CaseConversionTestCase [+  Field _CaseConversionTestCase_fromConvention $ encodeCaseConvention fromConvention,+  Field _CaseConversionTestCase_toConvention $ encodeCaseConvention toConvention,+  Field _CaseConversionTestCase_fromString $ Terms.string fromString,+  Field _CaseConversionTestCase_toString $ Terms.string toString]+encodeEvaluationTestCase (EvaluationTestCase style input output) = Terms.record _EvaluationTestCase [+  Field _EvaluationTestCase_evaluationStyle $ Terms.variant _EvaluationStyle (case style of+    EvaluationStyleEager -> _EvaluationStyle_eager+    EvaluationStyleLazy -> _EvaluationStyle_lazy) Terms.unit,+  Field _EvaluationTestCase_input $ EncodeCore.term input,+  Field _EvaluationTestCase_output $ EncodeCore.term output]+encodeInferenceTestCase (InferenceTestCase input output) = Terms.record _InferenceTestCase [+  Field _InferenceTestCase_input $ EncodeCore.term input,+  Field _InferenceTestCase_output $ EncodeCore.typeScheme output]++----------------------------------------++encodedTestGroupToBinding :: Namespace -> String -> TTerm TestGroup -> Binding+encodedTestGroupToBinding ns lname group = Binding name (unTTerm group)+    $ Just $ TypeScheme [] typ+  where+    name = unqualifyName $ QualifiedName (Just ns) lname+    typ = TypeVariable _TestGroup++inferenceFailureTestCase :: TTerm Term -> TTerm InferenceFailureTestCase+inferenceFailureTestCase input = Phantoms.record _InferenceFailureTestCase [+  _InferenceFailureTestCase_input>>: input]++inferenceTestCase :: TTerm Term -> TTerm TypeScheme -> TTerm InferenceTestCase+inferenceTestCase input output = Phantoms.record _InferenceTestCase [+  _InferenceTestCase_input>>: input,+  _InferenceTestCase_output>>: output]++testCaseInference :: TTerm InferenceTestCase -> TTerm TestCase+testCaseInference = variant _TestCase _TestCase_inference++testCaseInferenceFailure :: TTerm InferenceFailureTestCase -> TTerm TestCase+testCaseInferenceFailure = variant _TestCase _TestCase_inferenceFailure++testCaseWithMetadata :: TTerm String -> TTerm TestCase -> TTerm (Maybe String) -> TTerm [Tag] -> TTerm TestCaseWithMetadata+testCaseWithMetadata name tcase description tags = Phantoms.record _TestCaseWithMetadata [+  _TestCaseWithMetadata_name>>: name,+  _TestCaseWithMetadata_case>>: tcase,+  _TestCaseWithMetadata_description>>: description,+  _TestCaseWithMetadata_tags>>: tags]++testCaseWithMetadataName :: TTerm (TestCaseWithMetadata -> String)+testCaseWithMetadataName = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_name++testCaseWithMetadataCase :: TTerm (TestCaseWithMetadata -> TestCase)+testCaseWithMetadataCase = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_case++testCaseWithMetadataDescription :: TTerm (TestCaseWithMetadata -> Maybe String)+testCaseWithMetadataDescription = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_description++testCaseWithMetadataTags :: TTerm (TestCaseWithMetadata -> [Tag])+testCaseWithMetadataTags = Phantoms.project _TestCaseWithMetadata _TestCaseWithMetadata_tags++testGroup :: TTerm String -> TTerm (Maybe String) -> TTerm [TestGroup] -> TTerm [TestCaseWithMetadata] -> TTerm TestGroup+testGroup name description subgroups cases = Phantoms.record _TestGroup [+  _TestGroup_name>>: name,+  _TestGroup_description>>: description,+  _TestGroup_subgroups>>: subgroups,+  _TestGroup_cases>>: cases]++testGroupToBinding :: Namespace -> String -> TestGroup -> Binding+testGroupToBinding ns lname group = encodedTestGroupToBinding ns lname (TTerm $ encodeGroup group)
src/main/haskell/Hydra/Dsl/Tests.hs view
@@ -20,9 +20,10 @@ intListList :: [[Int]] -> Term intListList lists = list (intList <$> lists) -primCase :: Name -> [Term] -> Term -> TestCase-primCase name args output = TestCase Nothing EvaluationStyleEager input output+primCase :: String -> Name -> [Term] -> Term -> TestCaseWithMetadata+primCase cname name args output = TestCaseWithMetadata cname tcase Nothing []   where+    tcase = TestCaseEvaluation $ EvaluationTestCase EvaluationStyleEager input output     input = L.foldl (\a arg -> a @@ arg) (primitive name) args  stringList :: [String] -> Term@@ -30,5 +31,3 @@  stringSet :: S.Set String -> Term stringSet strings = set $ S.fromList $ string <$> S.toList strings--testCase = TestCase Nothing
+ src/main/haskell/Hydra/Dsl/Topology.hs view
@@ -0,0 +1,103 @@+module Hydra.Dsl.Topology where++import Hydra.Kernel+import Hydra.Dsl.Phantoms+import Hydra.Topology as Topology++import qualified Data.Map as M+import qualified Data.Set as S+++orderingIsomorphism :: TTerm ([a] -> [a])+                  -> TTerm ([a] -> [a])+                  -> TTerm (Topology.OrderingIsomorphism a)+orderingIsomorphism encode decode = record _OrderingIsomorphism [+    _OrderingIsomorphism_encode>>: encode,+    _OrderingIsomorphism_decode>>: decode]++tarjanState :: TTerm Int+            -> TTerm (M.Map Vertex Int)+            -> TTerm (M.Map Vertex Int)+            -> TTerm [Vertex]+            -> TTerm (S.Set Vertex)+            -> TTerm [[Vertex]]+            -> TTerm TarjanState+tarjanState counter indices lowLinks stack onStack sccs = record _TarjanState [+    _TarjanState_counter>>: counter,+    _TarjanState_indices>>: indices,+    _TarjanState_lowLinks>>: lowLinks,+    _TarjanState_stack>>: stack,+    _TarjanState_onStack>>: onStack,+    _TarjanState_sccs>>: sccs]++tarjanStateCounter :: TTerm TarjanState -> TTerm Int+tarjanStateCounter ts = project _TarjanState _TarjanState_counter @@ ts++tarjanStateIndices :: TTerm TarjanState -> TTerm (M.Map Vertex Int)+tarjanStateIndices ts = project _TarjanState _TarjanState_indices @@ ts++tarjanStateLowLinks :: TTerm TarjanState -> TTerm (M.Map Vertex Int)+tarjanStateLowLinks ts = project _TarjanState _TarjanState_lowLinks @@ ts++tarjanStateStack :: TTerm TarjanState -> TTerm [Vertex]+tarjanStateStack ts = project _TarjanState _TarjanState_stack @@ ts++tarjanStateOnStack :: TTerm TarjanState -> TTerm (S.Set Vertex)+tarjanStateOnStack ts = project _TarjanState _TarjanState_onStack @@ ts++tarjanStateSccs :: TTerm TarjanState -> TTerm [[Vertex]]+tarjanStateSccs ts = project _TarjanState _TarjanState_sccs @@ ts++tarjanStateWithCounter :: TTerm TarjanState -> TTerm Int -> TTerm TarjanState+tarjanStateWithCounter ts counter = tarjanState+    counter+    (Hydra.Dsl.Topology.tarjanStateIndices ts)+    (Hydra.Dsl.Topology.tarjanStateLowLinks ts)+    (Hydra.Dsl.Topology.tarjanStateStack ts)+    (Hydra.Dsl.Topology.tarjanStateOnStack ts)+    (Hydra.Dsl.Topology.tarjanStateSccs ts)++tarjanStateWithIndices :: TTerm TarjanState -> TTerm (M.Map Vertex Int) -> TTerm TarjanState+tarjanStateWithIndices ts indices = tarjanState+    (Hydra.Dsl.Topology.tarjanStateCounter ts)+    indices+    (Hydra.Dsl.Topology.tarjanStateLowLinks ts)+    (Hydra.Dsl.Topology.tarjanStateStack ts)+    (Hydra.Dsl.Topology.tarjanStateOnStack ts)+    (Hydra.Dsl.Topology.tarjanStateSccs ts)++tarjanStateWithLowLinks :: TTerm TarjanState -> TTerm (M.Map Vertex Int) -> TTerm TarjanState+tarjanStateWithLowLinks ts lowLinks = tarjanState+    (Hydra.Dsl.Topology.tarjanStateCounter ts)+    (Hydra.Dsl.Topology.tarjanStateIndices ts)+    lowLinks+    (Hydra.Dsl.Topology.tarjanStateStack ts)+    (Hydra.Dsl.Topology.tarjanStateOnStack ts)+    (Hydra.Dsl.Topology.tarjanStateSccs ts)++tarjanStateWithStack :: TTerm TarjanState -> TTerm [Vertex] -> TTerm TarjanState+tarjanStateWithStack ts stack = tarjanState+    (Hydra.Dsl.Topology.tarjanStateCounter ts)+    (Hydra.Dsl.Topology.tarjanStateIndices ts)+    (Hydra.Dsl.Topology.tarjanStateLowLinks ts)+    stack+    (Hydra.Dsl.Topology.tarjanStateOnStack ts)+    (Hydra.Dsl.Topology.tarjanStateSccs ts)++tarjanStateWithOnStack :: TTerm TarjanState -> TTerm (S.Set Vertex) -> TTerm TarjanState+tarjanStateWithOnStack ts onStack = tarjanState+    (Hydra.Dsl.Topology.tarjanStateCounter ts)+    (Hydra.Dsl.Topology.tarjanStateIndices ts)+    (Hydra.Dsl.Topology.tarjanStateLowLinks ts)+    (Hydra.Dsl.Topology.tarjanStateStack ts)+    onStack+    (Hydra.Dsl.Topology.tarjanStateSccs ts)++tarjanStateWithSccs :: TTerm TarjanState -> TTerm [[Vertex]] -> TTerm TarjanState+tarjanStateWithSccs ts sccs = tarjanState+    (Hydra.Dsl.Topology.tarjanStateCounter ts)+    (Hydra.Dsl.Topology.tarjanStateIndices ts)+    (Hydra.Dsl.Topology.tarjanStateLowLinks ts)+    (Hydra.Dsl.Topology.tarjanStateStack ts)+    (Hydra.Dsl.Topology.tarjanStateOnStack ts)+    sccs
src/main/haskell/Hydra/Dsl/Types.hs view
@@ -1,168 +1,258 @@--- | A DSL for constructing Hydra types--{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for IsString (Type)+-- | A domain-specific language for constructing Hydra types in Haskell. module Hydra.Dsl.Types where -import Hydra.Constants import Hydra.Core+import Hydra.Dsl.Common+import Hydra.Constants  import qualified Data.List as L import qualified Data.Map as M-import Data.String(IsString(..))  -instance IsString (Type) where fromString = var---- Not available: := ::=-infixr 0 >:-(>:) :: String -> Type -> FieldType-n >: t = field n t----(::=) :: String -> Type -> FieldType-n <=> t = field n t--+-- * Operators +-- | Function type constructor with infix syntax+-- Example: int32 --> string+-- Use this for more readable function type definitions infixr 0 --> (-->) :: Type -> Type -> Type-a --> b = function a b+dom --> cod = function dom cod --- Two alternative symbols for type application+-- | Type application operator+-- Example: list @@ int32 (@@) :: Type -> Type -> Type-f @@ x = apply f x-($$) :: Type -> Type -> Type-f $$ x = apply f x+fun @@ arg = apply fun arg +-- | Field definition operator+-- Example: "name">: string+infixr 0 >:+(>:) :: String -> Type -> FieldType+name>: typ = field name typ++-- * Fundamentals++-- | Attach an annotation to a type+-- Example: annot (M.fromList [(Name "min", int32 0), (Name "max", int32 100)]) int32 annot :: M.Map Name Term -> Type -> Type-annot ann t = TypeAnnotated $ AnnotatedType t ann+annot ann typ = TypeAnnotated $ AnnotatedType typ ann +-- | Apply a type to a type argument+-- Example: apply (var "f") int32 apply :: Type -> Type -> Type apply lhs rhs = TypeApplication (ApplicationType lhs rhs) -applyN :: [Type] -> Type-applyN ts = foldl apply (L.head ts) (L.tail ts)+-- | Apply a type to multiple type arguments+-- Example: applyMany [var "Either", string, int32]+applyMany :: [Type] -> Type+applyMany ts = L.foldl apply (L.head ts) (L.tail ts) +-- | Create a type variable with the given name+-- Example: var "a"+var :: String -> Type+var = TypeVariable . Name++-- * Functions++-- | Create a function type+-- Example: function int32 string+function :: Type -> Type -> Type+function dom cod = TypeFunction $ FunctionType dom cod++-- | Create an n-ary function type+-- Example: functionMany [int32, string, boolean]+functionMany :: [Type] -> Type+functionMany ts = L.foldl (\cod dom -> function dom cod) (L.head r) (L.tail r)+  where+    r = L.reverse ts++-- * Polymorphism (System F)++-- | Create a universally quantified type (polymorphic type) with a singe variable+-- Example: forAll "a" (var "a" --> var "a")+-- This creates the polymorphic identity function type: ∀a. a -> a+-- Universal quantification introduces type variables that can be used in the body+forAll :: String -> Type -> Type+forAll v body = TypeForall $ ForallType (Name v) body++-- | Universal quantification with multiple variables+-- Example: forAlls ["a", "b"] (var "a" --> var "b")+forAlls :: [String] -> Type -> Type+forAlls vs body = L.foldr forAll body vs++-- | Create a monomorphic type scheme+-- Example: mono int32+mono :: Type -> TypeScheme+mono = TypeScheme []++-- | Create a polymorphic type scheme with explicit type variables+-- Example: poly ["a", "b"] (var "a" --> var "b")+-- This represents a type forall a b. a -> b that can be instantiated with different types+poly :: [String] -> Type -> TypeScheme+poly vs t = TypeScheme (Name <$> vs) t++-- * Literal types++-- | Arbitrary-precision floating point type bigfloat :: Type bigfloat = float FloatTypeBigfloat +-- | Arbitrary-precision integer type bigint :: Type bigint = integer IntegerTypeBigint +-- | Binary data type binary :: Type binary = literal LiteralTypeBinary +-- | Boolean type boolean :: Type boolean = literal LiteralTypeBoolean -enum :: [String] -> Type-enum names = union $ (`field` unit) <$> names--field :: String -> Type -> FieldType-field fn = FieldType (Name fn)--fieldsToMap :: [FieldType] -> M.Map Name (Type)-fieldsToMap fields = M.fromList $ (\(FieldType name typ) -> (name, typ)) <$> fields-+-- | 32-bit floating point type float32 :: Type float32 = float FloatTypeFloat32 +-- | 64-bit floating point type float64 :: Type float64 = float FloatTypeFloat64 +-- | Create a floating point type with the specified precision+-- Example: float FloatTypeFloat32 float :: FloatType -> Type float = literal . LiteralTypeFloat -function :: Type -> Type -> Type-function dom cod = TypeFunction $ FunctionType dom cod--functionN :: [Type] -> Type-functionN ts = L.foldl (\cod dom -> function dom cod) (L.head r) (L.tail r)-  where-    r = L.reverse ts+-- | 8-bit signed integer type+int8 :: Type+int8 = integer IntegerTypeInt8 +-- | 16-bit signed integer type int16 :: Type int16 = integer IntegerTypeInt16 +-- | 32-bit signed integer type int32 :: Type int32 = integer IntegerTypeInt32 +-- | 64-bit signed integer type int64 :: Type int64 = integer IntegerTypeInt64 -int8 :: Type-int8 = integer IntegerTypeInt8-+-- | Create an integer type with the specified bit width+-- Example: integer IntegerTypeInt32 integer :: IntegerType -> Type integer = literal . LiteralTypeInteger -lambda :: String -> Type -> Type-lambda v body = TypeLambda $ LambdaType (Name v) body--lambdas :: [String] -> Type -> Type-lambdas vs body = L.foldr lambda body vs--list :: Type -> Type-list = TypeList-+-- | Literal primitive type+-- Example: literal LiteralTypeString literal :: LiteralType -> Type literal = TypeLiteral -map :: Type -> Type -> Type-map kt vt = TypeMap $ MapType kt vt+-- | Non-negative 32-bit integer type+-- Currently an alias for int32; intended for semantic annotation+-- In future versions, this may include validation constraints+nonNegativeInt32 :: Type+nonNegativeInt32 = int32 -mono :: Type -> TypeScheme-mono = TypeScheme []+-- | String type+string :: Type+string = literal LiteralTypeString -optional :: Type -> Type-optional = TypeOptional+-- | 8-bit unsigned integer type+uint8 :: Type+uint8 = integer IntegerTypeUint8 -pair :: Type -> Type -> Type-pair a b = TypeProduct [a, b]+-- | 16-bit unsigned integer type+uint16 :: Type+uint16 = integer IntegerTypeUint16 -poly :: [String] -> Type -> TypeScheme-poly vs t = TypeScheme (Name <$> vs) t+-- | 32-bit unsigned integer type+uint32 :: Type+uint32 = integer IntegerTypeUint32 -product :: [Type] -> Type-product = TypeProduct+-- | 64-bit unsigned integer type+uint64 :: Type+uint64 = integer IntegerTypeUint64 -record :: [FieldType] -> Type-record fields = TypeRecord $ RowType placeholderName fields+-- * Collections -scheme :: [String] -> Type -> TypeScheme-scheme vars body = TypeScheme (Name <$> vars) body+-- | List type+-- Example: list string+list :: Type -> Type+list = TypeList +-- | Map/dictionary type with key and value types+-- Example: map string int32+map :: Type -> Type -> Type+map keys vals = TypeMap $ MapType keys vals++-- | Optional (nullable) type+-- Example: optional string+optional :: Type -> Type+optional = TypeOptional++-- | Set type+-- Example: set string set :: Type -> Type set = TypeSet -string :: Type-string = literal LiteralTypeString+-- * Records, unions and newtypes -sum :: [Type] -> Type-sum = TypeSum+-- | Create an enum type with the given variant names (conventionally in camelCase)+-- Example: enum ["red", "green", "blue"]+enum :: [String] -> Type+enum names = union $ (`field` unit) <$> names -uint16 :: Type-uint16 = integer IntegerTypeUint16+-- | Create a field with the given name and type+-- Example: field "age" int32+field :: String -> Type -> FieldType+field fn = FieldType (Name fn) -uint32 :: Type-uint32 = integer IntegerTypeUint32+-- | Create a record type with the given fields and the default type name+-- Example: record ["name">: string, "age">: int32]+-- Use 'recordWithName' to specify a custom type name+record :: [FieldType] -> Type+record = recordWithName placeholderName -uint64 :: Type-uint64 = integer IntegerTypeUint64+-- | Create a record type with the given fields and a provided type name+-- Example: recordWithName (Name "Person") ["name" >: string, "age" >: int32]+recordWithName :: Name -> [FieldType] -> Type+recordWithName tname fields = TypeRecord $ RowType tname fields -uint8 :: Type-uint8 = integer IntegerTypeUint8+-- | Unit type (empty record type)+unit :: Type+unit = TypeUnit +-- | Create a union type with the given variants and the default type name+-- Example: union ["success">: int32, "failure">: string]+-- This creates a tagged union type (sum type with named variants)+-- Similar to sum [int32, string] but with named branches union :: [FieldType] -> Type union fields = TypeUnion $ RowType placeholderName fields -unit :: Type-unit = TypeRecord $ RowType (Name "hydra/core.Unit") []--var :: String -> Type-var = TypeVariable . Name-+-- | Create a wrapped type (newtype) with a provided base type and the default type name+-- Example: wrap string+-- Creates a newtype with placeholder name; use 'wrapWithName' for custom names wrap :: Type -> Type wrap = wrapWithName placeholderName +-- | Create a wrapped type (newtype) with a provided base type and type name+-- Example: wrapWithName (Name "Email") string wrapWithName :: Name -> Type -> Type wrapWithName name t = TypeWrap $ WrappedType name t++-- * Products and sums++-- | Create a pair (2-tuple) type+-- Example: pair string int32+pair :: Type -> Type -> Type+pair a b = TypeProduct [a, b]++-- | Create a product type (tuple) with multiple components+-- Example: product [string, int32, boolean]+product :: [Type] -> Type+product = TypeProduct++-- | Create a sum type (disjoint union) with multiple variants+-- Example: sum [string, int32, boolean]+sum :: [Type] -> Type+sum = TypeSum
+ src/main/haskell/Hydra/Dsl/Typing.hs view
@@ -0,0 +1,112 @@+module Hydra.Dsl.Typing where++import Hydra.Kernel+import Hydra.Dsl.Phantoms as Phantoms+import qualified Hydra.Dsl.Terms as Terms++import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import Data.Int+import Prelude hiding (map, product, sum)+++inferenceContext+  :: TTerm (M.Map Name TypeScheme)+  -> TTerm (M.Map Name TypeScheme)+  -> TTerm (M.Map Name TypeScheme)+  -> TTerm Bool+  -> TTerm InferenceContext+inferenceContext schemaTypes primitiveTypes dataTypes debug = Phantoms.record _InferenceContext [+  _InferenceContext_schemaTypes>>: schemaTypes,+  _InferenceContext_primitiveTypes>>: primitiveTypes,+  _InferenceContext_dataTypes>>: dataTypes,+  _InferenceContext_debug>>: debug]++inferenceContextSchemaTypes :: TTerm InferenceContext -> TTerm (M.Map Name TypeScheme)+inferenceContextSchemaTypes ic = Phantoms.project _InferenceContext _InferenceContext_schemaTypes @@ ic++inferenceContextPrimitiveTypes :: TTerm InferenceContext -> TTerm (M.Map Name TypeScheme)+inferenceContextPrimitiveTypes ic = Phantoms.project _InferenceContext _InferenceContext_primitiveTypes @@ ic++inferenceContextDataTypes :: TTerm InferenceContext -> TTerm (M.Map Name TypeScheme)+inferenceContextDataTypes ic = Phantoms.project _InferenceContext _InferenceContext_dataTypes @@ ic++inferenceContextDebug :: TTerm InferenceContext -> TTerm Bool+inferenceContextDebug ic = Phantoms.project _InferenceContext _InferenceContext_debug @@ ic++inferenceContextWithDataTypes :: TTerm InferenceContext -> TTerm (M.Map Name TypeScheme) -> TTerm InferenceContext+inferenceContextWithDataTypes ctx dataTypes = inferenceContext+  (Hydra.Dsl.Typing.inferenceContextSchemaTypes ctx)+  (Hydra.Dsl.Typing.inferenceContextPrimitiveTypes ctx)+  dataTypes+  (Hydra.Dsl.Typing.inferenceContextDebug ctx)++inferenceResult :: TTerm Term -> TTerm Type -> TTerm TypeSubst -> TTerm InferenceResult+inferenceResult term type_ subst = Phantoms.record _InferenceResult [+  _InferenceResult_term>>: term,+  _InferenceResult_type>>: type_,+  _InferenceResult_subst>>: subst]++inferenceResultTerm :: TTerm InferenceResult -> TTerm Term+inferenceResultTerm ir = Phantoms.project _InferenceResult _InferenceResult_term @@ ir++inferenceResultType :: TTerm InferenceResult -> TTerm Type+inferenceResultType ir = Phantoms.project _InferenceResult _InferenceResult_type @@ ir++inferenceResultSubst :: TTerm InferenceResult -> TTerm TypeSubst+inferenceResultSubst ir = Phantoms.project _InferenceResult _InferenceResult_subst @@ ir++termSubst :: TTerm (M.Map Name Term) -> TTerm TermSubst+termSubst = Phantoms.wrap _TermSubst++typeConstraint :: TTerm Type -> TTerm Type -> TTerm String -> TTerm TypeConstraint+typeConstraint t1 t2 comment = Phantoms.record _TypeConstraint [+  _TypeConstraint_left>>: t1,+  _TypeConstraint_right>>: t2,+  _TypeConstraint_comment>>: comment]++typeConstraintLeft :: TTerm TypeConstraint -> TTerm Type+typeConstraintLeft tc = Phantoms.project _TypeConstraint _TypeConstraint_left @@ tc++typeConstraintRight :: TTerm TypeConstraint -> TTerm Type+typeConstraintRight tc = Phantoms.project _TypeConstraint _TypeConstraint_right @@ tc++typeConstraintComment :: TTerm TypeConstraint -> TTerm String+typeConstraintComment tc = Phantoms.project _TypeConstraint _TypeConstraint_comment @@ tc++typeContext :: TTerm (M.Map Name Type) -> TTerm (S.Set Name) -> TTerm InferenceContext -> TTerm TypeContext+typeContext types variables inferenceContext = Phantoms.record _TypeContext [+  _TypeContext_types>>: types,+  _TypeContext_variables>>: variables,+  _TypeContext_inferenceContext>>: inferenceContext]++typeContextTypes :: TTerm TypeContext -> TTerm (M.Map Name Type)+typeContextTypes tc = Phantoms.project _TypeContext _TypeContext_types @@ tc++typeContextVariables :: TTerm TypeContext -> TTerm (S.Set Name)+typeContextVariables tc = Phantoms.project _TypeContext _TypeContext_variables @@ tc++typeContextInferenceContext :: TTerm TypeContext -> TTerm InferenceContext+typeContextInferenceContext tc = Phantoms.project _TypeContext _TypeContext_inferenceContext @@ tc++typeContextWithTypes :: TTerm TypeContext -> TTerm (M.Map Name Type) -> TTerm TypeContext+typeContextWithTypes ctx types = typeContext+  types+  (Hydra.Dsl.Typing.typeContextVariables ctx)+  (Hydra.Dsl.Typing.typeContextInferenceContext ctx)++typeContextWithVariables :: TTerm TypeContext -> TTerm (S.Set Name) -> TTerm TypeContext+typeContextWithVariables ctx variables = typeContext+  (Hydra.Dsl.Typing.typeContextTypes ctx)+  variables+  (Hydra.Dsl.Typing.typeContextInferenceContext ctx)++typeSubst :: TTerm (M.Map Name Type) -> TTerm TypeSubst+typeSubst = Phantoms.wrap _TypeSubst++unTermSubst :: TTerm TermSubst -> TTerm (M.Map Name Term)+unTermSubst ts = unwrap _TermSubst @@ ts++unTypeSubst :: TTerm TypeSubst -> TTerm (M.Map Name Type)+unTypeSubst ts = unwrap _TypeSubst @@ ts
− src/main/haskell/Hydra/Ext/Avro/Coder.hs 
@@ -1,389 +0,0 @@-module Hydra.Ext.Avro.Coder (-  AvroEnvironment(..),-  AvroHydraAdapter(..),-  AvroQualifiedName(..),-  avroHydraAdapter,-  emptyAvroEnvironment,-) where--import Hydra.Kernel-import Hydra.Ext.Json.Eliminate-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Types as Types-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Ext.Org.Apache.Avro.Schema as Avro-import qualified Hydra.Json as Json--import qualified Text.Read as TR-import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---data AvroEnvironment = AvroEnvironment {-  avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName AvroHydraAdapter,-  avroEnvironmentNamespace :: Maybe String,-  avroEnvironmentElements :: M.Map Name Element} -- note: only used in the term coders-type AvroHydraAdapter = Adapter AvroEnvironment AvroEnvironment Avro.Schema Type Json.Value Term--data AvroQualifiedName = AvroQualifiedName (Maybe String) String deriving (Eq, Ord, Show)--data ForeignKey = ForeignKey Name (String -> Name)--data PrimaryKey = PrimaryKey Name (String -> Name)--emptyAvroEnvironment = AvroEnvironment M.empty Nothing M.empty--avro_foreignKey = "@foreignKey"-avro_primaryKey = "@primaryKey"--avroHydraAdapter :: Avro.Schema -> Flow AvroEnvironment AvroHydraAdapter-avroHydraAdapter schema = case schema of-    Avro.SchemaArray (Avro.Array s) -> do-      ad <- avroHydraAdapter s-      let coder = Coder {-            coderEncode = \(Json.ValueArray vals) -> Terms.list <$> (CM.mapM (coderEncode $ adapterCoder ad) vals),-            coderDecode = \(TermList vals) -> Json.ValueArray <$> (CM.mapM (coderDecode $ adapterCoder ad) vals)}-      return $ Adapter (adapterIsLossy ad) schema (Types.list $ adapterTarget ad) coder-    Avro.SchemaMap (Avro.Map_ s) -> do-      ad <- avroHydraAdapter s-      let pairToHydra (k, v) = do-            v' <- coderEncode (adapterCoder ad) v-            return (Terms.string k, v')-      let coder = Coder {-            coderEncode = \(Json.ValueObject m) -> Terms.map . M.fromList <$> (CM.mapM pairToHydra $ M.toList m),-            coderDecode = \m -> Json.ValueObject <$> Expect.map Expect.string (coderDecode (adapterCoder ad)) m}-      return $ Adapter (adapterIsLossy ad) schema (Types.map Types.string $ adapterTarget ad) coder-    Avro.SchemaNamed n -> do-        let ns = Avro.namedNamespace n-        env <- getState--        let manns = namedAnnotationsToCore n-        let ann = if M.null manns then Nothing else (Just manns)--        let lastNs = avroEnvironmentNamespace env-        let nextNs = Y.maybe lastNs Just ns-        putState $ env {avroEnvironmentNamespace = nextNs}--        let qname = AvroQualifiedName nextNs (Avro.namedName n)-        let hydraName = avroNameToHydraName qname--        -- Note: if a named type is redefined (an illegal state for which the Avro spec does not provide a resolution),-        --       we just take the first definition and ignore the second.-        ad <- case getAvroHydraAdapter qname env of-          Just ad -> fail $ "Avro named type defined more than once: " ++ show qname-          Nothing -> do-            ad <- case Avro.namedType n of-              Avro.NamedTypeEnum (Avro.Enum_ syms mdefault) -> simpleAdapter typ encode decode  -- TODO: use default value-                where-                  typ = TypeUnion (RowType hydraName $ toField <$> syms)-                    where-                      toField s = FieldType (Name s) Types.unit-                  encode (Json.ValueString s) = pure $ TermUnion (Injection hydraName $ Field (Name s) Terms.unit)-                  -- Note: we simply trust that data coming from the Hydra side is correct-                  decode (TermUnion (Injection _ (Field fn _))) = return $ Json.ValueString $ unName fn-              Avro.NamedTypeFixed (Avro.Fixed size) -> simpleAdapter Types.binary encode decode-                where-                  encode (Json.ValueString s) = pure $ Terms.binary s-                  decode term = Json.ValueString <$> Expect.binary term-              Avro.NamedTypeRecord r -> do-                  let avroFields = Avro.recordFields r-                  adaptersByFieldName <- M.fromList <$> (CM.mapM prepareField avroFields)-                  pk <- findPrimaryKeyField qname avroFields-                  -- TODO: Nothing values for optional fields-                  let encodePair (k, v) = case M.lookup k adaptersByFieldName of-                        Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k-                        Just (f, ad) -> do-                          v' <- coderEncode (adapterCoder ad) v-                          return $ Field (Name k) v'-                  let decodeField (Field (Name k) v) = case M.lookup k adaptersByFieldName of-                        Nothing -> fail $ "unrecognized field for " ++ showQname qname ++ ": " ++ show k-                        Just (f, ad) -> do-                          v' <- coderDecode (adapterCoder ad) v-                          return (k, v')-                  let lossy = L.foldl (\b (_, ad) -> b || adapterIsLossy ad) False $ M.elems adaptersByFieldName-                  let hfields = toHydraField <$> M.elems adaptersByFieldName-                  let target = TypeRecord $ RowType hydraName hfields-                  let coder = Coder {-                    -- Note: the order of the fields is changed-                    coderEncode = \(Json.ValueObject m) -> do-                      fields <- CM.mapM encodePair $ M.toList m-                      let term = TermRecord $ Record hydraName fields-                      addElement term target pk fields-                      return term,-                    coderDecode = \(TermRecord (Record _ fields)) -> Json.ValueObject . M.fromList <$> (CM.mapM decodeField fields)}-                  return $ Adapter lossy schema target coder-                where-                  toHydraField (f, ad) = FieldType (Name $ Avro.fieldName f) $ adapterTarget ad-            env <- getState-            putState $ putAvroHydraAdapter qname ad env-            return $ annotate ann ad--        env2 <- getState-        putState $ env2 {avroEnvironmentNamespace = lastNs}-        return ad-      where-        addElement term typ pk fields = case pk of-          Nothing -> pure ()-          Just (PrimaryKey fname constr) -> case L.filter isPkField fields of-              [] -> pure ()-              [field] -> do-                  s <- termToString $ fieldTerm field-                  let name = constr s-                  let el = Element name term-                  env <- getState-                  putState $ env {avroEnvironmentElements = M.insert name el (avroEnvironmentElements env)}-                  return ()-              _ -> fail $ "multiple fields named " ++ unName fname-            where-              isPkField field = fieldName field == fname-        findPrimaryKeyField qname avroFields = do-          keys <- Y.catMaybes <$> CM.mapM primaryKey avroFields-          case keys of-            [] -> pure Nothing-            [k] -> pure $ Just k-            _ -> fail $ "multiple primary key fields for " ++ show qname-        prepareField f = do-          fk <- foreignKey f--          let manns = fieldAnnotationsToCore f-          let ann = if M.null manns then Nothing else (Just manns) :: Y.Maybe (M.Map Name Term)--          ad <- case fk of-            Nothing -> avroHydraAdapter $ Avro.fieldType f-            Just (ForeignKey name constr) -> do-                ad <- avroHydraAdapter $ Avro.fieldType f-                let decodeTerm = \(TermVariable name) -> do -- TODO: not symmetrical-                      term <- stringToTerm (adapterTarget ad) $ unName name-                      coderDecode (adapterCoder ad) term-                let encodeValue v = do-                      s <- coderEncode (adapterCoder ad) v >>= termToString-                      return $ TermVariable $ constr s-                -- Support three special cases of foreign key types: plain, optional, and list-                case stripType (adapterTarget ad) of-                  TypeOptional (TypeLiteral lit) -> forTypeAndCoder ad (Types.optional elTyp) coder-                    where-                      coder = Coder {-                        coderEncode = \json -> (TermOptional . Just) <$> encodeValue json,-                        coderDecode = decodeTerm}-                  TypeList (TypeLiteral lit) -> forTypeAndCoder ad (Types.list elTyp) coder-                    where-                      coder = Coder {-                        coderEncode = \json -> TermList <$> (expectArray json >>= CM.mapM encodeValue),-                        coderDecode = decodeTerm}-                  TypeLiteral lit -> forTypeAndCoder ad elTyp coder-                    where-                      coder = Coder {-                        coderEncode = encodeValue,-                        coderDecode = decodeTerm}-                  _ -> fail $ "unsupported type annotated as foreign key: " ++ (show $ typeVariant $ adapterTarget ad)-              where-                forTypeAndCoder ad typ coder = pure $ Adapter (adapterIsLossy ad) (Avro.fieldType f) typ coder-                elTyp = TypeVariable name-          return (Avro.fieldName f, (f, annotate ann ad))-    Avro.SchemaPrimitive p -> case p of-        Avro.PrimitiveNull -> simpleAdapter Types.unit encode decode-          where-            encode (Json.ValueString s) = pure $ Terms.string s-            decode term = Json.ValueString <$> Expect.string term-        Avro.PrimitiveBoolean -> simpleAdapter Types.boolean encode decode-          where-            encode (Json.ValueBoolean b) = pure $ Terms.boolean b-            decode term = Json.ValueBoolean <$> Expect.boolean term-        Avro.PrimitiveInt -> simpleAdapter Types.int32 encode decode-          where-            encode (Json.ValueNumber d) = pure $ Terms.int32 $ doubleToInt d-            decode term = Json.ValueNumber . fromIntegral <$> Expect.int32 term-        Avro.PrimitiveLong -> simpleAdapter Types.int64 encode decode-          where-            encode (Json.ValueNumber d) = pure $ Terms.int64 $ doubleToInt d-            decode term = Json.ValueNumber . fromIntegral <$> Expect.int64 term-        Avro.PrimitiveFloat -> simpleAdapter Types.float32 encode decode-          where-            encode (Json.ValueNumber d) = pure $ Terms.float32 $ realToFrac d-            decode term = Json.ValueNumber . realToFrac <$> Expect.float32 term-        Avro.PrimitiveDouble -> simpleAdapter Types.float64 encode decode-          where-            encode (Json.ValueNumber d) = pure $ Terms.float64 d-            decode term = Json.ValueNumber <$> Expect.float64 term-        Avro.PrimitiveBytes -> simpleAdapter Types.binary encode decode-          where-            encode (Json.ValueString s) = pure $ Terms.binary s-            decode term = Json.ValueString <$> Expect.binary term-        Avro.PrimitiveString -> simpleAdapter Types.string encode decode-          where-            encode (Json.ValueString s) = pure $ Terms.string s-            decode term = Json.ValueString <$> Expect.string term-      where-        doubleToInt d = if d < 0 then ceiling d else floor d-    Avro.SchemaReference name -> do-      env <- getState-      let qname = parseAvroName (avroEnvironmentNamespace env) name-      case getAvroHydraAdapter qname env of-        Nothing -> fail $ "Referenced Avro type has not been defined: " ++ show qname-         ++ ". Defined types: " ++ show (M.keys $ avroEnvironmentNamedAdapters env)-        Just ad -> pure ad-    Avro.SchemaUnion (Avro.Union schemas) -> if L.length nonNulls > 1-        then fail $ "general-purpose unions are not yet supported: " ++ show schema-        else if L.null nonNulls-        then fail $ "cannot generate the empty type"-        else if hasNull-        then forOptional $ L.head nonNulls-        else do-          ad <- avroHydraAdapter $ L.head nonNulls-          return $ Adapter (adapterIsLossy ad) schema (adapterTarget ad) (adapterCoder ad)-      where-        hasNull = (not . L.null . L.filter isNull) schemas-        nonNulls = L.filter (not . isNull) schemas-        isNull schema = case schema of-          Avro.SchemaPrimitive Avro.PrimitiveNull -> True-          _ -> False-        forOptional s = do-          ad <- avroHydraAdapter s-          let coder = Coder {-                coderDecode = \(TermOptional ot) -> case ot of-                  Nothing -> pure $ Json.ValueNull-                  Just term -> coderDecode (adapterCoder ad) term,-                coderEncode = \v -> case v of-                  Json.ValueNull -> pure $ TermOptional Nothing-                  _ -> TermOptional . Just <$> coderEncode (adapterCoder ad) v}-          return $ Adapter (adapterIsLossy ad) schema (Types.optional $ adapterTarget ad) coder-  where-    simpleAdapter typ encode decode = pure $ Adapter False schema typ $ Coder encode decode-    annotate ann ad = case ann of-      Nothing -> ad-      Just n -> ad {adapterTarget = Types.annot n (adapterTarget ad)}--avroNameToHydraName :: AvroQualifiedName -> Name-avroNameToHydraName (AvroQualifiedName mns local) = unqualifyName $ QualifiedName (Namespace <$> mns) local---- TODO: use me (for encoding annotations for which the type is not know) or lose me---       A more robust solution would use jsonCoder together with an expected type-encodeAnnotationValue :: Json.Value -> Term-encodeAnnotationValue v = case v of-  Json.ValueArray vals -> Terms.list (encodeAnnotationValue <$> vals)-  Json.ValueBoolean b -> Terms.boolean b-  Json.ValueNull -> Terms.product []-  Json.ValueNumber d -> Terms.float64 d-  -- Note: JSON objects are untyped maps, not records, in that fields are unordered-  Json.ValueObject m -> Terms.map $ M.fromList (toEntry <$> M.toList m)-    where-      toEntry (k, v) = (Terms.string k, encodeAnnotationValue v)-  Json.ValueString s -> Terms.string s--fieldAnnotationsToCore :: Avro.Field -> M.Map Name Term-fieldAnnotationsToCore f = M.fromList (toCore <$> (M.toList $ Avro.fieldAnnotations f))-  where-    toCore (k, v) = (Name k, encodeAnnotationValue v)--namedAnnotationsToCore :: Avro.Named -> M.Map Name Term-namedAnnotationsToCore n = M.fromList (toCore <$> (M.toList $ Avro.namedAnnotations n))-  where-    toCore (k, v) = (Name k, encodeAnnotationValue v)--getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment -> Y.Maybe AvroHydraAdapter-getAvroHydraAdapter qname = M.lookup qname . avroEnvironmentNamedAdapters--foreignKey :: Avro.Field -> Flow s (Maybe ForeignKey)-foreignKey f = case M.lookup avro_foreignKey (Avro.fieldAnnotations f) of-    Nothing -> pure Nothing-    Just v -> do-      m <- expectObject v-      tname <- Name <$> requireString "type" m-      pattern <- optString "pattern" m-      let constr = case pattern of-            Nothing -> Name-            Just pat -> patternToNameConstructor pat-      return $ Just $ ForeignKey tname constr--patternToNameConstructor :: String -> String -> Name-patternToNameConstructor pat = \s -> Name $ L.intercalate s $ Strings.splitOn "${}" pat--primaryKey :: Avro.Field -> Flow s (Maybe PrimaryKey)-primaryKey f = do-  case M.lookup avro_primaryKey $ Avro.fieldAnnotations f of-    Nothing -> pure Nothing-    Just v -> do-      s <- expectString v-      return $ Just $ PrimaryKey (Name $ Avro.fieldName f) $ patternToNameConstructor s--parseAvroName :: Maybe String -> String -> AvroQualifiedName-parseAvroName mns name = case L.reverse $ Strings.splitOn "." name of-  [local] -> AvroQualifiedName mns local-  (local:rest) -> AvroQualifiedName (Just $ L.intercalate "." $ L.reverse rest) local--putAvroHydraAdapter :: AvroQualifiedName -> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment-putAvroHydraAdapter qname ad env = env {avroEnvironmentNamedAdapters = M.insert qname ad $ avroEnvironmentNamedAdapters env}--rewriteAvroSchemaM :: ((Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema-rewriteAvroSchemaM f = rewrite fsub f-  where-    fsub recurse schema = case schema of-        Avro.SchemaArray (Avro.Array els) -> Avro.SchemaArray <$> (Avro.Array <$> recurse els)-        Avro.SchemaMap (Avro.Map_ vschema) -> Avro.SchemaMap <$> (Avro.Map_ <$> recurse vschema)-        Avro.SchemaNamed n -> do-          nt <- case Avro.namedType n of-            Avro.NamedTypeRecord (Avro.Record fields) -> Avro.NamedTypeRecord <$> (Avro.Record <$> (CM.mapM forField fields))-            t -> pure t-          return $ Avro.SchemaNamed $ n {Avro.namedType = nt}-        Avro.SchemaUnion (Avro.Union schemas) -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM recurse schemas))-        _ -> pure schema-      where-        forField f = do-          t <- recurse $ Avro.fieldType f-          return f {Avro.fieldType = t}--jsonToString :: Json.Value -> Flow s String-jsonToString v = case v of-  Json.ValueBoolean b -> pure $ if b then "true" else "false"-  Json.ValueString s -> pure s-  Json.ValueNumber d -> pure $ if fromIntegral (round d) == d-    then show (round d)-    else show d-  _ -> unexpected "string, number, or boolean" $ show v--showQname :: AvroQualifiedName -> String-showQname (AvroQualifiedName mns local) = (Y.maybe "" (\ns -> ns ++ ".") mns) ++ local--stringToTerm :: Type -> String -> Flow s Term-stringToTerm typ s = case stripType typ of-    TypeLiteral lt -> TermLiteral <$> case lt of-      LiteralTypeBoolean -> LiteralBoolean <$> doRead s-      LiteralTypeInteger it -> LiteralInteger <$> case it of-        IntegerTypeBigint -> IntegerValueBigint <$> doRead s-        IntegerTypeInt8 -> IntegerValueInt8 <$> doRead s-        IntegerTypeInt16 -> IntegerValueInt16 <$> doRead s-        IntegerTypeInt32 -> IntegerValueInt32 <$> doRead s-        IntegerTypeInt64 -> IntegerValueInt64 <$> doRead s-        IntegerTypeUint8 -> IntegerValueUint8 <$> doRead s-        IntegerTypeUint16 -> IntegerValueUint16 <$> doRead s-        IntegerTypeUint32 -> IntegerValueUint32 <$> doRead s-        IntegerTypeUint64 -> IntegerValueUint64 <$> doRead s-      LiteralTypeString -> LiteralString <$> pure s-      _ -> unexpected "literal type" $ show lt-  where-    doRead s = case TR.readEither s of-      Left msg -> fail $ "failed to read value: " ++ msg-      Right term -> pure term--termToString :: Term -> Flow s String-termToString term = case stripTerm term of-  TermLiteral l -> case l of-    LiteralBoolean b -> pure $ show b-    LiteralInteger iv -> pure $ case iv of-      IntegerValueBigint i -> show i-      IntegerValueInt8 i -> show i-      IntegerValueInt16 i -> show i-      IntegerValueInt32 i -> show i-      IntegerValueInt64 i -> show i-      IntegerValueUint8 i -> show i-      IntegerValueUint16 i -> show i-      IntegerValueUint32 i -> show i-      IntegerValueUint64 i -> show i-    LiteralString s -> pure s-    _ -> unexpected "boolean, integer, or string" $ show l-  TermOptional (Just term') -> termToString term'-  _ -> unexpected "literal value" $ show term
− src/main/haskell/Hydra/Ext/Avro/Language.hs 
@@ -1,32 +0,0 @@-module Hydra.Ext.Avro.Language where--import Hydra.Kernel--import qualified Data.Set as S---avroLanguage :: Language-avroLanguage = Language (LanguageName "hydra/ext/avro") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBinary, LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [FloatTypeFloat32, FloatTypeFloat64],-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList [IntegerTypeInt32, IntegerTypeInt64],-  languageConstraintsTermVariants = S.fromList [-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantOptional,-    TermVariantRecord],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantAnnotated,-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantWrap,-    TypeVariantOptional,-    TypeVariantRecord],-  languageConstraintsTypes = \typ -> case stripType typ of-    TypeOptional (TypeOptional _) -> False-    _ -> True }
− src/main/haskell/Hydra/Ext/Avro/SchemaJson.hs 
@@ -1,166 +0,0 @@-module Hydra.Ext.Avro.SchemaJson where--import Hydra.Kernel-import Hydra.Ext.Json.Serde-import Hydra.Ext.Json.Eliminate-import qualified Hydra.Ext.Org.Apache.Avro.Schema as Avro-import qualified Hydra.Json as Json--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---avro_aliases = "aliases"-avro_array = "array"-avro_ascending = "ascending"-avro_boolean = "boolean"-avro_bytes = "bytes"-avro_default = "default"-avro_descending = "descending"-avro_doc = "doc"-avro_double = "double"-avro_enum = "enum"-avro_fields = "fields"-avro_fixed = "fixed"-avro_float = "float"-avro_ignore = "ignore"-avro_int = "int"-avro_items = "items"-avro_long = "long"-avro_map = "map"-avro_name = "name"-avro_namespace = "namespace"-avro_null = "null"-avro_order = "order"-avro_record = "record"-avro_size = "size"-avro_string = "string"-avro_symbols = "symbols"-avro_type = "type"-avro_values = "values"--avroSchemaJsonCoder :: Coder s s Avro.Schema Json.Value-avroSchemaJsonCoder = Coder {-  coderEncode = \schema -> fail "not implemented",-  coderDecode = decodeNamedSchema}--avroSchemaStringCoder :: Coder s s Avro.Schema String-avroSchemaStringCoder = Coder {-  coderEncode = \schema -> jsonValueToString <$> coderEncode avroSchemaJsonCoder schema,-  coderDecode = \s -> do-    json <- case stringToJsonValue s of-      Left msg -> fail $ "failed to parse JSON: " ++ msg-      Right j -> pure j-    coderDecode avroSchemaJsonCoder json}--decodeAliases :: M.Map String Json.Value -> Flow s (Maybe [String])-decodeAliases m = do-  aliasesJson <- optArray avro_aliases m-  case aliasesJson of-    Nothing -> pure Nothing-    Just a -> Just <$> CM.mapM expectString a--decodeEnum :: M.Map String Json.Value -> Flow s Avro.NamedType-decodeEnum m = do-  symbolsJson <- requireArray avro_symbols m-  symbols <- CM.mapM expectString symbolsJson-  dflt <- optString avro_default m-  return $ Avro.NamedTypeEnum $ Avro.Enum_ symbols dflt--decodeField :: M.Map String Json.Value -> Flow s Avro.Field-decodeField m = do-  fname <- requireString avro_name m-  doc <- optString avro_doc m-  typ <- require avro_type m >>= decodeSchema-  let dflt = opt avro_default m-  order <- case opt avro_order m of-    Nothing -> pure Nothing-    Just o -> Just <$> (expectString o >>= decodeOrder)-  aliases <- decodeAliases m-  let anns = getAnnotations m-  return $ Avro.Field fname doc typ dflt order aliases anns--decodeFixed :: M.Map String Json.Value -> Flow s Avro.NamedType-decodeFixed m = do-    size <- doubleToInt <$> requireNumber avro_size m-    return $ Avro.NamedTypeFixed $ Avro.Fixed size-  where-    doubleToInt d = if d < 0 then ceiling d else floor d--decodeNamedSchema :: Json.Value -> Flow s Avro.Schema-decodeNamedSchema value = do-  m <- expectObject value-  name <- requireString avro_name m-  ns <- optString avro_namespace m-  typ <- requireString avro_type m-  nt <- case M.lookup typ decoders of-    Nothing -> unexpected "Avro type" $ show typ-    Just d -> d m-  aliases <- decodeAliases m-  doc <- optString avro_doc m-  let anns = getAnnotations m-  return $ Avro.SchemaNamed $ Avro.Named name ns aliases doc nt anns-  where-    decoders = M.fromList [-      (avro_enum, decodeEnum),-      (avro_fixed, decodeFixed),-      (avro_record, decodeRecord)]--decodeOrder :: String -> Flow s Avro.Order-decodeOrder o = case M.lookup o orderMap of-    Nothing -> unexpected "ordering" $ show o-    Just order -> pure order-  where-    orderMap = M.fromList [-      (avro_ascending, Avro.OrderAscending),-      (avro_descending, Avro.OrderDescending),-      (avro_ignore, Avro.OrderIgnore)]--decodeRecord :: M.Map String Json.Value -> Flow s Avro.NamedType-decodeRecord m = do-  fields <- requireArray avro_fields m >>= CM.mapM expectObject >>= CM.mapM decodeField-  return $ Avro.NamedTypeRecord $ Avro.Record fields--decodeSchema :: Json.Value -> Flow s Avro.Schema-decodeSchema v = case v of-  Json.ValueArray els -> Avro.SchemaUnion <$> (Avro.Union <$> (CM.mapM decodeSchema els))-  Json.ValueObject m -> do-      typ <- requireString avro_type m-      case M.lookup typ decoders of-        Nothing -> unexpected "\"array\" or \"map\"" $ show typ-        Just d -> d m-    where-      decoders = M.fromList [-        (avro_array, \m -> do-          items <- require avro_items m >>= decodeSchema-          return $ Avro.SchemaArray $ Avro.Array items),-        (avro_enum, \m -> decodeNamedSchema $ Json.ValueObject m),-        (avro_fixed, \m -> decodeNamedSchema $ Json.ValueObject m),-        (avro_map, \m -> do-          values <- require avro_values m >>= decodeSchema-          return $ Avro.SchemaMap $ Avro.Map_ values),-        (avro_record, \m -> decodeNamedSchema $ Json.ValueObject m)]-  Json.ValueString s -> pure $ case M.lookup s schemas of-      Just prim -> Avro.SchemaPrimitive prim-      Nothing -> Avro.SchemaReference s-    where-      schemas = M.fromList [-        (avro_boolean, Avro.PrimitiveBoolean),-        (avro_bytes, Avro.PrimitiveBytes),-        (avro_double, Avro.PrimitiveDouble),-        (avro_float, Avro.PrimitiveFloat),-        (avro_int, Avro.PrimitiveInt),-        (avro_long, Avro.PrimitiveLong),-        (avro_null, Avro.PrimitiveNull),-        (avro_string, Avro.PrimitiveString)]-  Json.ValueNull -> pure $ Avro.SchemaPrimitive $ Avro.PrimitiveNull-  _ -> unexpected "JSON array, object, or string" $ show v--getAnnotations :: M.Map String Json.Value -> M.Map String Json.Value-getAnnotations = M.fromList . Y.catMaybes . fmap toPair . M.toList-  where-    toPair (k, v) = if L.take 1 k == "@"-      then Just (L.drop 1 k, v)-      else Nothing
− src/main/haskell/Hydra/Ext/Graphql/Coder.hs 
@@ -1,164 +0,0 @@-module Hydra.Ext.Graphql.Coder (moduleToGraphql) where--import Hydra.Kernel-import Hydra.Ext.Graphql.Language-import Hydra.Ext.Graphql.Serde-import qualified Hydra.Ext.Org.Graphql.Syntax as G-import Hydra.Tools.Serialization-import Hydra.Tools.Formatting--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---type Prefixes = M.Map Namespace String--moduleToGraphql :: Module -> Flow (Graph) (M.Map FilePath String)-moduleToGraphql mod = do-    files <- moduleToGraphqlSchemas mod-    return $ M.fromList (mapPair <$> M.toList files)-  where-    mapPair (path, sf) = (path, printExpr $ parenthesize $ exprDocument sf)--moduleToGraphqlSchemas :: Module -> Flow (Graph) (M.Map FilePath G.Document)-moduleToGraphqlSchemas mod = transformModule graphqlLanguage encodeTerm constructModule mod--constructModule :: Module-  -> M.Map (Type) (Coder (Graph) (Graph) (Term) ())-  -> [(Element, TypedTerm)]-  -> Flow (Graph) (M.Map FilePath G.Document)-constructModule mod coders pairs = do-    -- Gather all dependencies because GraphQL does not support imports (in a standard way)-    withDeps <- elementsWithDependencies $ fst <$> pairs-    -- Qualify the names of dependencies with prefixes, so as to avoid name collisions-    let prefixes = findPrefixes withDeps-    -- Elements to GraphQL type definitions-    tdefs <- CM.mapM (toTypeDef prefixes) withDeps-    let doc = G.Document $ (G.DefinitionTypeSystem . G.TypeSystemDefinitionOrExtensionDefinition . G.TypeSystemDefinitionType) <$> tdefs-    return $ M.fromList [(filePath, doc)]-  where-    filePath = namespaceToFilePath False (FileExtension "graphql") (moduleNamespace mod)-    findPrefixes els = M.fromList $ toPair <$> namespaces-      where-        namespaces = L.nub $ (Y.fromJust . namespaceOfEager . elementName) <$> els-        toPair ns = (ns, if ns == moduleNamespace mod then "" else (sanitizeWithUnderscores S.empty (unNamespace ns)) ++ "_")-    toTypeDef prefixes el = do-      typ <- requireTermType (elementData el)-      if isType typ-        then coreDecodeType (elementData el) >>= encodeNamedType prefixes el-        else fail $ "mapping of non-type elements to GraphQL is not yet supported: " ++ unName (elementName el)--descriptionFromType :: Type -> Flow (Graph) (Maybe G.Description)-descriptionFromType typ = do-  mval <- getTypeDescription typ-  return $ G.Description . G.StringValue <$> mval--encodeEnumFieldType :: FieldType -> Flow (Graph) G.EnumValueDefinition-encodeEnumFieldType ft = do-  desc <- descriptionFromType $ fieldTypeType ft-  return G.EnumValueDefinition {-    G.enumValueDefinitionDescription = desc,-    G.enumValueDefinitionEnumValue = encodeEnumFieldName $ fieldTypeName ft,-    G.enumValueDefinitionDirectives = Nothing}--encodeEnumFieldName :: Name -> G.EnumValue-encodeEnumFieldName = G.EnumValue . G.Name . sanitize . unName--encodeFieldName :: Name -> G.Name-encodeFieldName = G.Name . sanitize . unName--encodeFieldType :: Prefixes -> FieldType -> Flow (Graph) G.FieldDefinition-encodeFieldType prefixes ft = do-  gtype <- encodeType prefixes $ fieldTypeType ft-  desc <- descriptionFromType $ fieldTypeType ft-  return G.FieldDefinition {-    G.fieldDefinitionDescription = desc,-    G.fieldDefinitionName = encodeFieldName $ fieldTypeName ft,-    G.fieldDefinitionArgumentsDefinition = Nothing,-    G.fieldDefinitionType = gtype,-    G.fieldDefinitionDirectives = Nothing}--encodeLiteralType :: LiteralType -> Flow (Graph) G.NamedType-encodeLiteralType lt = G.NamedType . G.Name <$> case lt of-  LiteralTypeBoolean -> pure "Boolean"-  LiteralTypeFloat ft -> case ft of-    FloatTypeFloat64 -> pure "Float"-    _ -> unexpected "64-bit float type" $ show ft-  LiteralTypeInteger it -> case it of-    IntegerTypeInt32 -> pure "Int"-    _ -> unexpected "32-bit signed integer type" $ show it-  LiteralTypeString -> pure "String"-  _ -> unexpected "GraphQL-compatible literal type" $ show lt--encodeNamedType :: Prefixes -> Element -> Type -> Flow (Graph) G.TypeDefinition-encodeNamedType prefixes el typ = do-    g <- getState-    let cx = AdapterContext g graphqlLanguage M.empty-    ad <- withState cx $ termAdapter typ-    case stripType (adapterTarget ad) of-      TypeRecord rt -> do-        gfields <- CM.mapM (encodeFieldType prefixes) $ rowTypeFields rt-        desc <- descriptionFromType typ-        return $ G.TypeDefinitionObject $ G.ObjectTypeDefinition {-          G.objectTypeDefinitionDescription = desc,-          G.objectTypeDefinitionName = encodeTypeName prefixes $ elementName el,-          G.objectTypeDefinitionImplementsInterfaces = Nothing,-          G.objectTypeDefinitionDirectives = Nothing,-          G.objectTypeDefinitionFieldsDefinition = Just $ G.FieldsDefinition gfields}-      TypeUnion rt -> do-        values <- CM.mapM encodeEnumFieldType $ rowTypeFields rt-        desc <- descriptionFromType typ-        return $ G.TypeDefinitionEnum $ G.EnumTypeDefinition {-          G.enumTypeDefinitionDescription = desc,-          G.enumTypeDefinitionName = encodeTypeName prefixes $ elementName el,-          G.enumTypeDefinitionDirectives = Nothing,-          G.enumTypeDefinitionEnumValuesDefinition = Just $ G.EnumValuesDefinition values}-      TypeList _ -> wrapAsRecord-      TypeLiteral _ -> wrapAsRecord-      TypeVariable _ -> wrapAsRecord-      t -> unexpected "record or union type" $ show t-  where-    wrapAsRecord = encodeNamedType prefixes el $ TypeRecord $ RowType (elementName el) [-      FieldType (Name "value") typ]--encodeTerm :: Term -> Flow (Graph) ()-encodeTerm term = fail "not yet implemented"--encodeType :: Prefixes -> Type -> Flow (Graph) G.Type-encodeType prefixes typ = case stripType typ of-    TypeOptional et -> case stripType et of-        TypeList et -> G.TypeList . G.ListType <$> encodeType prefixes et-        TypeLiteral lt -> G.TypeNamed <$> encodeLiteralType lt-        TypeRecord rt -> forRowType rt-        TypeUnion rt -> forRowType rt---         TypeWrap name -> forName name-        TypeVariable name -> forName name-        t -> unexpected "GraphQL-compatible type" $ show t-      where-        forName = pure . G.TypeNamed . G.NamedType . encodeTypeName prefixes-        forRowType = forName . rowTypeTypeName-    t -> G.TypeNonNull <$> nonnull t-  where-    nonnull t = case stripType t of-        TypeList et -> G.NonNullTypeList . G.ListType <$> encodeType prefixes et-        TypeLiteral lt -> G.NonNullTypeNamed <$> encodeLiteralType lt-        TypeRecord rt -> forRowType rt-        TypeUnion rt -> forRowType rt-        TypeVariable name -> forName name---         TypeWrap name -> forName name-        _ -> unexpected "GraphQL-compatible non-null type" $ show t-      where-        forName = pure . G.NonNullTypeNamed . G.NamedType . encodeTypeName prefixes-        forRowType = forName . rowTypeTypeName--encodeTypeName :: Prefixes -> Name -> G.Name-encodeTypeName prefixes name = G.Name $ (prefix ++ sanitize local)-  where-    prefix = Y.fromMaybe "UNKNOWN" $ M.lookup ns prefixes-    QualifiedName (Just ns) local = qualifyNameEager name--sanitize :: String -> String-sanitize = sanitizeWithUnderscores graphqlReservedWords
− src/main/haskell/Hydra/Ext/Graphql/Language.hs 
@@ -1,51 +0,0 @@-module Hydra.Ext.Graphql.Language where--import Hydra.Kernel--import qualified Data.List as L-import qualified Data.Set as S---graphqlLanguage :: Language-graphqlLanguage = Language (LanguageName "hydra/ext/graphql") $ LanguageConstraints {-  -- Note: this language is for schemas and data only; support for queries may be added later-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBoolean, -- Boolean-    LiteralVariantFloat,   -- Float-    LiteralVariantInteger, -- Int-    LiteralVariantString], -- String-  languageConstraintsFloatTypes = S.fromList [-    FloatTypeFloat64], -- Float-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList [-    IntegerTypeInt32], -- Int-  languageConstraintsTermVariants = S.fromList [-    TermVariantList,-    TermVariantLiteral,-    TermVariantOptional,-    TermVariantRecord,-    TermVariantUnion], -- Unions are supported only in the form of enums-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantWrap,-    TypeVariantOptional,-    TypeVariantRecord,-    TypeVariantUnion, -- Unions are supported only in the form of enums-    TypeVariantVariable],-  languageConstraintsTypes = \typ -> case stripType typ of-    -- If it is a union type, make sure it can be treated as an enum.-    TypeUnion rt -> L.foldl (\b f -> b && isEnumField f) True $ rowTypeFields rt-      where-        isUnitType t = case stripType t of-          TypeRecord (RowType name fields) -> L.null fields || name == _Unit-          _ -> False-        isEnumField = isUnitType . fieldTypeType-    TypeOptional et -> case stripType et of-      TypeOptional _ -> False  -- No encoding for optionals within optionals-      _ -> True-    _ -> True}--graphqlReservedWords :: S.Set String-graphqlReservedWords = S.fromList ["true", "false"]
− src/main/haskell/Hydra/Ext/Graphql/Serde.hs 
@@ -1,106 +0,0 @@-module Hydra.Ext.Graphql.Serde (exprDocument) where--import Hydra.Tools.Serialization-import Hydra.Tools.Formatting-import qualified Hydra.Ast as CT-import qualified Hydra.Ext.Org.Graphql.Syntax as G--import qualified Data.List as L-import qualified Data.Maybe as Y---commentDelim = cst "\"\"\"" :: CT.Expr--exprDefinition :: G.Definition -> CT.Expr-exprDefinition def = case def of-  G.DefinitionExecutable _ -> unsup def-  G.DefinitionTypeSystem de -> exprTypeSystemDefinitionOrExtension de--exprDescription :: G.Description -> CT.Expr-exprDescription desc = newlineSep [-  commentDelim,-  cst $ G.unStringValue $ G.unDescription desc,-  commentDelim]--exprDocument :: G.Document -> CT.Expr-exprDocument d = doubleNewlineSep (exprDefinition <$> G.unDocument d)--exprEnumTypeDefinition :: G.EnumTypeDefinition -> CT.Expr-exprEnumTypeDefinition def = withDescription (G.enumTypeDefinitionDescription def) $-    spaceSep [cst "enum", exprName (G.enumTypeDefinitionName def),-      curlyBracesList Nothing fullBlockStyle valuesExpr]-  where-    valuesExpr = case G.enumTypeDefinitionEnumValuesDefinition def of-      Nothing -> []-      Just values -> exprEnumValueDefinition <$> G.unEnumValuesDefinition values--exprEnumValue :: G.EnumValue -> CT.Expr-exprEnumValue = exprName . G.unEnumValue--exprEnumValueDefinition :: G.EnumValueDefinition -> CT.Expr-exprEnumValueDefinition def = withDescription (G.enumValueDefinitionDescription def) $-  exprEnumValue $ G.enumValueDefinitionEnumValue def--exprFieldDefinition :: G.FieldDefinition -> CT.Expr-exprFieldDefinition def = withDescription (G.fieldDefinitionDescription def) $-    spaceSep [namePart, typePart]-  where-    namePart = noSep[exprName (G.fieldDefinitionName def), cst ":"]-    typePart = exprType $ G.fieldDefinitionType def--exprListType :: G.ListType -> CT.Expr-exprListType lt = noSep[cst "[", exprType $ G.unListType lt, cst "]"]--exprName :: G.Name -> CT.Expr-exprName = cst . G.unName--exprNamedType :: G.NamedType -> CT.Expr-exprNamedType = exprName . G.unNamedType--exprNonNullType :: G.NonNullType -> CT.Expr-exprNonNullType nnt = noSep [typeExpr, cst "!"]-  where-    typeExpr = case nnt of-      G.NonNullTypeNamed nt -> exprNamedType nt-      G.NonNullTypeList lt -> exprListType lt--exprObjectTypeDefinition :: G.ObjectTypeDefinition -> CT.Expr-exprObjectTypeDefinition def = withDescription (G.objectTypeDefinitionDescription def) $-    spaceSep [cst "type", exprName (G.objectTypeDefinitionName def),-      curlyBracesList Nothing fullBlockStyle fieldsExpr]-  where-    fieldsExpr = case G.objectTypeDefinitionFieldsDefinition def of-      Nothing -> []-      Just fields -> exprFieldDefinition <$> G.unFieldsDefinition fields--exprType :: G.Type -> CT.Expr-exprType typ = case typ of-  G.TypeNamed nt -> exprNamedType nt-  G.TypeList lt -> exprListType lt-  G.TypeNonNull nnt -> exprNonNullType nnt--exprTypeDefinition :: G.TypeDefinition -> CT.Expr-exprTypeDefinition def = case def of-  G.TypeDefinitionScalar _ -> unsup def-  G.TypeDefinitionObject od -> exprObjectTypeDefinition od-  G.TypeDefinitionInterface _ -> unsup def-  G.TypeDefinitionUnion _ -> unsup def-  G.TypeDefinitionEnum ed -> exprEnumTypeDefinition ed-  G.TypeDefinitionInputObject _ -> unsup def--exprTypeSystemDefinition :: G.TypeSystemDefinition -> CT.Expr-exprTypeSystemDefinition def = case def of-  G.TypeSystemDefinitionSchema _ -> unsup def-  G.TypeSystemDefinitionType dt -> exprTypeDefinition dt-  G.TypeSystemDefinitionDirective _ -> unsup def--exprTypeSystemDefinitionOrExtension :: G.TypeSystemDefinitionOrExtension -> CT.Expr-exprTypeSystemDefinitionOrExtension de = case de of-  G.TypeSystemDefinitionOrExtensionDefinition d -> exprTypeSystemDefinition d-  G.TypeSystemDefinitionOrExtensionExtension _ -> unsup de--unsup :: Show x => x -> CT.Expr-unsup obj = cst $ "Unsupported: " ++ show obj--withDescription :: Maybe G.Description -> CT.Expr -> CT.Expr-withDescription mdesc expr = newlineSep $ Y.catMaybes [exprDescription <$> mdesc, Y.Just expr]
− src/main/haskell/Hydra/Ext/Haskell/Coder.hs 
@@ -1,417 +0,0 @@-module Hydra.Ext.Haskell.Coder (moduleToHaskell) where--import Hydra.Kernel-import Hydra.Adapters-import Hydra.Ext.Haskell.Language-import Hydra.Ext.Haskell.Utils-import Hydra.Dsl.Terms-import Hydra.Tools.Serialization-import Hydra.Ext.Haskell.Serde-import Hydra.Ext.Haskell.Settings-import qualified Hydra.Ext.Haskell.Ast as H-import qualified Hydra.Lib.Strings as Strings-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.Lib.Io-import qualified Hydra.Decode as Decode--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import Hydra.Rewriting (removeTypeAnnotations, removeTermAnnotations)---data HaskellGenerationOptions = HaskellGenerationOptions {-  haskellGenerationOptionsIncludeTypeDefinitions :: Bool-}--key_haskellVar = Name "haskellVar"---- TODO: make these settings configurable-defaultHaskellGenerationOptions = HaskellGenerationOptions False--adaptTypeToHaskellAndEncode :: Namespaces -> Type -> Flow Graph H.Type-adaptTypeToHaskellAndEncode namespaces = adaptAndEncodeType haskellLanguage (encodeType namespaces)--constantForFieldName tname fname = "_" ++ localNameOfEager tname ++ "_" ++ unName fname-constantForTypeName tname = "_" ++ localNameOfEager tname--constructModule :: Namespaces-  -> Module-  -> M.Map Type (Coder Graph Graph Term H.Expression)-  -> [(Element, TypedTerm)] -> Flow Graph H.Module-constructModule namespaces mod coders pairs = do-    g <- getState-    decls <- L.concat <$> CM.mapM (createDeclarations g) pairs-    let mc = moduleDescription mod-    return $ H.Module (Just $ H.ModuleHead mc (importName $ h $ moduleNamespace mod) []) imports decls-  where-    h (Namespace name) = name--    createDeclarations g pair@(el, TypedTerm term typ) = do-      if isType typ-        then toTypeDeclarations namespaces el term-        else do-          d <- toDataDeclaration coders namespaces pair-          return [d]--    importName name = H.ModuleName $ L.intercalate "." (capitalize <$> Strings.splitOn "/" name)-    imports = domainImports ++ standardImports-      where-        domainImports = toImport <$> M.toList (namespacesMapping namespaces)-          where-            toImport (Namespace name, alias) = H.Import True (importName name) (Just alias) Nothing-        standardImports = toImport <$> [-            ("Data.Int", Nothing),-            ("Data.List", Just "L"),-            ("Data.Map", Just "M"),-            ("Data.Set", Just "S")]-          where-            toImport (name, alias) = H.Import False (H.ModuleName name) (H.ModuleName <$> alias) Nothing--encodeFunction :: Namespaces -> Function -> Flow Graph H.Expression-encodeFunction namespaces fun = case fun of-    FunctionElimination e -> case e of-      EliminationList fun -> do-        let lhs = hsvar "L.foldl"-        rhs <- encodeTerm namespaces fun-        return $ hsapp lhs rhs-      EliminationWrap name -> pure $ H.ExpressionVariable $ elementReference namespaces $-        qname (Y.fromJust $ namespaceOfEager name) $ newtypeAccessorName name-      EliminationOptional (OptionalCases nothing just) -> do-        nothingRhs <- H.CaseRhs <$> encodeTerm namespaces nothing-        let nothingAlt = H.Alternative (H.PatternName $ rawName "Nothing") nothingRhs Nothing-        justAlt <- do-          -- Note: some of the following could be brought together with FunctionCases-          v0 <- (\i -> "v" ++ show i) <$> nextCount key_haskellVar-          let rhsTerm = simplifyTerm $ apply just (var v0)-          let v1 = if S.member (Name v0) $ freeVariablesInTerm rhsTerm then v0 else ignoredVariable-          let lhs = applicationPattern (rawName "Just") [H.PatternName $ rawName v1]-          rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm-          return $ H.Alternative lhs rhs Nothing-        return $ hslambda "x" $ H.ExpressionCase $ H.Expression_Case (hsvar "x") [nothingAlt, justAlt]-      EliminationProduct (TupleProjection arity idx) -> if arity == 2-        then return $ hsvar $ if idx == 0 then "fst" else "snd"-        else fail "Eliminations for tuples of arity > 2 are not supported yet in the Haskell coder"-      EliminationRecord (Projection dn fname) -> return $ H.ExpressionVariable $ recordFieldReference namespaces dn fname-      EliminationUnion (CaseStatement dn def fields) -> hslambda "x" <$> caseExpr -- note: could use a lambda case here-        where-          caseExpr = do-            rt <- withSchemaContext $ requireUnionType dn-            let fieldMap = M.fromList $ (\f -> (fieldTypeName f, f)) <$> rowTypeFields rt-            ecases <- CM.mapM (toAlt fieldMap) fields-            dcases <- case def of-              Nothing -> pure []-              Just d -> do-                cs <- H.CaseRhs <$> encodeTerm namespaces d-                let lhs = H.PatternName $ rawName ignoredVariable-                return [H.Alternative lhs cs Nothing]-            return $ H.ExpressionCase $ H.Expression_Case (hsvar "x") $ ecases ++ dcases-          toAlt fieldMap (Field fn fun') = do-            v0 <- (\i -> "v" ++ show i) <$> nextCount key_haskellVar-            let raw = apply fun' (var v0)-            let rhsTerm = simplifyTerm raw-            let v1 = if isFreeIn (Name v0) rhsTerm then ignoredVariable else v0-            let hname = unionFieldReference namespaces dn fn-            args <- case M.lookup fn fieldMap of-              Just (FieldType _ ft) -> case stripType ft of-                TypeRecord (RowType _ []) -> pure []-                _ -> pure [H.PatternName $ rawName v1]-              Nothing -> fail $ "field " ++ show fn ++ " not found in " ++ show dn-            let lhs = applicationPattern hname args-            rhs <- H.CaseRhs <$> encodeTerm namespaces rhsTerm-            return $ H.Alternative lhs rhs Nothing-    FunctionLambda (Lambda (Name v) _ body) -> hslambda v <$> encodeTerm namespaces body-    FunctionPrimitive name -> pure $ H.ExpressionVariable $ hsPrimitiveReference name--encodeLiteral :: Literal -> Flow Graph H.Expression-encodeLiteral av = case av of-    LiteralBoolean b -> pure $ hsvar $ if b then "True" else "False"-    LiteralFloat fv -> case fv of-      FloatValueFloat32 f -> pure $ hslit $ H.LiteralFloat f-      FloatValueFloat64 f -> pure $ hslit $ H.LiteralDouble f-      _ -> unexpected "floating-point number" $ show fv-    LiteralInteger iv -> case iv of-      IntegerValueBigint i -> pure $ hslit $ H.LiteralInteger i-      IntegerValueInt32 i -> pure $ hslit $ H.LiteralInt i-      _ -> unexpected "integer" $ show iv-    LiteralString s -> pure $ hslit $ H.LiteralString s-    _ -> unexpected "literal value" $ show av--encodeTerm :: Namespaces -> Term -> Flow Graph H.Expression-encodeTerm namespaces term = do-   case fullyStripTerm term of-    TermApplication (Application fun arg) -> hsapp <$> encode fun <*> encode arg-    TermFunction f -> encodeFunction namespaces f-    TermLet (Let bindings env) -> do-        hbindings <- CM.mapM encodeBinding bindings-        hinner <- encode env-        return $ H.ExpressionLet $ H.Expression_Let hbindings hinner-      where-        encodeBinding (LetBinding name term _) = do-          let hname = simpleName $ unName name-          hexpr <- encode term-          return $ H.LocalBindingValue $ simpleValueBinding hname hexpr Nothing-    TermList els -> H.ExpressionList <$> CM.mapM encode els-    TermLiteral v -> encodeLiteral v-    TermWrap (WrappedTerm tname term') -> if newtypesNotTypedefs-      then hsapp <$> pure (H.ExpressionVariable $ elementReference namespaces tname) <*> encode term'-      else encode term'-    TermOptional m -> case m of-      Nothing -> pure $ hsvar "Nothing"-      Just t -> hsapp (hsvar "Just") <$> encode t-    TermProduct terms -> H.ExpressionTuple <$> (CM.mapM encode terms)-    TermRecord (Record sname fields) -> do-      if L.null fields -- TODO: too permissive; not all empty record types are the unit type-        then pure $ H.ExpressionTuple []-        else do-            let typeName = elementReference namespaces sname-            updates <- CM.mapM toFieldUpdate fields-            return $ H.ExpressionConstructRecord $ H.Expression_ConstructRecord typeName updates-          where-            toFieldUpdate (Field fn ft) = H.FieldUpdate (recordFieldReference namespaces sname fn) <$> encode ft-    TermUnion (Injection sname (Field fn ft)) -> do-      let lhs = H.ExpressionVariable $ unionFieldReference namespaces sname fn-      case fullyStripTerm ft of-        TermRecord (Record _ []) -> pure lhs-        _ -> hsapp lhs <$> encode ft-    TermVariable name -> pure $ H.ExpressionVariable $ elementReference namespaces name --pure $ hsvar v-    t -> fail $ "unexpected term: " ++ show t-  where-    encode = encodeTerm namespaces--encodeType :: Namespaces -> Type -> Flow Graph H.Type-encodeType namespaces typ = withTrace "encode type" $ case stripType typ of-    TypeApplication (ApplicationType lhs rhs) -> toTypeApplication <$> CM.sequence [encode lhs, encode rhs]-    TypeFunction (FunctionType dom cod) -> H.TypeFunction <$> (H.Type_Function <$> encode dom <*> encode cod)-    TypeLambda (LambdaType (Name v) body) -> toTypeApplication <$> CM.sequence [-      encode body,-      pure $ H.TypeVariable $ simpleName v]-    TypeList lt -> H.TypeList <$> encode lt-    TypeLiteral lt -> H.TypeVariable . rawName <$> case lt of-      LiteralTypeBoolean -> pure "Bool"-      LiteralTypeFloat ft -> case ft of-        FloatTypeFloat32 -> pure "Float"-        FloatTypeFloat64 -> pure "Double"-        FloatTypeBigfloat -> pure "Double" -- TODO: type adapter should prevent this---        _ -> fail $ "unexpected floating-point type: " ++ show ft-      LiteralTypeInteger it -> case it of-        IntegerTypeBigint -> pure "Integer"-        IntegerTypeInt8 -> pure "Int8"-        IntegerTypeInt16 -> pure "Int16"-        IntegerTypeInt32 -> pure "Int"-        IntegerTypeInt64 -> pure "Int64"-        _ -> fail $ "unexpected integer type: " ++ show it-      LiteralTypeString -> pure "String"-      _ -> fail $ "unexpected literal type: " ++ show lt-    TypeMap (MapType kt vt) -> toTypeApplication <$> CM.sequence [-      pure $ H.TypeVariable $ rawName "Map",-      encode kt,-      encode vt]-    TypeOptional ot -> toTypeApplication <$> CM.sequence [-      pure $ H.TypeVariable $ rawName "Maybe",-      encode ot]-    TypeProduct types -> H.TypeTuple <$> (CM.mapM encode types)-    TypeRecord rt -> case rowTypeFields rt of-      [] -> pure $ H.TypeTuple []  -- TODO: too permissive; not all empty record types are the unit type-      _ -> ref $ rowTypeTypeName rt-    TypeSet st -> toTypeApplication <$> CM.sequence [-      pure $ H.TypeVariable $ rawName "Set",-      encode st]-    TypeUnion rt -> ref $ rowTypeTypeName rt-    TypeVariable v -> ref v-    TypeWrap (WrappedType name _) -> ref name-    _ -> fail $ "unexpected type: " ++ show typ-  where-    encode = encodeType namespaces-    ref name = pure $ H.TypeVariable $ elementReference namespaces name--encodeTypeWithClassAssertions :: Namespaces -> M.Map Name (S.Set TypeClass) -> Type -> Flow Graph H.Type-encodeTypeWithClassAssertions namespaces classes typ = withTrace "encode with assertions" $ do-  htyp <- adaptTypeToHaskellAndEncode namespaces typ-  if L.null assertPairs-    then pure htyp-    else do-      let encoded = encodeAssertion <$> assertPairs-      let hassert = if L.length encoded > 1 then L.head encoded else H.AssertionTuple encoded-      return $ H.TypeCtx $ H.Type_Context hassert htyp-  where-    encodeAssertion (name, cls) = H.AssertionClass $ H.Assertion_Class hname [htype]-      where-        hname = rawName $ case cls of-          TypeClassEquality -> "Eq"-          TypeClassOrdering -> "Ord"-        htype = H.TypeVariable $ rawName $ unName name -- TODO: sanitization--    assertPairs = L.concat (toPairs <$> M.toList classes)-      where-        toPairs (name, cls) = toPair <$> S.toList cls-          where-            toPair c = (name, c)--moduleToHaskellModule :: Module -> Flow Graph H.Module-moduleToHaskellModule mod = do-    namespaces <- namespacesForModule mod-    transformModule haskellLanguage (encodeTerm namespaces) (constructModule namespaces) mod--moduleToHaskell :: Module -> Flow Graph (M.Map FilePath String)-moduleToHaskell mod = do-  hsmod <- moduleToHaskellModule mod-  let s = printExpr $ parenthesize $ toTree hsmod-  return $ M.fromList [(namespaceToFilePath True (FileExtension "hs") $ moduleNamespace mod, s)]--nameDecls :: Graph -> Namespaces -> Name -> Type -> [H.DeclarationWithComments]-nameDecls g namespaces name@(Name nm) typ = if useCoreImport-    then (toDecl _Name nameDecl):(toDecl _Name <$> fieldDecls)-    else []-  where-    toDecl n (k, v) = H.DeclarationWithComments decl Nothing-      where-        decl = H.DeclarationValueBinding $ H.ValueBindingSimple $ H.ValueBinding_Simple pat rhs Nothing-        pat = applicationPattern (simpleName k) []-        rhs = H.RightHandSide $ H.ExpressionApplication $ H.Expression_Application-          (H.ExpressionVariable $ elementReference namespaces n)-          (H.ExpressionLiteral $ H.LiteralString v)-    nameDecl = (constantForTypeName name, nm)-    fieldDecls = toConstant <$> fieldsOf typ-    toConstant (FieldType fname _) = (constantForFieldName name fname, unName fname)--toDataDeclaration :: M.Map Type (Coder Graph Graph Term H.Expression) -> Namespaces-  -> (Element, TypedTerm) -> Flow Graph H.DeclarationWithComments-toDataDeclaration coders namespaces (el, TypedTerm term typ) = do-  comments <- getTermDescription term-  toDecl comments hname term coder Nothing-  where-    coder = Y.fromJust $ M.lookup typ coders-    hname = simpleName $ localNameOfEager $ elementName el--    rewriteValueBinding vb = case vb of-      H.ValueBindingSimple (H.ValueBinding_Simple (H.PatternApplication (H.Pattern_Application name args)) rhs bindings) -> case rhs of-        H.RightHandSide (H.ExpressionLambda (H.Expression_Lambda vars body)) -> rewriteValueBinding $-          H.ValueBindingSimple $ H.ValueBinding_Simple-            (applicationPattern name (args ++ vars)) (H.RightHandSide body) bindings-        _ -> vb--    toDecl comments hname term coder bindings = case fullyStripTerm term of-      TermLet (Let lbindings env) -> do-          -- A "let" constant cannot be predicted in advance, so we infer its type and construct a coder on the fly-          -- This makes program code with "let" terms more expensive to transform than simple data.-          ts <- (CM.mapM inferredTypeOf (letBindingTerm <$> lbindings))-          coders <- CM.mapM (constructCoder haskellLanguage (encodeTerm namespaces)) ts-          let hnames = simpleName <$> (unName . letBindingName <$> lbindings)-          hterms <- CM.zipWithM coderEncode coders (letBindingTerm <$> lbindings)--          let hbindings = L.zipWith toBinding hnames hterms-          toDecl comments hname env coder (Just $ H.LocalBindings hbindings)-        where-          toBinding hname' hterm' = H.LocalBindingValue $ simpleValueBinding hname' hterm' Nothing-      _ -> do-        hterm <- coderEncode coder term-        let vb = simpleValueBinding hname hterm bindings-        classes <- getTypeClasses typ-        htype <- encodeTypeWithClassAssertions namespaces classes typ-        let decl = H.DeclarationTypedBinding $ H.TypedBinding (H.TypeSignature hname htype) (rewriteValueBinding vb)-        return $ H.DeclarationWithComments decl comments--toTypeDeclarations :: Namespaces -> Element -> Term -> Flow Graph [H.DeclarationWithComments]-toTypeDeclarations namespaces el term = withTrace ("type element " ++ unName (elementName el)) $ do-    g <- getState-    let lname = localNameOfEager $ elementName el-    let hname = simpleName lname-    t <- coreDecodeType term--    isSer <- isSerializable el-    let deriv = H.Deriving $ if isSer-                  then rawName <$> ["Eq", "Ord", "Read", "Show"]-                  else []-    let (vars, t') = unpackLambdaType g t-    let hd = declHead hname $ L.reverse vars-    decl <- case stripType t' of-      TypeRecord rt -> do-        cons <- recordCons lname $ rowTypeFields rt-        return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd [cons] [deriv]-      TypeUnion rt -> do-        cons <- CM.mapM (unionCons lname) $ rowTypeFields rt-        return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordData [] hd cons [deriv]-      TypeWrap (WrappedType tname wt) -> do-        cons <- newtypeCons el wt-        return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv]-      _ -> if newtypesNotTypedefs-        then do-          cons <- newtypeCons el t'-          return $ H.DeclarationData $ H.DataDeclaration H.DataDeclaration_KeywordNewtype [] hd [cons] [deriv]-        else do-          htype <- adaptTypeToHaskellAndEncode namespaces t-          return $ H.DeclarationType (H.TypeDeclaration hd htype)-    comments <- getTermDescription term-    tdecls <- if haskellGenerationOptionsIncludeTypeDefinitions defaultHaskellGenerationOptions-       then do-         decl <- typeDecl namespaces (elementName el) t-         pure [decl]-       else pure []-    return $ [H.DeclarationWithComments decl comments]-      ++ nameDecls g namespaces (elementName el) t-      ++ tdecls-  where-    declHead name vars = case vars of-      [] -> H.DeclarationHeadSimple name-      ((Name h):rest) -> H.DeclarationHeadApplication $-        H.DeclarationHead_Application (declHead name rest) (H.Variable $ simpleName h)--    newtypeCons el typ = do-        let hname = simpleName $ newtypeAccessorName $ elementName el-        htype <- adaptTypeToHaskellAndEncode namespaces typ-        let hfield = H.FieldWithComments (H.Field hname htype) Nothing-        return $ H.ConstructorWithComments-          (H.ConstructorRecord $ H.Constructor_Record (simpleName $ localNameOfEager $ elementName el) [hfield]) Nothing--    recordCons lname fields = do-        hFields <- CM.mapM toField fields-        return $ H.ConstructorWithComments (H.ConstructorRecord $ H.Constructor_Record (simpleName lname) hFields) Nothing-      where-        toField (FieldType (Name fname) ftype) = do-          let hname = simpleName $ decapitalize lname ++ capitalize fname-          htype <- adaptTypeToHaskellAndEncode namespaces ftype-          comments <- getTypeDescription ftype-          return $ H.FieldWithComments (H.Field hname htype) comments--    unionCons lname (FieldType (Name fname) ftype) = do-      comments <- getTypeDescription ftype-      let nm = capitalize lname ++ capitalize fname-      typeList <- if stripType ftype == Types.unit-        then pure []-        else do-          htype <- adaptTypeToHaskellAndEncode namespaces ftype-          return [htype]-      return $ H.ConstructorWithComments (H.ConstructorOrdinary $ H.Constructor_Ordinary (simpleName nm) typeList) comments---- | Constructs a Hydra Type definition which can be included along with the nativized Haskell type definition-typeDecl :: Namespaces -> Name -> Type -> Flow Graph H.DeclarationWithComments-typeDecl namespaces name typ = do-    -- Note: consider constructing this coder just once, then reusing it-    coder <- constructCoder haskellLanguage (encodeTerm namespaces) typeT-    expr <- coderEncode coder finalTerm-    let rhs = H.RightHandSide expr-    let hname = simpleName $ typeNameLocal name-    let pat = applicationPattern hname []-    let decl = H.DeclarationValueBinding $ H.ValueBindingSimple $ H.ValueBinding_Simple pat rhs Nothing-    return $ H.DeclarationWithComments decl Nothing-  where-    typeName ns name = qname ns (typeNameLocal name)-    typeNameLocal name = "_" ++ localNameOfEager name ++ "_type_"-    rawTerm = coreEncodeType typ-    finalTerm = rewriteTerm rewrite rawTerm-      where-        rewrite :: (Term -> Term) -> Term -> Term-        rewrite recurse term = Y.fromMaybe (recurse term) (Decode.variant _Type term >>= forType)-          where-            forType (Field fname fterm) = if fname == _Type_record-              then Nothing -- TODO-              else if fname == _Type_variable-              then Decode.name fterm >>= forVariableType-              else Nothing-            forVariableType name = (\ns -> TermVariable $ qname ns $ "_" ++ local ++ "_type_") <$> mns-              where-                (QualifiedName mns local) = qualifyNameEager name
− src/main/haskell/Hydra/Ext/Haskell/Language.hs 
@@ -1,77 +0,0 @@-module Hydra.Ext.Haskell.Language where--import Hydra.Kernel--import qualified Data.Set as S---haskellLanguage :: Language-haskellLanguage = Language (LanguageName "hydra/ext/haskell") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.fromList eliminationVariants,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBoolean,-    LiteralVariantFloat,-    LiteralVariantInteger,-    LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [-    -- Bigfloat is excluded for now-    FloatTypeFloat32, -- Float-    FloatTypeFloat64], -- Double-  languageConstraintsFunctionVariants = S.fromList functionVariants,-  languageConstraintsIntegerTypes = S.fromList [-    IntegerTypeBigint, -- Integer-    IntegerTypeInt8, -- Int8-    IntegerTypeInt16, -- Int16-    IntegerTypeInt32, -- Int-    IntegerTypeInt64], -- Int64-  languageConstraintsTermVariants = S.fromList [-    TermVariantApplication,-    TermVariantFunction,-    TermVariantLet,-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantOptional,-    TermVariantProduct,-    TermVariantRecord,-    TermVariantSet,-    TermVariantUnion,-    TermVariantVariable,-    TermVariantWrap],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantAnnotated,-    TypeVariantApplication,-    TypeVariantFunction,-    TypeVariantLambda,-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantOptional,-    TypeVariantProduct,-    TypeVariantRecord,-    TypeVariantSet,-    TypeVariantUnion,-    TypeVariantVariable,-    TypeVariantWrap],-  languageConstraintsTypes = const True }--reservedWords :: S.Set String-reservedWords = S.fromList $ preludeSymbols ++ extSymbols-  where-    -- See: https://www.haskell.org/onlinereport/standard-prelude.html-    -- List created on 2022-06-01. Symbols not containing at least one alphanumeric character are excluded.-    preludeSymbols = [-      "Bool", "Bounded", "Char", "Double", "EQ", "Either", "Enum", "Eq", "False", "Float", "Floating", "Fractional",-      "Functor", "GT", "IO", "Int", "Integer", "Integral", "Just", "LT", "Left", "Maybe", "Monad", "Nothing", "Num",-      "Ord", "Ordering", "Rational", "Real", "RealFloat", "RealFrac", "Right", "String", "True", "abs", "acos", "acosh",-      "asTypeOf", "asin", "asinh", "atan", "atan2", "atanh", "ceiling", "compare", "const", "cos", "cosh", "curry",-      "decodeFloat", "div", "divMod", "either", "encodeFloat", "enumFrom", "enumFromThen", "enumFromThenTo",-      "enumFromTo", "error", "even", "exp", "exponent", "fail", "flip", "floatDigits", "floatRadix", "floatRange",-      "floor", "fmap", "fromEnum", "fromInteger", "fromIntegral", "fromRational", "fst", "gcd", "id", "isDenormalized",-      "isIEEE", "isInfinite", "isNaN", "isNegativeZero", "lcm", "log", "logBase", "mapM", "mapM_", "max", "maxBound",-      "maybe", "min", "minBound", "mod", "negate", "not", "odd", "otherwise", "pi", "pred", "properFraction", "quot",-      "quotRem", "realToFrac", "recip", "rem", "return", "round", "scaleFloat", "seq", "sequence", "sequence_",-      "significand", "signum", "sin", "sinh", "snd", "sqrt", "subtract", "succ", "tan", "tanh", "toEnum", "toInteger",-      "toRational", "truncate", "uncurry", "undefined", "until"]-    -- Additional symbols which need to be reserved, as the Haskell coder uses them in their unqualified form-    extSymbols = ["Map", "Set"]
− src/main/haskell/Hydra/Ext/Haskell/Operators.hs 
@@ -1,42 +0,0 @@-module Hydra.Ext.Haskell.Operators where--import Hydra.Ast-import Hydra.Tools.Serialization---andOp = op "&&" 3 AssociativityRight :: Op-apOp = op "<*>" 4 AssociativityLeft :: Op-appOp = Op (Symbol "") (Padding WsNone WsSpace) (Precedence 0) AssociativityLeft :: Op -- No source-applyOp = op "$" 0 AssociativityRight :: Op-arrowOp = op "->" (negate 1) AssociativityRight :: Op-assertOp = op "=>" 0 AssociativityNone :: Op -- No source---assignOp = op "<-"-bindOp = op ">>=" 1 AssociativityLeft :: Op-caseOp = op "->" 0 AssociativityNone :: Op -- No source-composeOp = op "." 9 AssociativityLeft :: Op-concatOp = op "++" 5 AssociativityRight :: Op-consOp = op ":" 5 AssociativityRight :: Op-defineOp = op "=" 0 AssociativityNone :: Op -- No source-diamondOp = op "<>" 6 AssociativityRight :: Op-divOp = op "`div`" 7 AssociativityLeft :: Op-divideOp = op "/" 7 AssociativityLeft :: Op-elemOp = op "`elem`" 4 AssociativityNone :: Op-equalOp = op "==" 4 AssociativityNone :: Op-fmapOp = op "<$>" 4 AssociativityLeft :: Op-gtOp = op ">" 4 AssociativityNone :: Op-gteOp = op ">=" 4 AssociativityNone :: Op-indexOp = op "!!" 9 AssociativityLeft :: Op-lambdaOp = op "->" (negate 1) AssociativityRight :: Op -- No source-ltOp = op "<" 4 AssociativityNone :: Op-lteOp = op ">=" 4 AssociativityNone :: Op-minusOp = op "-" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft-modOp = op "`mod`" 7 AssociativityLeft :: Op-multOp = op "*" 7 AssociativityBoth :: Op -- Originally: AssociativityLeft-neqOp = op "/=" 4 AssociativityNone :: Op-notElemOp = op "`notElem`" 4 AssociativityNone :: Op-orOp = op "||" 2 AssociativityRight :: Op-plusOp = op "+" 6 AssociativityBoth :: Op -- Originally: AssociativityLeft-quotOp = op "`quot`" 7 AssociativityLeft :: Op-remOp = op "`rem`" 7 AssociativityLeft :: Op---suchThatOp = op "|"-typeOp = op "::" 0 AssociativityNone :: Op -- No source
− src/main/haskell/Hydra/Ext/Haskell/Serde.hs 
@@ -1,241 +0,0 @@--- | Haskell operator precendence and associativity are drawn from:---   https://self-learning-java-tutorial.blogspot.com/2016/04/haskell-operator-precedence.html--- Other operators were investigated using GHCi, e.g. ":info (->)"--- Operator names are drawn (loosely) from:---   https://stackoverflow.com/questions/7746894/are-there-pronounceable-names-for-common-haskell-operators--module Hydra.Ext.Haskell.Serde where--import Hydra.Ast-import Hydra.Tools.Serialization-import Hydra.Ext.Haskell.Operators-import qualified Hydra.Ext.Haskell.Ast as H--import qualified Data.Char as C-import qualified Data.List as L-import qualified Data.Maybe as Y---class ToTree a where-  toTree :: a -> Expr--instance ToTree H.Alternative where-  toTree (H.Alternative pat rhs _) = ifx caseOp (toTree pat) (toTree rhs)--instance ToTree H.Assertion where-  toTree sert = case sert of-    H.AssertionClass cls -> toTree cls-    H.AssertionTuple serts -> parenList False (toTree <$> serts)--instance ToTree H.Assertion_Class where-  toTree (H.Assertion_Class name types) = spaceSep [toTree name, commaSep halfBlockStyle (toTree <$> types)]--instance ToTree H.CaseRhs where-  toTree (H.CaseRhs expr) = toTree expr--instance ToTree H.Constructor where-  toTree cons = case cons of-    H.ConstructorOrdinary (H.Constructor_Ordinary name types) -> spaceSep [-      toTree name,-      spaceSep (toTree <$> types)]-    H.ConstructorRecord (H.Constructor_Record name fields) -> spaceSep [-      toTree name,-      curlyBracesList Nothing halfBlockStyle (toTree <$> fields)]--instance ToTree H.ConstructorWithComments where-  toTree (H.ConstructorWithComments body mc) = case mc of-    Nothing -> toTree body-    Just c -> newlineSep [cst $ toHaskellComments c, toTree body]--instance ToTree H.DataDeclaration_Keyword where-  toTree kw = case kw of-    H.DataDeclaration_KeywordData -> cst "data"-    H.DataDeclaration_KeywordNewtype -> cst "newtype"--instance ToTree H.Declaration where-  toTree decl = case decl of-    H.DeclarationData (H.DataDeclaration kw _ hd cons deriv) -> indentBlock $-        [spaceSep [toTree kw, toTree hd, cst "="], constructors]-        ++ if L.null derivCat then [] else [spaceSep [cst "deriving", parenList False (toTree <$> derivCat)]]-      where-        derivCat = L.concat $ h <$> deriv-          where-            h (H.Deriving names) = names-        constructors = orSep halfBlockStyle (toTree <$> cons)-    H.DeclarationType (H.TypeDeclaration hd typ) -> spaceSep [cst "type", toTree hd, cst "=", toTree typ]-    H.DeclarationValueBinding vb -> toTree vb-    H.DeclarationTypedBinding (H.TypedBinding (H.TypeSignature name htype) vb) -> newlineSep [ -- TODO: local bindings-        ifx typeOp (toTree name) (toTree htype),-        toTree vb]--instance ToTree H.DeclarationHead where-  toTree hd = case hd of-    H.DeclarationHeadApplication (H.DeclarationHead_Application fun op) -> spaceSep [toTree fun, toTree op]---    H.DeclarationHeadParens ... ->-    H.DeclarationHeadSimple name -> toTree name--instance ToTree H.DeclarationWithComments where-  toTree (H.DeclarationWithComments body mc) = case mc of-    Nothing -> toTree body-    Just c -> newlineSep [cst $ toHaskellComments c, toTree body]--instance ToTree H.Expression where-  toTree expr = case expr of-      H.ExpressionApplication app -> toTree app-      H.ExpressionCase cases -> toTree cases-      H.ExpressionConstructRecord r -> toTree r-      H.ExpressionDo statements -> indentBlock $ [cst "do"] ++ (toTree <$> statements)-      H.ExpressionIf ifte -> toTree ifte-    --  H.ExpressionInfixApplication Term_InfixApplication-      H.ExpressionLiteral lit -> toTree lit-      -- Note: the need for extra parens may point to an operator precedence issue-      H.ExpressionLambda lam -> parenthesize $ toTree lam-    --  H.ExpressionLeftSection Term_Section-      H.ExpressionLet (H.Expression_Let bindings inner) -> indentBlock [-          cst "",-          spaceSep [cst "let", customIndentBlock "    " (encodeBinding <$> bindings)],-          spaceSep [cst "in", toTree inner]]-        where-          -- Note: indentation should depend on the length of the pattern-          encodeBinding = indentSubsequentLines "      " . toTree-      H.ExpressionList exprs -> bracketList halfBlockStyle $ toTree <$> exprs-      H.ExpressionParens expr' -> parenthesize $ toTree expr'-    --  H.ExpressionPrefixApplication Term_PrefixApplication-    --  H.ExpressionRightSection Term_Section-      H.ExpressionTuple exprs -> parenList False $ toTree <$> exprs-    --  H.ExpressionTypeSignature Term_TypeSignature-    --  H.ExpressionUpdateRecord Term_UpdateRecord-      H.ExpressionVariable name -> toTree name--instance ToTree H.Expression_Application where-  toTree (H.Expression_Application fun arg) = ifx appOp (toTree fun) (toTree arg)--instance ToTree H.Expression_Case where-  toTree (H.Expression_Case cs alts) = ifx ofOp lhs rhs-    where-      lhs = spaceSep [cst "case", toTree cs]-      rhs = newlineSep (toTree <$> alts)-      ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent "  ") (Precedence 0) AssociativityNone--instance ToTree H.Expression_ConstructRecord where-  toTree (H.Expression_ConstructRecord name updates) = spaceSep [toTree name, brackets curlyBraces halfBlockStyle body]-    where-      body = commaSep halfBlockStyle (fromUpdate <$> updates)-      fromUpdate (H.FieldUpdate fn val) = ifx defineOp (toTree fn) (toTree val)--instance ToTree H.Expression_If where-  toTree (H.Expression_If eif ethen eelse) = ifx ifOp (spaceSep [cst "if", toTree eif]) body-    where-      ifOp = Op (Symbol "") (Padding WsNone $ WsBreakAndIndent "  ") (Precedence 0) AssociativityNone-      body = newlineSep [spaceSep [cst "then", toTree ethen], spaceSep [cst "else", toTree eelse]]--instance ToTree H.Expression_Lambda where-  toTree (H.Expression_Lambda bindings inner) = ifx lambdaOp (prefix "\\" head) body-    where-      head = spaceSep (toTree <$> bindings)-      body = toTree inner--instance ToTree H.Field where-  toTree (H.Field name typ) = spaceSep [toTree name, cst "::", toTree typ]--instance ToTree H.FieldWithComments where-  toTree (H.FieldWithComments field mc) = case mc of-      Nothing -> toTree field-      Just c -> newlineSep [cst $ toHaskellComments c, toTree field]--instance ToTree H.Import where-  toTree (H.Import qual (H.ModuleName name) mod _) = spaceSep $ Y.catMaybes [-      Just $ cst "import",-      if qual then Just (cst "qualified") else Nothing,-      Just $ cst name,-      (\(H.ModuleName m) -> cst $ "as " ++ m) <$> mod]--instance ToTree H.Literal where-  toTree lit = cst $ case lit of-    H.LiteralChar c -> show $ C.chr $ fromIntegral c-    H.LiteralDouble d -> if d < 0 then "(0" ++ show d ++ ")" else show d-    H.LiteralFloat f -> if f < 0 then "(0" ++ show f ++ ")" else show f-    H.LiteralInt i -> if i < 0 then "(0" ++ show i ++ ")" else show i-    H.LiteralInteger i -> show i-    H.LiteralString s -> show s--instance ToTree H.LocalBinding where-  toTree binding = case binding of-    H.LocalBindingSignature ts -> toTree ts-    H.LocalBindingValue vb -> toTree vb--instance ToTree H.Module where-  toTree (H.Module mh imports decls) = doubleNewlineSep $-      headerLine ++ importLines ++ declLines-    where-      headerLine = Y.maybe [] (\h -> [toTree h]) mh-      declLines = toTree <$> decls-      importLines = [newlineSep $ toTree <$> imports | not (L.null imports)]--instance ToTree H.Name where-  toTree name = cst $ case name of-    H.NameImplicit qn -> "?" ++ writeQualifiedName qn-    H.NameNormal qn -> writeQualifiedName qn-    H.NameParens qn -> "(" ++ writeQualifiedName qn ++ ")"--instance ToTree H.ModuleHead where-  toTree (H.ModuleHead mc (H.ModuleName mname) _) = case mc of-    Nothing -> head-    Just c -> newlineSep [cst $ toHaskellComments c, cst "", head]-    where-      head = spaceSep [cst "module", cst mname, cst "where"]--instance ToTree H.Pattern where-  toTree pat = case pat of-      H.PatternApplication app -> toTree app---      H.PatternAs (H.Pattern_As ) ->-      H.PatternList pats -> bracketList halfBlockStyle $ toTree <$> pats-      H.PatternLiteral lit -> toTree lit-      H.PatternName name -> toTree name-      H.PatternParens pat -> parenthesize $ toTree pat---      H.PatternRecord (H.Pattern_Record ) ->-      H.PatternTuple pats -> parenList False $ toTree <$> pats---      H.PatternTyped (H.Pattern_Typed ) ->-      H.PatternWildcard -> cst "_"--instance ToTree H.Pattern_Application where-  toTree (H.Pattern_Application name pats) = spaceSep $ toTree name:(toTree <$> pats)--instance ToTree H.RightHandSide where-  toTree (H.RightHandSide expr) = toTree expr--instance ToTree H.Statement where-  toTree (H.Statement expr) = toTree expr--instance ToTree H.Type where-  toTree htype = case htype of-    H.TypeApplication (H.Type_Application lhs rhs) -> ifx appOp (toTree lhs) (toTree rhs)-    H.TypeCtx (H.Type_Context ctx typ) -> ifx assertOp (toTree ctx) (toTree typ)-    H.TypeFunction (H.Type_Function dom cod) -> ifx arrowOp (toTree dom) (toTree cod)---  H.TypeInfix Type_Infix-    H.TypeList htype -> bracketList inlineStyle [toTree htype]---  H.TypeParens Type-    H.TypeTuple types -> parenList False $ toTree <$> types-    H.TypeVariable name -> toTree name--instance ToTree H.TypeSignature where-  toTree (H.TypeSignature name typ) = spaceSep [toTree name, cst "::", toTree typ]--instance ToTree H.ValueBinding where-  toTree vb = case vb of-    H.ValueBindingSimple (H.ValueBinding_Simple pat rhs local) -> case local of-        Nothing -> body-        Just (H.LocalBindings bindings) -> indentBlock [body, indentBlock $ [cst "where"] ++ (toTree <$> bindings)]-      where-        body = ifx defineOp (toTree pat) (toTree rhs)--instance ToTree H.Variable where-  toTree (H.Variable v) = toTree v--toHaskellComments :: String -> String-toHaskellComments c = L.intercalate "\n" $ ("-- | " ++) <$> L.lines c--writeQualifiedName :: H.QualifiedName -> String-writeQualifiedName (H.QualifiedName qualifiers unqual) = L.intercalate "." $ (h <$> qualifiers) ++ [h unqual]-  where-    h (H.NamePart part) = part
− src/main/haskell/Hydra/Ext/Haskell/Settings.hs 
@@ -1,7 +0,0 @@-module Hydra.Ext.Haskell.Settings where--newtypesNotTypedefs :: Bool-newtypesNotTypedefs = True--useCoreImport :: Bool-useCoreImport = True
− src/main/haskell/Hydra/Ext/Haskell/Utils.hs 
@@ -1,109 +0,0 @@-module Hydra.Ext.Haskell.Utils where--import Hydra.Kernel-import Hydra.Ext.Haskell.Language-import qualified Hydra.Ext.Haskell.Ast as H-import qualified Hydra.Lib.Strings as Strings--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S---data Namespaces = Namespaces {-  namespacesFocus :: (Namespace, H.ModuleName),-  namespacesMapping :: M.Map Namespace H.ModuleName} deriving Show--applicationPattern name args = H.PatternApplication $ H.Pattern_Application name args--elementReference :: Namespaces -> Name -> H.Name-elementReference (Namespaces (gname, H.ModuleName gmod) namespaces) name = case (qualifiedNameNamespace qname) of-    Nothing -> simpleName local-    Just ns -> case M.lookup ns namespaces of-      Nothing -> simpleName local-      Just (H.ModuleName a) -> if ns == gname-         then simpleName escLocal-         else rawName $ a ++ "." ++ escLocal-  where-    qname = qualifyNameEager name-    local = qualifiedNameLocal qname-    escLocal = sanitizeHaskellName local-    simple = simpleName $ qualifiedNameLocal qname--hsapp :: H.Expression -> H.Expression -> H.Expression-hsapp l r = H.ExpressionApplication $ H.Expression_Application l r--hslambda :: String -> H.Expression -> H.Expression-hslambda v rhs = H.ExpressionLambda (H.Expression_Lambda [H.PatternName $ rawName v] rhs)--hslit :: H.Literal -> H.Expression-hslit = H.ExpressionLiteral--hsPrimitiveReference :: Name -> H.Name-hsPrimitiveReference name = H.NameNormal $ H.QualifiedName [prefix] $ H.NamePart local-  where-    QualifiedName (Just (Namespace ns)) local = qualifyNameEager name-    prefix = H.NamePart $ capitalize $ L.last $ Strings.splitOn "/" ns--hsvar :: String -> H.Expression-hsvar s = H.ExpressionVariable $ rawName s--namespacesForModule :: Module -> Flow (Graph) Namespaces-namespacesForModule mod = do-    nss <- moduleDependencyNamespaces True True True True mod-    return $ Namespaces focusPair $ fst $ L.foldl addPair (M.empty, S.empty) (toPair <$> S.toList nss)-  where-    ns = moduleNamespace mod-    focusPair = toPair ns-    toModuleName (Namespace n) = H.ModuleName $ capitalize $ L.last $ Strings.splitOn "/" n-    toPair name = (name, toModuleName name)-    addPair (m, s) (name, alias@(H.ModuleName aliasStr)) = if S.member alias s-      then addPair (m, s) (name, H.ModuleName $ aliasStr ++ "_")-      else (M.insert name alias m, S.insert alias s)--newtypeAccessorName :: Name -> String-newtypeAccessorName name = "un" ++ localNameOfEager name--rawName :: String -> H.Name-rawName n = H.NameNormal $ H.QualifiedName [] $ H.NamePart n--recordFieldReference :: Namespaces -> Name -> Name -> H.Name-recordFieldReference namespaces sname (Name fname) = elementReference namespaces $-    unqualifyName $ QualifiedName (qualifiedNameNamespace $ qualifyNameEager sname) nm-  where-    nm = decapitalize (typeNameForRecord sname) ++ capitalize fname--sanitizeHaskellName :: String -> String-sanitizeHaskellName = sanitizeWithUnderscores reservedWords--simpleName :: String -> H.Name-simpleName = rawName . sanitizeHaskellName--simpleValueBinding :: H.Name -> H.Expression -> Maybe H.LocalBindings -> H.ValueBinding-simpleValueBinding hname rhs bindings = H.ValueBindingSimple $ H.ValueBinding_Simple pat (H.RightHandSide rhs) bindings-  where-    pat = H.PatternApplication $ H.Pattern_Application hname []--toTypeApplication :: [H.Type] -> H.Type-toTypeApplication = app . L.reverse-  where-    app l = case l of-      [e] -> e-      (h:r) -> H.TypeApplication $ H.Type_Application (app r) h--typeNameForRecord :: Name -> String-typeNameForRecord (Name sname) = L.last (Strings.splitOn "." sname)--unionFieldReference :: Namespaces -> Name -> Name -> H.Name-unionFieldReference namespaces sname (Name fname) = elementReference namespaces $-    unqualifyName $ QualifiedName ns nm-  where-    ns = qualifiedNameNamespace $ qualifyNameEager sname-    nm = capitalize (typeNameForRecord sname) ++ capitalize fname--unpackLambdaType :: Graph -> Type -> ([Name], Type)-unpackLambdaType cx t = case stripType t of-  TypeLambda (LambdaType v tbody) -> (v:vars, t')-    where-      (vars, t') = unpackLambdaType cx tbody-  _ -> ([], t)
− src/main/haskell/Hydra/Ext/Java/Coder.hs 
@@ -1,987 +0,0 @@-module Hydra.Ext.Java.Coder (-  JavaFeatures(..),-  java8Features,-  moduleToJava,-) where--import Hydra.Kernel-import Hydra.Reduction-import Hydra.Ext.Java.Utils-import Hydra.Ext.Java.Language-import Hydra.Ext.Java.Names-import Hydra.Adapters-import Hydra.Tools.Serialization-import Hydra.Ext.Java.Serde-import Hydra.Ext.Java.Settings-import Hydra.AdapterUtils-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types-import qualified Hydra.Ext.Java.Syntax as Java-import Hydra.Lib.Io--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.List.Split as LS-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import Data.String (String)---data JavaSymbolClass = JavaSymbolClassConstant | JavaSymbolClassNullaryFunction | JavaSymbolClassUnaryFunction | JavaSymbolLocalVariable--data JavaFeatures = JavaFeatures {-  supportsDiamondOperator :: Bool-}--java8Features = JavaFeatures {-  supportsDiamondOperator = False-}--java11Features = JavaFeatures {-  supportsDiamondOperator = True-}---- For now, the supported features are hard-coded to those of Java 11, rather than being configurable.-javaFeatures = java11Features--moduleToJava :: Module -> Flow Graph (M.Map FilePath String)-moduleToJava mod = withTrace "encode module in Java" $ do-    units <- moduleToJavaCompilationUnit mod-    return $ M.fromList $ forPair <$> M.toList units-  where-    forPair (name, unit) = (elementNameToFilePath name, printExpr $ parenthesize $ writeCompilationUnit unit)--adaptTypeToJavaAndEncode :: Aliases -> Type -> Flow Graph Java.Type-adaptTypeToJavaAndEncode aliases = adaptAndEncodeType javaLanguage (encodeType aliases)--addComment :: Java.ClassBodyDeclaration -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments-addComment decl field = Java.ClassBodyDeclarationWithComments decl <$> commentsFromFieldType field--boundTypeVariables :: Type -> [Name]-boundTypeVariables typ = case typ of-  TypeAnnotated (AnnotatedType typ1 _) -> boundTypeVariables typ1-  TypeLambda (LambdaType v body) -> v:(boundTypeVariables body)-  _ -> []--classModsPublic :: [Java.ClassModifier]-classModsPublic = [Java.ClassModifierPublic]--classifyDataReference :: Name -> Flow Graph JavaSymbolClass-classifyDataReference name = do-  mel <- dereferenceElement name-  case mel of-    Nothing -> return JavaSymbolLocalVariable-    Just el -> do-      typ <- requireElementType el-      return $ classifyDataTerm typ $ elementData el--classifyDataTerm :: Type -> Term -> JavaSymbolClass-classifyDataTerm typ term = if isLambda term-    then JavaSymbolClassUnaryFunction-    else if hasTypeParameters || isUnsupportedVariant-      then JavaSymbolClassNullaryFunction-      else JavaSymbolClassConstant-  where-    hasTypeParameters = not $ S.null $ freeVariablesInType typ-    isUnsupportedVariant = case fullyStripTerm term of-      TermLet _ -> True-      _ -> False--commentsFromElement :: Element -> Flow Graph (Maybe String)-commentsFromElement = getTermDescription . elementData--commentsFromFieldType :: FieldType -> Flow Graph (Maybe String)-commentsFromFieldType = getTypeDescription . fieldTypeType--constantDecl :: String -> Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments-constantDecl javaName aliases name = do-  jt <- adaptTypeToJavaAndEncode aliases $ TypeVariable _Name-  arg <- encodeTerm aliases $ Terms.string $ unName name-  let init = Java.VariableInitializerExpression $ javaConstructorCall (javaConstructorName nameName Nothing) [arg] Nothing-  let var = javaVariableDeclarator (Java.Identifier javaName) (Just init)-  return $ noComment $ javaMemberField mods jt var-  where-    mods = [Java.FieldModifierPublic, Java.FieldModifierStatic, Java.FieldModifierFinal]-    nameName = nameToJavaName aliases _Name--constantDeclForFieldType :: Aliases -> FieldType -> Flow Graph Java.ClassBodyDeclarationWithComments-constantDeclForFieldType aliases ftyp = constantDecl javaName aliases name-  where-    name = fieldTypeName ftyp-    javaName = "FIELD_NAME_" ++ nonAlnumToUnderscores (convertCase CaseConventionCamel CaseConventionUpperSnake $ unName name)--constantDeclForTypeName :: Aliases -> Name -> Flow Graph Java.ClassBodyDeclarationWithComments-constantDeclForTypeName = constantDecl "TYPE_NAME"--constructElementsInterface :: Module -> [Java.InterfaceMemberDeclaration] -> (Name, Java.CompilationUnit)-constructElementsInterface mod members = (elName, cu)-  where-    cu = Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) [] [decl]-    pkg = javaPackageDeclaration $ moduleNamespace mod-    mods = [Java.InterfaceModifierPublic]-    className = elementsClassName $ moduleNamespace mod-    elName = unqualifyName $ QualifiedName (Just $ moduleNamespace mod) className-    body = Java.InterfaceBody members-    itf = Java.TypeDeclarationInterface $ Java.InterfaceDeclarationNormalInterface $-      Java.NormalInterfaceDeclaration mods (javaTypeIdentifier className) [] [] body-    decl = Java.TypeDeclarationWithComments itf $ moduleDescription mod--constructModule :: Module-  -> M.Map Type (Coder Graph Graph (Term) Java.Expression)-  -> [(Element, TypedTerm)]-  -> Flow Graph (M.Map Name Java.CompilationUnit)-constructModule mod coders pairs = do-    let isTypePair = isType . typedTermType . snd-    let typePairs = L.filter isTypePair pairs-    let dataPairs = L.filter (not . isTypePair) pairs-    typeUnits <- CM.mapM typeToClass typePairs-    dataMembers <- CM.mapM (termToInterfaceMember coders) dataPairs-    return $ M.fromList $ typeUnits ++ ([constructElementsInterface mod dataMembers | not (L.null dataMembers)])-  where-    pkg = javaPackageDeclaration $ moduleNamespace mod-    aliases = importAliasesForModule mod--    typeToClass pair@(el, _) = do-      isSer <- isSerializable el-      let imports = if isSer-                    then [Java.ImportDeclarationSingleType $ Java.SingleTypeImportDeclaration $ javaTypeName $ Java.Identifier "java.io.Serializable"]-                    else []-      decl <- declarationForType isSer aliases pair-      return (elementName el,-        Java.CompilationUnitOrdinary $ Java.OrdinaryCompilationUnit (Just pkg) imports [decl])--    -- Lambdas cannot (in general) be turned into top-level constants, as there is no way of declaring type parameters for constants-    -- These functions must be capable of handling various combinations of let and lambda terms:-    -- * Plain lambdas such as \x y -> x + y + 42-    -- * Lambdas with nested let terms, such as \x y -> let z = x + y in z + 42-    -- * Let terms with nested lambdas, such as let z = 42 in \x y -> x + y + z-    termToInterfaceMember coders pair = withTrace ("element " ++ unName (elementName el)) $ do-        let expanded = contractTerm $ unshadowVariables $ expandTypedLambdas $ typedTermTerm $ snd pair-        case classifyDataTerm typ expanded of-          JavaSymbolClassConstant -> termToConstant coders el expanded-          JavaSymbolClassNullaryFunction -> termToNullaryMethod coders el expanded-          JavaSymbolClassUnaryFunction -> termToUnaryMethod coders el expanded-      where-        el = fst pair-        typ = typedTermType $ snd pair-        tparams = javaTypeParametersForType typ-        mname = sanitizeJavaName $ decapitalize $ localNameOfEager $ elementName el--        termToConstant coders el term = do-          jtype <- Java.UnannType <$> adaptTypeToJavaAndEncode aliases typ-          jterm <- coderEncode (Y.fromJust $ M.lookup typ coders) term-          let mods = []-          let var = javaVariableDeclarator (javaVariableName $ elementName el) $ Just $ Java.VariableInitializerExpression jterm-          return $ Java.InterfaceMemberDeclarationConstant $ Java.ConstantDeclaration mods jtype [var]--        termToNullaryMethod coders el term0 = maybeLet aliases term0 forInnerTerm-          where-            forInnerTerm aliases2 term stmts = do-              result <- javaTypeToJavaResult <$> adaptTypeToJavaAndEncode aliases2 typ-              jbody <- encodeTerm aliases2 term-              let mods = [Java.InterfaceMethodModifierStatic]-              let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody-              return $ interfaceMethodDeclaration mods tparams mname [] result (Just $ stmts ++ [returnSt])--        termToUnaryMethod coders el term = case stripType typ of-          TypeFunction (FunctionType dom cod) -> maybeLet aliases term $ \aliases2 term2 stmts2 -> case fullyStripTerm term2 of-            TermFunction (FunctionLambda (Lambda v _ body)) -> do-              jdom <- adaptTypeToJavaAndEncode aliases2 dom-              jcod <- adaptTypeToJavaAndEncode aliases2 cod-              let mods = [Java.InterfaceMethodModifierStatic]-              let param = javaTypeToJavaFormalParameter jdom (Name $ unName v)-              let result = javaTypeToJavaResult jcod-              maybeLet aliases2 body $ \aliases3 term3 stmts3 -> do-                jbody <- encodeTerm aliases3 term3-                -- TODO: use coders-                --jbody <- coderEncode (Y.fromJust $ M.lookup typ coders) body-                let returnSt = Java.BlockStatementStatement $ javaReturnStatement $ Just jbody-                return $ interfaceMethodDeclaration mods tparams mname [param] result (Just $ stmts2 ++ stmts3 ++ [returnSt])-            _ -> unexpected "function term" $ show term-          _ -> unexpected "function type" $ show typ--declarationForLambdaType :: Bool -> Aliases-  -> [Java.TypeParameter] -> Name -> LambdaType -> Flow Graph Java.ClassDeclaration-declarationForLambdaType isSer aliases tparams elName (LambdaType (Name v) body) =-    toClassDecl False isSer aliases (tparams ++ [param]) elName body-  where-    param = javaTypeParameter $ capitalize v--declarationForRecordType :: Bool -> Bool -> Aliases -> [Java.TypeParameter] -> Name-  -> [FieldType] -> Flow Graph Java.ClassDeclaration-declarationForRecordType isInner isSer aliases tparams elName fields = do-    memberVars <- CM.mapM toMemberVar fields-    memberVars' <- CM.zipWithM addComment memberVars fields-    withMethods <- if L.length fields > 1-      then CM.mapM toWithMethod fields-      else pure []-    cons <- constructor-    tn <- if isInner then pure [] else do-      d <- constantDeclForTypeName aliases elName-      dfields <- CM.mapM (constantDeclForFieldType aliases) fields-      return (d:dfields)-    let bodyDecls = tn ++ memberVars' ++ (noComment <$> [cons, equalsMethod, hashCodeMethod] ++ withMethods)-    return $ javaClassDeclaration aliases tparams elName classModsPublic Nothing (interfaceTypes isSer) bodyDecls-  where-    constructor = do-      params <- CM.mapM (fieldTypeToFormalParam aliases) fields-      let nullCheckStmts = fieldToNullCheckStatement <$> fields-      let assignStmts = fieldToAssignStatement <$> fields-      return $ makeConstructor aliases elName False params $ nullCheckStmts ++ assignStmts--    fieldToAssignStatement = Java.BlockStatementStatement . toAssignStmt . fieldTypeName--    fieldArgs = fieldNameToJavaExpression . fieldTypeName <$> fields--    toMemberVar (FieldType fname ft) = do-      let mods = [Java.FieldModifierPublic, Java.FieldModifierFinal]-      jt <- adaptTypeToJavaAndEncode aliases ft-      let var = fieldNameToJavaVariableDeclarator fname-      return $ javaMemberField mods jt var--    toWithMethod field = do-        param <- fieldTypeToFormalParam aliases field-        return $ methodDeclaration mods [] anns methodName [param] result (Just [nullCheck, returnStmt])-      where-        anns = [] -- TODO-        mods = [Java.MethodModifierPublic]-        methodName = "with" ++ nonAlnumToUnderscores (capitalize (unName $ fieldTypeName field))-        nullCheck = fieldToNullCheckStatement field-        result = referenceTypeToResult $ nameToJavaReferenceType aliases False [] elName Nothing-        consId = Java.Identifier $ sanitizeJavaName $ localNameOfEager elName-        returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just $-          javaConstructorCall (javaConstructorName consId Nothing) fieldArgs Nothing--    equalsMethod = methodDeclaration mods [] anns equalsMethodName [param] result $-        Just [instanceOfStmt,-          castStmt,-          returnAllFieldsEqual]-      where-        anns = [overrideAnnotation]-        mods = [Java.MethodModifierPublic]-        param = javaTypeToJavaFormalParameter (javaRefType [] Nothing "Object") (Name otherInstanceName)-        result = javaTypeToJavaResult javaBooleanType-        tmpName = "o"--        instanceOfStmt = Java.BlockStatementStatement $ Java.StatementIfThen $-            Java.IfThenStatement cond returnFalse-          where-            cond = javaUnaryExpressionToJavaExpression $-                Java.UnaryExpressionOther $-                Java.UnaryExpressionNotPlusMinusNot $-                javaRelationalExpressionToJavaUnaryExpression $-                javaInstanceOf other parent-              where-                other = javaIdentifierToJavaRelationalExpression $ javaIdentifier otherInstanceName-                parent = nameToJavaReferenceType aliases False [] elName Nothing--            returnFalse = javaReturnStatement $ Just $ javaBooleanExpression False--        castStmt = variableDeclarationStatement aliases jtype id rhs-          where-            jtype = javaTypeFromTypeName aliases elName-            id = javaIdentifier tmpName-            rhs = javaCastExpressionToJavaExpression $ javaCastExpression rt var-            var = javaIdentifierToJavaUnaryExpression $ Java.Identifier $ sanitizeJavaName otherInstanceName-            rt = nameToJavaReferenceType aliases False [] elName Nothing--        returnAllFieldsEqual = Java.BlockStatementStatement $ javaReturnStatement $ Just $ if L.null fields-            then javaBooleanExpression True-            else javaConditionalAndExpressionToJavaExpression $-              Java.ConditionalAndExpression (eqClause . fieldTypeName <$> fields)-          where-            eqClause (Name fname) = javaPostfixExpressionToJavaInclusiveOrExpression $-                javaMethodInvocationToJavaPostfixExpression $ Java.MethodInvocation header [arg]-              where-                arg = javaExpressionNameToJavaExpression $-                  fieldExpression (javaIdentifier tmpName) (javaIdentifier fname)-                header = Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex var [] (Java.Identifier equalsMethodName)-                var = Java.MethodInvocation_VariantExpression $ Java.ExpressionName Nothing $ Java.Identifier $-                  sanitizeJavaName fname--    hashCodeMethod = methodDeclaration mods [] anns hashCodeMethodName [] result $ Just [returnSum]-      where-        anns = [overrideAnnotation]-        mods = [Java.MethodModifierPublic]-        result = javaTypeToJavaResult javaIntType--        returnSum = Java.BlockStatementStatement $ if L.null fields-          then returnZero-          else javaReturnStatement $ Just $-            javaAdditiveExpressionToJavaExpression $ addExpressions $-              L.zipWith multPair multipliers (fieldTypeName <$> fields)-          where-            returnZero = javaReturnStatement $ Just $ javaIntExpression 0--            multPair :: Int -> Name -> Java.MultiplicativeExpression-            multPair i (Name fname) = Java.MultiplicativeExpressionTimes $-                Java.MultiplicativeExpression_Binary lhs rhs-              where-                lhs = Java.MultiplicativeExpressionUnary $ javaPrimaryToJavaUnaryExpression $-                  javaLiteralToJavaPrimary $ javaInt i-                rhs = javaPostfixExpressionToJavaUnaryExpression $-                  javaMethodInvocationToJavaPostfixExpression $-                  methodInvocationStatic (javaIdentifier fname) (Java.Identifier hashCodeMethodName) []--            multipliers = L.cycle first20Primes-              where-                first20Primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71]--declarationForType :: Bool -> Aliases -> (Element, TypedTerm) -> Flow Graph Java.TypeDeclarationWithComments-declarationForType isSer aliases (el, TypedTerm term _) = withTrace ("element " ++ unName (elementName el)) $ do-    t <- coreDecodeType term >>= adaptType javaLanguage-    cd <- toClassDecl False isSer aliases [] (elementName el) t-    comments <- commentsFromElement el-    return $ Java.TypeDeclarationWithComments (Java.TypeDeclarationClass cd) comments--declarationForUnionType :: Bool -> Aliases-  -> [Java.TypeParameter] -> Name -> [FieldType] -> Flow Graph Java.ClassDeclaration-declarationForUnionType isSer aliases tparams elName fields = do-    variantClasses <- CM.mapM (fmap augmentVariantClass . unionFieldClass) fields-    let variantDecls = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationClass <$> variantClasses-    variantDecls' <- CM.zipWithM addComment variantDecls fields-    let otherDecls = noComment <$> [privateConstructor, toAcceptMethod True tparams, visitor, partialVisitor]-    tn <- do-      d <- constantDeclForTypeName aliases elName-      dfields <- CM.mapM (constantDeclForFieldType aliases) fields-      return (d:dfields)-    let bodyDecls = tn ++ otherDecls ++ variantDecls'-    let mods = classModsPublic ++ [Java.ClassModifierAbstract]-    return $ javaClassDeclaration aliases tparams elName mods Nothing (interfaceTypes isSer) bodyDecls-  where-    privateConstructor = makeConstructor aliases elName True [] []-    unionFieldClass (FieldType fname ftype) = do-      let rtype = Types.record $ if isUnitType ftype then [] else [FieldType (Name valueFieldName) $ stripType ftype]-      toClassDecl True isSer aliases [] (variantClassName False elName fname) rtype-    augmentVariantClass (Java.ClassDeclarationNormal cd) = Java.ClassDeclarationNormal $ cd {-        Java.normalClassDeclarationModifiers = [Java.ClassModifierPublic, Java.ClassModifierStatic, Java.ClassModifierFinal],-        Java.normalClassDeclarationExtends = Just $ nameToJavaClassType aliases True args elName Nothing,-        Java.normalClassDeclarationParameters = tparams,-        Java.normalClassDeclarationBody = newBody (Java.normalClassDeclarationBody cd)}-      where-        newBody (Java.ClassBody decls) = Java.ClassBody $ decls ++ [noComment $ toAcceptMethod False tparams]-        args = typeParameterToTypeArgument <$> tparams--    visitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $-        Java.NormalInterfaceDeclaration mods ti vtparams extends body-      where-        mods = [Java.InterfaceModifierPublic]-        ti = Java.TypeIdentifier $ Java.Identifier visitorName-        vtparams = tparams ++ [javaTypeParameter visitorReturnParameter]-        extends = []-        body = Java.InterfaceBody (toVisitMethod . fieldTypeName <$> fields)-          where-            toVisitMethod fname = interfaceMethodDeclaration [] [] visitMethodName [variantInstanceParam fname] resultR Nothing--    partialVisitor = javaInterfaceDeclarationToJavaClassBodyDeclaration $-        Java.NormalInterfaceDeclaration {-            Java.normalInterfaceDeclarationModifiers = [Java.InterfaceModifierPublic],-            Java.normalInterfaceDeclarationIdentifier = Java.TypeIdentifier $ Java.Identifier partialVisitorName,-            Java.normalInterfaceDeclarationParameters = tparams ++ [javaTypeParameter visitorReturnParameter],-            Java.normalInterfaceDeclarationExtends =-              [Java.InterfaceType $ javaClassType ((typeParameterToReferenceType <$> tparams) ++ [visitorTypeVariable]) Nothing visitorName],-            Java.normalInterfaceDeclarationBody = Java.InterfaceBody $ otherwise:(toVisitMethod . fieldTypeName <$> fields)}-      where-        otherwise = interfaceMethodDeclaration defaultMod [] otherwiseMethodName [mainInstanceParam] resultR $ Just [throw]-          where-            typeArgs = typeParameterToTypeArgument <$> tparams-            throw = Java.BlockStatementStatement $ javaThrowIllegalStateException args-              where-                args = [javaAdditiveExpressionToJavaExpression $ addExpressions [-                  javaStringMultiplicativeExpression "Non-exhaustive patterns when matching: ",-                  Java.MultiplicativeExpressionUnary $ javaIdentifierToJavaUnaryExpression $ Java.Identifier "instance"]]--        toVisitMethod fname = interfaceMethodDeclaration defaultMod [] visitMethodName [variantInstanceParam fname] resultR $-            Just [returnOtherwise]-          where-            returnOtherwise = Java.BlockStatementStatement $ javaReturnStatement $ Just $-              javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray $ Java.PrimaryNoNewArrayMethodInvocation $-              methodInvocation Nothing (Java.Identifier otherwiseMethodName) [javaIdentifierToJavaExpression $ Java.Identifier "instance"]--    defaultMod = [Java.InterfaceMethodModifierDefault]--    resultR = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable--    typeArgs = typeParameterToTypeArgument <$> tparams--    mainInstanceParam = javaTypeToJavaFormalParameter classRef $ Name instanceName-      where-        classRef = javaClassTypeToJavaType $-          nameToJavaClassType aliases False typeArgs elName Nothing--    variantInstanceParam fname = javaTypeToJavaFormalParameter classRef $ Name instanceName-      where-        classRef = javaClassTypeToJavaType $-          nameToJavaClassType aliases False typeArgs (variantClassName False elName fname) Nothing--elementJavaIdentifier :: Bool -> Bool -> Aliases -> Name -> Java.Identifier-elementJavaIdentifier isPrim isMethod aliases name = Java.Identifier $ if isPrim-    then (qualify $ capitalize local) ++ "." ++ applyMethodName-    else case ns of-      Nothing -> local-      Just n -> (qualify $ elementsClassName n) ++ sep ++ local-  where-    sep = if isMethod then "::" else "."-    qualify s = Java.unIdentifier $ nameToJavaName aliases $ unqualifyName $ QualifiedName ns s-    QualifiedName ns local = qualifyNameEager name--elementNameToFilePath :: Name -> FilePath-elementNameToFilePath name = nameToFilePath False (FileExtension "java") $ unqualifyName $ QualifiedName ns (sanitizeJavaName local)-  where-    QualifiedName ns local = qualifyNameEager name--elementsClassName :: Namespace -> String-elementsClassName (Namespace ns) = capitalize $ L.last $ LS.splitOn "/" ns--encodeApplication :: Aliases -> Application -> Flow Graph Java.Expression-encodeApplication aliases app@(Application lhs rhs) = case fullyStripTerm fun of-    TermFunction f -> case f of-      FunctionPrimitive name -> functionCall aliases True name args-      _ -> fallback-    TermVariable name -> do-        firstCall <- functionCall aliases False name [L.head args]-        calls firstCall $ L.tail args-      where-        calls exp args = case args of-          [] -> pure exp-          (h:r) -> do-            jarg <- encodeTerm aliases h-            calls (apply exp jarg) r-    _ -> fallback-  where-    (fun, args) = uncurry [] lhs rhs-      where-       uncurry args lhs rhs = case fullyStripTerm lhs of-         TermApplication (Application lhs' rhs') -> uncurry (rhs:args) lhs' rhs'-         _ -> (lhs, (rhs:args))--    fallback = withTrace "fallback" $ do-        if Y.isNothing (getTermType lhs)-          -- then fail $ "app: " ++ showTerm (TermApplication app)-          then fail $ "lhs: " ++ showTerm lhs-          else pure ()--        t <- requireTermType lhs-        (dom, cod) <- case stripTypeParameters $ stripType t of-            TypeFunction (FunctionType dom cod) -> pure (dom, cod)-            t' -> fail $ "expected a function type on function " ++ show lhs ++ ", but found " ++ show t'-        case fullyStripTerm lhs of-          TermFunction f -> case f of-            FunctionElimination e -> do-                jarg <- encodeTerm aliases rhs-                encodeElimination aliases (Just jarg) dom cod e-            _ -> defaultExpression-          _ -> defaultExpression-      where-        defaultExpression = do-          -- Note: the domain type will not be used, so we just substitute the unit type-          jfun <- encodeTerm aliases lhs-          jarg <- encodeTerm aliases rhs-          let prim = javaExpressionToJavaPrimary jfun-          return $ apply jfun jarg-    apply exp jarg = javaMethodInvocationToJavaExpression $-      methodInvocation (Just $ Right $ javaExpressionToJavaPrimary exp) (Java.Identifier applyMethodName) [jarg]--encodeElimination :: Aliases -> Maybe Java.Expression -> Type -> Type -> Elimination -> Flow Graph Java.Expression-encodeElimination aliases marg dom cod elm = case elm of-  EliminationOptional (OptionalCases nothing just) -> do-    jnothing <- encodeTerm aliases nothing-    jjust <- encodeTerm aliases just-    let var = Name "m"--    let jobj = case marg of-                  Nothing -> Left $ javaIdentifierToJavaExpressionName $ variableToJavaIdentifier var-                  Just jarg -> Right $ javaExpressionToJavaPrimary jarg-    let jhead = javaMethodInvocationToJavaExpression $ methodInvocation-          (Just jobj)-          (Java.Identifier "map") [jjust]-    let jbody = javaMethodInvocationToJavaExpression $ methodInvocation-          (Just $ Right $ javaExpressionToJavaPrimary jhead)-          (Java.Identifier "orElse") [jnothing]-    castType <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod) >>= javaTypeToJavaReferenceType-    return $ case marg of-      Nothing -> javaCastExpressionToJavaExpression $ javaCastExpression castType $-                       javaExpressionToJavaUnaryExpression $ javaLambda var jbody-      Just _ -> jbody-  EliminationRecord (Projection _ fname) -> do-    jdomr <- adaptTypeToJavaAndEncode aliases dom >>= javaTypeToJavaReferenceType-    jexp <- case marg of-      Nothing -> pure $ javaLambda var jbody-        where-          var = Name "r"-          jbody = javaExpressionNameToJavaExpression $-            fieldExpression (variableToJavaIdentifier var) (javaIdentifier $ unName fname)-      Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier $ unName fname)-        where-          qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg-    return jexp-  EliminationProduct (TupleProjection arity idx) -> if arity > javaMaxTupleLength-      then fail $ "Tuple eliminations of arity greater than " ++ show javaMaxTupleLength ++ " are unsupported"-      else pure $ case marg of-        Nothing -> javaLambda var $ accessExpr $ javaIdentifierToJavaExpression $ variableToJavaIdentifier var-          where-            var = Name "w"-        Just jarg -> accessExpr jarg-    where-      accessExpr jarg = javaFieldAccessToJavaExpression $ Java.FieldAccess qual accessor-        where-          accessor = javaIdentifier $ "object" ++ show (idx + 1)-          qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg-  EliminationUnion (CaseStatement tname def fields) -> do-     case marg of-      Nothing -> do-        g <- getState-        let lhs = setTermType (Just $ Types.function (TypeVariable tname) cod) $ Terms.elimination elm-        let var = "u"-        encodeTerm aliases $ Terms.lambda var $ Terms.apply lhs (Terms.var var)-        -- TODO: default value-      Just jarg -> applyElimination jarg-    where-      applyElimination jarg = do-          let prim = javaExpressionToJavaPrimary jarg-          let consId = innerClassRef aliases tname $ case def of-                Nothing -> visitorName-                Just _ -> partialVisitorName-          jcod <- adaptTypeToJavaAndEncode aliases cod-          rt <- javaTypeToJavaReferenceType jcod-          let targs = typeArgsOrDiamond $ javaTypeArgumentsForType dom ++ [Java.TypeArgumentReference rt]-          otherwiseBranches <- case def of-            Nothing -> pure []-            Just d -> do-              b <- otherwiseBranch jcod d-              return [b]-          visitBranches <- CM.mapM (visitBranch jcod) fields-          let body = Java.ClassBody $ otherwiseBranches ++ visitBranches-          let visitor = javaConstructorCall (javaConstructorName consId $ Just targs) [] (Just body)-          return $ javaMethodInvocationToJavaExpression $-            methodInvocation (Just $ Right prim) (Java.Identifier acceptMethodName) [visitor]-        where-          otherwiseBranch jcod d = do-            targs <- javaTypeArgumentsForNamedType tname-            let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname Nothing-            let mods = [Java.MethodModifierPublic]-            let anns = [overrideAnnotation]-            let param = javaTypeToJavaFormalParameter jdom $ Name instanceName-            let result = Java.ResultType $ Java.UnannType jcod-            jret <- encodeTerm aliases d-            let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret-            return $ noComment $ methodDeclaration mods [] anns otherwiseMethodName [param] result (Just [returnStmt])--          visitBranch jcod field = do-            targs <- javaTypeArgumentsForNamedType tname-            let jdom = Java.TypeReference $ nameToJavaReferenceType aliases True targs tname (Just $ capitalize $ unName $ fieldName field)-            let mods = [Java.MethodModifierPublic]-            let anns = [overrideAnnotation]-            let param = javaTypeToJavaFormalParameter jdom $ Name instanceName-            let result = Java.ResultType $ Java.UnannType jcod-            -- Note: the escaping is necessary because the instance.value field reference does not correspond to an actual Hydra projection term-            let value = Terms.var ("$" ++ instanceName ++ "." ++ valueFieldName)-            jret <- encodeTerm aliases $ contractTerm $ Terms.apply (fieldTerm field) value-            let returnStmt = Java.BlockStatementStatement $ javaReturnStatement $ Just jret-            return $ noComment $ methodDeclaration mods [] anns visitMethodName [param] result (Just [returnStmt])-  EliminationWrap name -> case marg of-    Nothing -> pure $ javaLambda var jbody-      where-        var = Name "w"-        arg = javaIdentifierToJavaExpression $ variableToJavaIdentifier var-        jbody = javaConstructorCall (javaConstructorName (nameToJavaName aliases name) Nothing) [arg] Nothing-    Just jarg -> pure $ javaFieldAccessToJavaExpression $ Java.FieldAccess qual (javaIdentifier valueFieldName)-      where-        qual = Java.FieldAccess_QualifierPrimary $ javaExpressionToJavaPrimary jarg-  _ -> pure $ encodeLiteral $ LiteralString $-    "Unimplemented elimination variant: " ++ show (eliminationVariant elm) -- TODO: temporary--encodeFunction :: Aliases -> Type -> Type -> Function -> Flow Graph Java.Expression-encodeFunction aliases dom cod fun = case fun of-    FunctionElimination elm -> withTrace ("elimination (" ++ show (eliminationVariant elm) ++ ")") $ do-      encodeElimination aliases Nothing dom cod elm-    FunctionLambda (Lambda var _ body) -> withTrace ("lambda " ++ unName var) $ do-        lam <- toLambda var body-        if needsCast body-          then do-            jtype <- adaptTypeToJavaAndEncode aliases (TypeFunction $ FunctionType dom cod)-            rt <- javaTypeToJavaReferenceType jtype-            return $ javaCastExpressionToJavaExpression $-              javaCastExpression rt (javaExpressionToJavaUnaryExpression lam)-          else return lam-      where-        needsCast _  = True -- TODO: try to discriminate between lambdas which really need a cast, and those which do not-    _ -> pure $ encodeLiteral $ LiteralString $-      "Unimplemented function variant: " ++ show (functionVariant fun) -- TODO: temporary-  where-    toLambda var body = maybeLet aliases body cons-      where-        cons aliases' term stmts = if L.null stmts-          then do-            jbody <- encodeTerm aliases term-            return $ javaLambda var jbody-          else do-            jbody <- encodeTerm aliases term-            return $ javaLambdaFromBlock var $ Java.Block $ stmts-              ++ [Java.BlockStatementStatement $ javaReturnStatement $ Just jbody]--encodeLiteral :: Literal -> Java.Expression-encodeLiteral lit = javaLiteralToJavaExpression $ case lit of-  LiteralBoolean b -> javaBoolean b-  LiteralFloat f -> Java.LiteralFloatingPoint $ Java.FloatingPointLiteral $ case f of-    FloatValueFloat32 v -> realToFrac v-    FloatValueFloat64 v -> v-  LiteralInteger i -> case i of-      IntegerValueBigint v -> integer v -- BigInteger-      IntegerValueInt8 v -> integer $ fromIntegral v -- byte-      IntegerValueInt16 v -> integer $ fromIntegral v -- short-      IntegerValueInt32 v -> integer $ fromIntegral v -- int-      IntegerValueInt64 v -> integer $ fromIntegral v -- long-      IntegerValueUint16 v -> Java.LiteralCharacter $ fromIntegral v -- char-    where-      integer = Java.LiteralInteger . Java.IntegerLiteral-  LiteralString s -> javaString s---- Note: we use Java object types everywhere, rather than primitive types, as the latter cannot be used---       to build function types, parameterized types, etc.-encodeLiteralType :: LiteralType -> Flow Graph Java.Type-encodeLiteralType lt = case lt of-    LiteralTypeBoolean -> simple "Boolean"-    LiteralTypeFloat ft -> case ft of-      FloatTypeFloat32 -> simple "Float"-      FloatTypeFloat64 -> simple "Double"-      FloatTypeBigfloat -> simple "Double" -- TODO: type adapter should prevent this---      _ -> fail $ "unexpected float type: " ++ show ft-    LiteralTypeInteger it -> case it of-      IntegerTypeBigint -> pure $ javaRefType [] (Just $ javaPackageName ["java", "math"]) "BigInteger"-      IntegerTypeInt8 -> simple "Byte"-      IntegerTypeInt16 -> simple "Short"-      IntegerTypeInt32 -> simple "Integer"-      IntegerTypeInt64 -> simple "Long"-      IntegerTypeUint16 -> simple "Character"-      _ -> fail $ "unexpected integer type: " ++ show it-    LiteralTypeString -> simple "String"-    _ -> fail $ "unexpected literal type: " ++ show lt-  where-    simple n = pure $ javaRefType [] Nothing n--encodeNullaryConstant :: Aliases -> Type -> Function -> Flow Graph Java.Expression-encodeNullaryConstant aliases typ fun = case fun of-  FunctionPrimitive name -> functionCall aliases True name []-  _ -> unexpected "nullary function" $ show fun--encodeTerm :: Aliases -> Term -> Flow Graph Java.Expression-encodeTerm aliases term0 = encodeInternal [] term0-  where-    encode = encodeTerm aliases-    failAsLiteral msg = pure $ encodeLiteral $ LiteralString msg-    encodeInternal anns term = case term of-        TermAnnotated (AnnotatedTerm term' ann) -> encodeInternal (ann:anns) term'--        TermApplication app -> withTrace "encode application" $ encodeApplication aliases app--        TermFunction f -> withTrace ("encode function (" ++ show (functionVariant f) ++ ")") $ do-          t <- requireTermType term0-          case stripType t of-            TypeFunction (FunctionType dom cod) -> do-              encodeFunction aliases dom cod f-            _ -> encodeNullaryConstant aliases t f--        TermLet _ -> fail $ "nested let is unsupported for Java: " ++ showTerm term--        TermList els -> do-          jels <- CM.mapM encode els-          return $ javaMethodInvocationToJavaExpression $-            methodInvocationStatic (Java.Identifier "java.util.Arrays") (Java.Identifier "asList") jels--        TermLiteral l -> pure $ encodeLiteral l--        TermOptional mt -> case mt of-          Nothing -> pure $ javaMethodInvocationToJavaExpression $-            methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "empty") []-          Just term1 -> do-            expr <- encode term1-            return $ javaMethodInvocationToJavaExpression $-              methodInvocationStatic (Java.Identifier "hydra.util.Opt") (Java.Identifier "of") [expr]--        TermProduct terms -> do-          jterms <- CM.mapM encode terms-          let tupleTypeName = "hydra.util.Tuple.Tuple" ++ show (length terms)-          return $ javaConstructorCall (javaConstructorName (Java.Identifier tupleTypeName) Nothing) jterms Nothing--        TermRecord (Record name fields) -> do-          fieldExprs <- CM.mapM encode (fieldTerm <$> fields)-          let consId = nameToJavaName aliases name-          return $ javaConstructorCall (javaConstructorName consId Nothing) fieldExprs Nothing--        TermSet s -> do-          jels <- CM.mapM encode $ S.toList s-          let prim = javaMethodInvocationToJavaPrimary $-                     methodInvocationStatic (Java.Identifier "java.util.Stream") (Java.Identifier "of") jels-          let coll = javaMethodInvocationToJavaExpression $-                     methodInvocationStatic (Java.Identifier "java.util.stream.Collectors") (Java.Identifier "toSet") []-          return $ javaMethodInvocationToJavaExpression $-            methodInvocation (Just $ Right prim) (Java.Identifier "collect") [coll]--        TermTyped (TypedTerm term1 _) -> encodeInternal anns term1--        TermUnion (Injection name (Field (Name fname) v)) -> do-          let (Java.Identifier typeId) = nameToJavaName aliases name-          let consId = Java.Identifier $ typeId ++ "." ++ sanitizeJavaName (capitalize fname)-          args <- if isUnitTerm v-            then return []-            else do-              ex <- encode v-              return [ex]-          return $ javaConstructorCall (javaConstructorName consId Nothing) args Nothing--        TermVariable name -> encodeVariable aliases name--        TermWrap (WrappedTerm tname arg) -> do-          jarg <- encode arg-          return $ javaConstructorCall (javaConstructorName (nameToJavaName aliases tname) Nothing) [jarg] Nothing--        _ -> failAsLiteral $ "Unimplemented term variant: " ++ show (termVariant term)--encodeType :: Aliases -> Type -> Flow Graph Java.Type-encodeType aliases t = case stripType t of-    TypeApplication (ApplicationType lhs rhs) -> do-      jlhs <- encode lhs-      jrhs <- encode rhs >>= javaTypeToJavaReferenceType-      addJavaTypeParameter jrhs jlhs-    TypeFunction (FunctionType dom cod) -> do-      jdom <- encode dom >>= javaTypeToJavaReferenceType-      jcod <- encode cod >>= javaTypeToJavaReferenceType-      return $ javaRefType [jdom, jcod] javaUtilFunctionPackageName "Function"-    TypeLambda (LambdaType (Name v) body) -> do-      jbody <- encode body-      addJavaTypeParameter (javaTypeVariable v) jbody-    TypeList et -> do-      jet <- encode et-      if listsAsArrays-        then toJavaArrayType jet-        else do-          rt <- javaTypeToJavaReferenceType jet-          return $ javaRefType [rt] javaUtilPackageName "List"-    TypeLiteral lt -> encodeLiteralType lt-    TypeMap (MapType kt vt) -> do-      jkt <- encode kt >>= javaTypeToJavaReferenceType-      jvt <- encode vt >>= javaTypeToJavaReferenceType-      return $ javaRefType [jkt, jvt] javaUtilPackageName "Map"-    TypeProduct types -> case types of-      [] -> unit-      _ -> do-        jtypes <- CM.mapM encode types >>= mapM javaTypeToJavaReferenceType-        return $ javaRefType jtypes hydraUtilPackageName $ "Tuple.Tuple" ++ (show $ length types)-    TypeRecord (RowType _Unit []) -> unit-    TypeRecord (RowType name _) -> pure $-      Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing-    TypeOptional ot -> do-      jot <- encode ot >>= javaTypeToJavaReferenceType-      return $ javaRefType [jot] hydraUtilPackageName "Opt"-    TypeSet st -> do-      jst <- encode st >>= javaTypeToJavaReferenceType-      return $ javaRefType [jst] javaUtilPackageName "Set"-    TypeUnion (RowType name _) -> pure $-      Java.TypeReference $ nameToJavaReferenceType aliases True (javaTypeArgumentsForType t) name Nothing-    TypeVariable name -> forReference name-    TypeWrap (WrappedType name _) -> forReference name-    _ -> fail $ "can't encode unsupported type in Java: " ++ show t-  where-    forReference name = pure $ if isLambdaBoundVariable name-        then variableReference name-        else nameReference name-    nameReference name = Java.TypeReference $ nameToJavaReferenceType aliases True [] name Nothing-    variableReference name = Java.TypeReference $ javaTypeVariable $ unName name-    encode = encodeType aliases-    unit = return $ javaRefType [] javaLangPackageName "Void"--encodeVariable :: Aliases -> Name -> Flow Graph Java.Expression-encodeVariable aliases name = if isRecursiveVariable aliases name-    then return $ javaMethodInvocationToJavaExpression $-      methodInvocation (Just $ Left $ Java.ExpressionName Nothing jid) (Java.Identifier getMethodName) []-    else do-      cls <- classifyDataReference name-      return $ case cls of-        JavaSymbolLocalVariable -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name-        JavaSymbolClassConstant -> javaIdentifierToJavaExpression $ elementJavaIdentifier False False aliases name-        JavaSymbolClassNullaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name -- TODO-        JavaSymbolClassUnaryFunction -> javaIdentifierToJavaExpression $ elementJavaIdentifier False True aliases name-  where-    jid = javaIdentifier $ unName name--fieldToNullCheckStatement :: FieldType -> Java.BlockStatement-fieldToNullCheckStatement field = Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $ Java.MethodInvocation header [arg]-  where-    arg = javaIdentifierToJavaExpression $ fieldNameToJavaIdentifier $ fieldTypeName field-    header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $-      Java.Identifier "java.util.Objects.requireNonNull"--fieldTypeToFormalParam aliases (FieldType fname ft) = do-  jt <- adaptTypeToJavaAndEncode aliases ft-  return $ javaTypeToJavaFormalParameter jt fname--functionCall :: Aliases -> Bool -> Name -> [Term] -> Flow Graph Java.Expression-functionCall aliases isPrim name args = do-    jargs <- CM.mapM (encodeTerm aliases) args-    if isLocalVariable name-      then do-        prim <- javaExpressionToJavaPrimary <$> encodeVariable aliases name-        return $ javaMethodInvocationToJavaExpression $-          methodInvocation (Just $ Right prim) (Java.Identifier applyMethodName) jargs-      else do-        let header = Java.MethodInvocation_HeaderSimple $ Java.MethodName $ elementJavaIdentifier isPrim False aliases name-        return $ javaMethodInvocationToJavaExpression $ Java.MethodInvocation header jargs--getCodomain :: M.Map Name Term -> Flow Graph Type-getCodomain ann = functionTypeCodomain <$> getFunctionType ann--getFunctionType :: M.Map Name Term -> Flow Graph FunctionType-getFunctionType ann = do-  mt <- getType ann-  case mt of-    Nothing -> fail "type annotation is required for function and elimination terms in Java"-    Just t -> case t of-      TypeFunction ft -> return ft-      _ -> unexpected "function type (3)" $ show t--innerClassRef :: Aliases -> Name -> String -> Java.Identifier-innerClassRef aliases name local = Java.Identifier $ id ++ "." ++ local-  where-    Java.Identifier id = nameToJavaName aliases name--interfaceTypes :: Bool -> [Java.InterfaceType]-interfaceTypes isSer = if isSer then [javaSerializableType] else []-  where-    javaSerializableType = Java.InterfaceType $-      Java.ClassType [] Java.ClassTypeQualifierNone (javaTypeIdentifier "Serializable") []--isLambdaBoundVariable :: Name -> Bool-isLambdaBoundVariable (Name v) = L.length v <= 4--isLocalVariable :: Name -> Bool-isLocalVariable name = Y.isNothing $ qualifiedNameNamespace $ qualifyNameEager name--isRecursiveVariable :: Aliases -> Name -> Bool-isRecursiveVariable aliases name = S.member name (aliasesRecursiveVars aliases)--javaTypeArgumentsForNamedType :: Name -> Flow Graph [Java.TypeArgument]-javaTypeArgumentsForNamedType tname = do-    params <- javaTypeParametersForType <$> requireType tname-    return $ typeParameterToTypeArgument <$> params--javaTypeArgumentsForType :: Type -> [Java.TypeArgument]-javaTypeArgumentsForType typ = L.reverse (typeParameterToTypeArgument <$> javaTypeParametersForType typ)---- Note: this is somewhat of a hack; it compensates for the irregular way in which type parameters are currently used.---       When this irregularity is resolved, a better approach will be to simply pick up type parameters from type applications.-javaTypeParametersForType :: Type -> [Java.TypeParameter]-javaTypeParametersForType typ = toParam <$> vars-  where-    toParam (Name v) = Java.TypeParameter [] (javaTypeIdentifier $ capitalize v) Nothing-    vars = L.nub $ boundVars typ ++ freeVars-    boundVars t = case stripType t of-      TypeLambda (LambdaType v body) -> v:(boundVars body)-      _ -> []-    freeVars = L.filter isLambdaBoundVariable $ S.toList $ freeVariablesInType typ--maybeLet :: Aliases -> Term -> (Aliases -> Term -> [Java.BlockStatement] -> Flow Graph x) -> Flow Graph x-maybeLet aliases term cons = helper Nothing [] term-  where-    -- Note: let-flattening could be done at the top level for better efficiency-    helper mtyp anns term = case flattenLetTerms term of-      TermAnnotated (AnnotatedTerm term' ann) -> helper mtyp (ann:anns) term'-      TermTyped (TypedTerm term' typ) -> helper (Just typ) anns term'-      TermLet (Let bindings env) -> do-          stmts <- L.concat <$> CM.mapM toDeclStatements sorted-          maybeLet aliasesWithRecursive env $ \aliases' tm stmts' -> cons aliases' (reannotate mtyp anns tm) (stmts ++ stmts')-        where-          aliasesWithRecursive = aliases { aliasesRecursiveVars = recursiveVars }-          toDeclStatements names = do-            inits <- Y.catMaybes <$> CM.mapM toDeclInit names-            impls <- CM.mapM toDeclStatement names-            return $ inits ++ impls--          toDeclInit name = if S.member name recursiveVars-            then do-              -- TODO: repeated-              let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings-              typ <- requireTermType value-              jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ-              let id = variableToJavaIdentifier name--              let pkg = javaPackageName ["java", "util", "concurrent", "atomic"]-              let arid = Java.Identifier "java.util.concurrent.atomic.AtomicReference" -- TODO-              let aid = Java.AnnotatedIdentifier [] arid-              rt <- javaTypeToJavaReferenceType jtype-              let targs = typeArgsOrDiamond [Java.TypeArgumentReference rt]-              let ci = Java.ClassOrInterfaceTypeToInstantiate [aid] (Just targs)-              let body = javaConstructorCall ci [] Nothing-              let artype = javaRefType [rt] (Just pkg) "AtomicReference"-              return $ Just $ variableDeclarationStatement aliasesWithRecursive artype id body-            else pure Nothing--          toDeclStatement name = do-            -- TODO: repeated-            let value = letBindingTerm $ L.head $ L.filter (\b -> letBindingName b == name) bindings-            typ <- requireTermType value-            jtype <- adaptTypeToJavaAndEncode aliasesWithRecursive typ-            let id = variableToJavaIdentifier name-            rhs <- encodeTerm aliasesWithRecursive value-            return $ if S.member name recursiveVars-              then Java.BlockStatementStatement $ javaMethodInvocationToJavaStatement $-                methodInvocation (Just $ Left $ Java.ExpressionName Nothing id) (Java.Identifier setMethodName) [rhs]-              else variableDeclarationStatement aliasesWithRecursive jtype id rhs-          bindingVars = S.fromList (letBindingName <$> bindings)-          recursiveVars = S.fromList $ L.concat (ifRec <$> sorted)-            where-              ifRec names = case names of-                [name] -> case M.lookup name allDeps of-                  Nothing -> []-                  Just deps -> if S.member name deps-                    then [name]-                    else []-                _ -> names-          allDeps = M.fromList (toDeps <$> bindings)-            where-              toDeps (LetBinding key value _) = (key, S.filter (\n -> S.member n bindingVars) $ freeVariablesInTerm value)-          sorted = topologicalSortComponents (toDeps <$> M.toList allDeps)-            where-              toDeps (key, deps) = (key, S.toList deps)-      _ -> cons aliases (reannotate mtyp anns term) []--moduleToJavaCompilationUnit :: Module -> Flow Graph (M.Map Name Java.CompilationUnit)-moduleToJavaCompilationUnit mod = transformModule javaLanguage encode constructModule mod-  where-    aliases = importAliasesForModule mod-    encode = encodeTerm aliases . contractTerm--noComment :: Java.ClassBodyDeclaration -> Java.ClassBodyDeclarationWithComments-noComment decl = Java.ClassBodyDeclarationWithComments decl Nothing--reannotate mtyp anns term = case mtyp of-    Nothing -> base-    Just typ -> TermTyped (TypedTerm base typ)-  where-    base = reann anns term-    reann anns term = case anns of-      [] -> term-      (h:r) -> reann r $ TermAnnotated (AnnotatedTerm term h)--toClassDecl :: Bool -> Bool -> Aliases -> [Java.TypeParameter]-  -> Name -> Type -> Flow Graph Java.ClassDeclaration-toClassDecl isInner isSer aliases tparams elName t = case stripType t of-    TypeRecord rt -> declarationForRecordType isInner isSer aliases tparams elName $ rowTypeFields rt-    TypeUnion rt -> declarationForUnionType isSer aliases tparams elName $ rowTypeFields rt-    TypeLambda ut -> declarationForLambdaType isSer aliases tparams elName ut-    TypeWrap (WrappedType tname wt) -> declarationForRecordType isInner isSer aliases tparams elName-      [FieldType (Name "value") wt]-    -- Other types are not supported as class declarations, so we wrap them as record types.-    _ -> wrap t -- TODO: wrap and unwrap the corresponding terms as record terms.-  where-    wrap t' = declarationForRecordType isInner isSer aliases tparams elName [Types.field valueFieldName $ stripType t']--toDataDeclaration :: Aliases -> (a, TypedTerm) -> Flow Graph a-toDataDeclaration aliases (el, TypedTerm term typ) = do-  fail "not implemented" -- TODO--typeArgsOrDiamond :: [Java.TypeArgument] -> Java.TypeArgumentsOrDiamond-typeArgsOrDiamond args = if supportsDiamondOperator javaFeatures-  then Java.TypeArgumentsOrDiamondDiamond-  else Java.TypeArgumentsOrDiamondArguments args
− src/main/haskell/Hydra/Ext/Java/Names.hs 
@@ -1,39 +0,0 @@-module Hydra.Ext.Java.Names where--import Hydra.Kernel--import qualified Hydra.Ext.Java.Syntax as Java---acceptMethodName = "accept" :: String-applyMethodName = "apply" :: String-equalsMethodName = "equals" :: String-getMethodName = "get" :: String-hashCodeMethodName = "hashCode" :: String-instanceName = "instance" :: String-otherInstanceName = "other" :: String-otherwiseMethodName = "otherwise" :: String-partialVisitorName = "PartialVisitor" :: String-setMethodName = "set" :: String-valueFieldName = "value" :: String-visitMethodName = "visit" :: String-visitorName = "Visitor" :: String-visitorReturnParameter = "R" :: String--javaPackageName :: [String] -> Java.PackageName-javaPackageName parts = Java.PackageName (Java.Identifier <$> parts)--hydraCorePackageName :: Maybe Java.PackageName-hydraCorePackageName = Just $ javaPackageName ["hydra", "core"]--hydraUtilPackageName :: Maybe Java.PackageName-hydraUtilPackageName = Just $ javaPackageName ["hydra", "util"]--javaLangPackageName :: Maybe Java.PackageName-javaLangPackageName = Just $ javaPackageName ["java", "lang"]--javaUtilFunctionPackageName :: Maybe Java.PackageName-javaUtilFunctionPackageName = Just $ javaPackageName ["java", "util", "function"]--javaUtilPackageName :: Maybe Java.PackageName-javaUtilPackageName = Just $ javaPackageName ["java", "util"]
− src/main/haskell/Hydra/Ext/Java/Serde.hs 
@@ -1,926 +0,0 @@-module Hydra.Ext.Java.Serde where--import Hydra.Tools.Serialization-import qualified Hydra.Ast as CT-import qualified Hydra.Ext.Java.Syntax as Java-import Hydra.Messages--import qualified Data.List as L-import qualified Data.Maybe as Y---sanitizeJavaComment :: String -> String-sanitizeJavaComment s = L.concat (fromChar <$> s)-  where-    fromChar c = case c of-      '<' -> "&lt;"-      '>' -> "&gt;"-      _ -> [c]--singleLineComment :: String -> CT.Expr-singleLineComment c = cst $ "// " ++ sanitizeJavaComment c--withComments :: Maybe String -> CT.Expr -> CT.Expr-withComments mc expr = case mc of-    Nothing -> expr-    Just c -> newlineSep [writeComments c, expr]-  where-    writeComments c = cst $ "/**\n" ++ unlines (toLine <$> (lines $ sanitizeJavaComment c)) ++ " */"-      where-        toLine l = " * " ++ l--writeAdditionalBound :: Java.AdditionalBound -> CT.Expr-writeAdditionalBound _ = cst "TODO:AdditionalBound"--writeAdditiveExpression :: Java.AdditiveExpression -> CT.Expr-writeAdditiveExpression e = case e of-  Java.AdditiveExpressionUnary m -> writeMultiplicativeExpression m-  Java.AdditiveExpressionPlus (Java.AdditiveExpression_Binary lhs rhs) ->-    infixWs "+" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs)-  Java.AdditiveExpressionMinus (Java.AdditiveExpression_Binary lhs rhs) ->-    infixWs "-" (writeAdditiveExpression lhs) (writeMultiplicativeExpression rhs)--writeAmbiguousName :: Java.AmbiguousName -> CT.Expr-writeAmbiguousName (Java.AmbiguousName parts) = dotSep (writeIdentifier <$> parts)--writeAndExpression :: Java.AndExpression -> CT.Expr-writeAndExpression (Java.AndExpression eqs) = infixWsList "&" (writeEqualityExpression <$> eqs)--writeAnnotatedIdentifier :: Java.AnnotatedIdentifier -> CT.Expr-writeAnnotatedIdentifier (Java.AnnotatedIdentifier anns id) = writeIdentifier id -- Note: ignoring annotations for now--writeAnnotation :: Java.Annotation -> CT.Expr-writeAnnotation ann = case ann of-  Java.AnnotationNormal n -> writeNormalAnnotation n-  Java.AnnotationMarker m -> writeMarkerAnnotation m-  Java.AnnotationSingleElement s -> writeSingleElementAnnotation s--writeAnnotationTypeDeclaration :: Java.AnnotationTypeDeclaration -> CT.Expr-writeAnnotationTypeDeclaration _ = cst "TODO:AnnotationTypeDeclaration"--writeArrayAccess :: Java.ArrayAccess -> CT.Expr-writeArrayAccess _ = cst "TODO:ArrayAccess"--writeArrayCreationExpression :: Java.ArrayCreationExpression -> CT.Expr-writeArrayCreationExpression _ = cst "TODO:ArrayCreationExpression"--writeArrayInitializer :: Java.ArrayInitializer -> CT.Expr-writeArrayInitializer _ = cst "TODO:ArrayInitializer"--writeArrayType :: Java.ArrayType -> CT.Expr-writeArrayType _ = cst "TODO:ArrayType"--writeAssertStatement :: Java.AssertStatement -> CT.Expr-writeAssertStatement _ = cst "TODO:AssertStatement"--writeAssignment :: Java.Assignment -> CT.Expr-writeAssignment (Java.Assignment lhs op rhs) = infixWs ctop (writeLeftHandSide lhs) (writeExpression rhs)-  where-    ctop = case op of-      Java.AssignmentOperatorSimple -> "="-      Java.AssignmentOperatorTimes -> "*="-      Java.AssignmentOperatorDiv -> "/="-      Java.AssignmentOperatorMod -> "%="-      Java.AssignmentOperatorPlus -> "+="-      Java.AssignmentOperatorMinus -> "-="-      Java.AssignmentOperatorShiftLeft -> "<<="-      Java.AssignmentOperatorShiftRight -> ">>="-      Java.AssignmentOperatorShiftRightZeroFill -> ">>>="-      Java.AssignmentOperatorAnd -> "&="-      Java.AssignmentOperatorXor -> "^="-      Java.AssignmentOperatorOr -> "|="--writeAssignmentExpression :: Java.AssignmentExpression -> CT.Expr-writeAssignmentExpression e = case e of-  Java.AssignmentExpressionConditional c -> writeConditionalExpression c-  Java.AssignmentExpressionAssignment a -> writeAssignment a--writeBlock :: Java.Block -> CT.Expr-writeBlock (Java.Block stmts) = curlyBlock fullBlockStyle $ newlineSep (writeBlockStatement <$> stmts)--writeBlockStatement :: Java.BlockStatement -> CT.Expr-writeBlockStatement s = case s of-  Java.BlockStatementLocalVariableDeclaration d -> writeLocalVariableDeclarationStatement d-  Java.BlockStatementClass cd -> writeClassDeclaration cd-  Java.BlockStatementStatement s -> writeStatement s--writeBreakStatement :: Java.BreakStatement -> CT.Expr-writeBreakStatement _ = cst "TODO:BreakStatement"--writeCastExpression :: Java.CastExpression -> CT.Expr-writeCastExpression e = case e of-  Java.CastExpressionPrimitive p -> writeCastExpression_Primitive p-  Java.CastExpressionNotPlusMinus npm -> writeCastExpression_NotPlusMinus npm-  Java.CastExpressionLambda l -> writeCastExpression_Lambda l--writeCastExpression_Lambda :: Java.CastExpression_Lambda -> CT.Expr-writeCastExpression_Lambda _ = cst "TODO:CastExpression_Lambda"--writeCastExpression_NotPlusMinus :: Java.CastExpression_NotPlusMinus -> CT.Expr-writeCastExpression_NotPlusMinus (Java.CastExpression_NotPlusMinus rb ex) = spaceSep [-  writeCastExpression_RefAndBounds rb,-  writeUnaryExpression ex]--writeCastExpression_RefAndBounds :: Java.CastExpression_RefAndBounds -> CT.Expr-writeCastExpression_RefAndBounds (Java.CastExpression_RefAndBounds rt adds) = parenList False [spaceSep $ Y.catMaybes [-  Just $ writeReferenceType rt,-  if L.null adds then Nothing else Just $ spaceSep (writeAdditionalBound <$> adds)]]--writeCastExpression_Primitive :: Java.CastExpression_Primitive -> CT.Expr-writeCastExpression_Primitive _ = cst "TODO:CastExpression_Primitive"--writeCharacterLiteral :: Int -> CT.Expr-writeCharacterLiteral _ = cst "TODO:CharacterLiteral"--writeClassBody :: Java.ClassBody -> CT.Expr-writeClassBody (Java.ClassBody decls) = curlyBlock fullBlockStyle $-  doubleNewlineSep (writeClassBodyDeclarationWithComments <$> decls)--writeClassBodyDeclaration :: Java.ClassBodyDeclaration -> CT.Expr-writeClassBodyDeclaration d = case d of-  Java.ClassBodyDeclarationClassMember d -> writeClassMemberDeclaration d-  Java.ClassBodyDeclarationInstanceInitializer i -> writeInstanceInitializer i-  Java.ClassBodyDeclarationStaticInitializer i -> writeStaticInitializer i-  Java.ClassBodyDeclarationConstructorDeclaration d -> writeConstructorDeclaration d--writeClassBodyDeclarationWithComments :: Java.ClassBodyDeclarationWithComments -> CT.Expr-writeClassBodyDeclarationWithComments (Java.ClassBodyDeclarationWithComments d mc) = withComments mc $-  writeClassBodyDeclaration d--writeClassDeclaration :: Java.ClassDeclaration -> CT.Expr-writeClassDeclaration d = case d of-  Java.ClassDeclarationNormal nd -> writeNormalClassDeclaration nd-  Java.ClassDeclarationEnum ed -> writeEnumDeclaration ed--writeClassInstanceCreationExpression :: Java.ClassInstanceCreationExpression -> CT.Expr-writeClassInstanceCreationExpression (Java.ClassInstanceCreationExpression mqual e) = case mqual of-  Nothing -> writeUnqualifiedClassInstanceCreationExpression e-  Just q -> dotSep [writeClassInstanceCreationExpression_Qualifier q, writeUnqualifiedClassInstanceCreationExpression e]--writeClassInstanceCreationExpression_Qualifier :: Java.ClassInstanceCreationExpression_Qualifier -> CT.Expr-writeClassInstanceCreationExpression_Qualifier q = case q of-  Java.ClassInstanceCreationExpression_QualifierExpression en -> writeExpressionName en-  Java.ClassInstanceCreationExpression_QualifierPrimary p -> writePrimary p--writeClassLiteral :: Java.ClassLiteral -> CT.Expr-writeClassLiteral _ = cst "TODO:ClassLiteral"--writeClassMemberDeclaration :: Java.ClassMemberDeclaration -> CT.Expr-writeClassMemberDeclaration d = case d of-  Java.ClassMemberDeclarationField fd -> writeFieldDeclaration fd-  Java.ClassMemberDeclarationMethod md -> writeMethodDeclaration md-  Java.ClassMemberDeclarationClass cd -> writeClassDeclaration cd-  Java.ClassMemberDeclarationInterface id -> writeInterfaceDeclaration id-  Java.ClassMemberDeclarationNone -> semi--writeClassModifier :: Java.ClassModifier -> CT.Expr-writeClassModifier m = case m of-  Java.ClassModifierAnnotation ann -> writeAnnotation ann-  Java.ClassModifierPublic -> cst "public"-  Java.ClassModifierProtected -> cst "protected"-  Java.ClassModifierPrivate -> cst "private"-  Java.ClassModifierAbstract -> cst "abstract"-  Java.ClassModifierStatic -> cst "static"-  Java.ClassModifierFinal -> cst "final"-  Java.ClassModifierStrictfp -> cst "strictfp"--writeClassOrInterfaceType :: Java.ClassOrInterfaceType -> CT.Expr-writeClassOrInterfaceType cit = case cit of-  Java.ClassOrInterfaceTypeClass ct -> writeClassType ct-  Java.ClassOrInterfaceTypeInterface it -> writeInterfaceType it--writeClassOrInterfaceTypeToInstantiate :: Java.ClassOrInterfaceTypeToInstantiate -> CT.Expr-writeClassOrInterfaceTypeToInstantiate (Java.ClassOrInterfaceTypeToInstantiate ids margs) =-  noSep $ Y.catMaybes [-    Just $ dotSep (writeAnnotatedIdentifier <$> ids),-    writeTypeArgumentsOrDiamond <$> margs]--writeClassType :: Java.ClassType -> CT.Expr-writeClassType (Java.ClassType anns qual id args) = noSep $ Y.catMaybes [-    Just $ spaceSep $ Y.catMaybes [-      if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns),-      Just qualifiedId],-    if L.null args then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> args)]-  where-    qualifiedId = case qual of-      Java.ClassTypeQualifierNone -> writeTypeIdentifier id-      Java.ClassTypeQualifierPackage pkg -> dotSep [writePackageName pkg, writeTypeIdentifier id]-      Java.ClassTypeQualifierParent cit -> dotSep [writeClassOrInterfaceType cit, writeTypeIdentifier id]--writeCompilationUnit :: Java.CompilationUnit -> CT.Expr-writeCompilationUnit u = case u of-  Java.CompilationUnitOrdinary (Java.OrdinaryCompilationUnit mpkg imports types) -> doubleNewlineSep $ Y.catMaybes-      [warning, pkgSec, importsSec, typesSec]-    where-      warning = Just $ singleLineComment warningAutoGeneratedFile-      pkgSec = fmap writePackageDeclaration mpkg-      importsSec = if L.null imports-        then Nothing-        else Just $ newlineSep (writeImportDeclaration <$> imports)-      typesSec = if L.null types-        then Nothing-        else Just $ doubleNewlineSep (writeTypeDeclarationWithComments <$> types)--writeConditionalAndExpression :: Java.ConditionalAndExpression -> CT.Expr-writeConditionalAndExpression (Java.ConditionalAndExpression ors)-  = infixWsList "&&" (writeInclusiveOrExpression <$> ors)--writeConditionalExpression :: Java.ConditionalExpression -> CT.Expr-writeConditionalExpression c = case c of-  Java.ConditionalExpressionSimple co -> writeConditionalOrExpression co-  Java.ConditionalExpressionTernaryCond tc -> writeConditionalExpression_TernaryCond tc-  Java.ConditionalExpressionTernaryLambda tl -> writeConditionalExpression_TernaryLambda tl--writeConditionalExpression_TernaryCond :: Java.ConditionalExpression_TernaryCond -> CT.Expr-writeConditionalExpression_TernaryCond _ = cst "TODO:ConditionalExpression_TernaryCond"--writeConditionalExpression_TernaryLambda :: Java.ConditionalExpression_TernaryLambda -> CT.Expr-writeConditionalExpression_TernaryLambda _ = cst "TODO:ConditionalExpression_TernaryLambda"--writeConditionalOrExpression :: Java.ConditionalOrExpression -> CT.Expr-writeConditionalOrExpression (Java.ConditionalOrExpression ands)-  = infixWsList "||" (writeConditionalAndExpression <$> ands)--writeConstantDeclaration :: Java.ConstantDeclaration -> CT.Expr-writeConstantDeclaration (Java.ConstantDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [-  if L.null mods then Nothing else Just $ spaceSep (writeConstantModifier <$> mods),-  Just $ writeUnannType typ,-  Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)]--writeConstantModifier :: Java.ConstantModifier -> CT.Expr-writeConstantModifier _ = cst "TODO:ConstantModifier"--writeConstructorBody :: Java.ConstructorBody -> CT.Expr-writeConstructorBody (Java.ConstructorBody minvoc stmts) = curlyBlock fullBlockStyle $ doubleNewlineSep $ Y.catMaybes [-  writeExplicitConstructorInvocation <$> minvoc,-  Just $ newlineSep (writeBlockStatement <$> stmts)]--writeConstructorDeclaration :: Java.ConstructorDeclaration -> CT.Expr-writeConstructorDeclaration (Java.ConstructorDeclaration mods cons mthrows body) = spaceSep $ Y.catMaybes [-  if L.null mods then Nothing else Just $ spaceSep (writeConstructorModifier <$> mods),-  Just $ writeConstructorDeclarator cons,-  writeThrows <$> mthrows,-  Just $ writeConstructorBody body]--writeConstructorDeclarator :: Java.ConstructorDeclarator -> CT.Expr-writeConstructorDeclarator (Java.ConstructorDeclarator tparams name mrecparam fparams) = spaceSep $ Y.catMaybes [-  if L.null tparams then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams),-  Just $ writeSimpleTypeName name,-  writeReceiverParameter <$> mrecparam,-  Just $ parenList False (writeFormalParameter <$> fparams)]--writeConstructorModifier :: Java.ConstructorModifier -> CT.Expr-writeConstructorModifier m = case m of-  Java.ConstructorModifierAnnotation ann -> writeAnnotation ann-  Java.ConstructorModifierPublic -> cst "public"-  Java.ConstructorModifierProtected -> cst "protected"-  Java.ConstructorModifierPrivate -> cst "private"--writeContinueStatement :: Java.ContinueStatement -> CT.Expr-writeContinueStatement _ = cst "TODO:ContinueStatement"--writeDims :: Java.Dims -> CT.Expr-writeDims (Java.Dims anns) = noSep (write <$> anns)-  where-    write _ = cst "[]" -- Note: ignoring annotations on dimensions for now--writeDoStatement :: Java.DoStatement -> CT.Expr-writeDoStatement _ = cst "TODO:DoStatement"--writeElementValue :: Java.ElementValue -> CT.Expr-writeElementValue ev = case ev of-  Java.ElementValueConditionalExpression c -> writeConditionalExpression c-  Java.ElementValueElementValueArrayInitializer (Java.ElementValueArrayInitializer values) ->-    commaSep inlineStyle (writeElementValue <$> values)-  Java.ElementValueAnnotation ann -> writeAnnotation ann--writeElementValuePair :: Java.ElementValuePair -> CT.Expr-writeElementValuePair (Java.ElementValuePair k v) = infixWs "=" (writeIdentifier k) (writeElementValue v)--writeEmptyStatement :: Java.EmptyStatement -> CT.Expr-writeEmptyStatement _ = semi--writeEnumDeclaration :: Java.EnumDeclaration -> CT.Expr-writeEnumDeclaration _ = cst "TODO:EnumDeclaration"--writeEqualityExpression :: Java.EqualityExpression -> CT.Expr-writeEqualityExpression e = case e of-  Java.EqualityExpressionUnary r -> writeRelationalExpression r-  Java.EqualityExpressionEqual (Java.EqualityExpression_Binary lhs rhs) ->-    infixWs "==" (writeEqualityExpression lhs) (writeRelationalExpression rhs)-  Java.EqualityExpressionNotEqual (Java.EqualityExpression_Binary lhs rhs) ->-    infixWs "!=" (writeEqualityExpression lhs) (writeRelationalExpression rhs)--writeExclusiveOrExpression :: Java.ExclusiveOrExpression -> CT.Expr-writeExclusiveOrExpression (Java.ExclusiveOrExpression ands) = infixWsList "^" (writeAndExpression <$> ands)--writeExplicitConstructorInvocation :: Java.ExplicitConstructorInvocation -> CT.Expr-writeExplicitConstructorInvocation _ = cst "TODO:ExplicitConstructorInvocation"--writeExpression :: Java.Expression -> CT.Expr-writeExpression e = case e of-  Java.ExpressionLambda l -> writeLambdaExpression l-  Java.ExpressionAssignment a -> writeAssignmentExpression a--writeExpressionName :: Java.ExpressionName -> CT.Expr-writeExpressionName (Java.ExpressionName mqual id) = dotSep $ Y.catMaybes [-  writeAmbiguousName <$> mqual,-  Just $ writeIdentifier id]--writeExpressionStatement :: Java.ExpressionStatement -> CT.Expr-writeExpressionStatement (Java.ExpressionStatement stmt) = suffixSemi $ writeStatementExpression stmt--writeFieldAccess :: Java.FieldAccess -> CT.Expr-writeFieldAccess (Java.FieldAccess qual id) = dotSep $ case qual of-  Java.FieldAccess_QualifierPrimary p -> [writePrimary p, writeIdentifier id]-  Java.FieldAccess_QualifierSuper -> [cst "super", writeIdentifier id]-  Java.FieldAccess_QualifierTyped tn -> [writeTypeName tn, cst "super", writeIdentifier id]--writeFieldDeclaration :: Java.FieldDeclaration -> CT.Expr-writeFieldDeclaration (Java.FieldDeclaration mods typ vars) = suffixSemi $ spaceSep $ Y.catMaybes [-    if L.null mods then Nothing else Just $ spaceSep (writeFieldModifier <$> mods),-    Just $ writeUnannType typ,-    Just $ commaSep inlineStyle (writeVariableDeclarator <$> vars)]--writeFieldModifier :: Java.FieldModifier -> CT.Expr-writeFieldModifier m = case m of-  Java.FieldModifierAnnotation ann -> writeAnnotation ann-  Java.FieldModifierPublic -> cst "public"-  Java.FieldModifierProtected -> cst "protected"-  Java.FieldModifierPrivate -> cst "private"-  Java.FieldModifierStatic -> cst "static"-  Java.FieldModifierFinal -> cst "final"-  Java.FieldModifierTransient -> cst "transient"-  Java.FieldModifierVolatile -> cst "volatile"--writeFloatingPointLiteral :: Java.FloatingPointLiteral -> CT.Expr-writeFloatingPointLiteral _ = cst "TODO:FloatingPointLiteral"--writeFloatingPointType :: Java.FloatingPointType -> CT.Expr-writeFloatingPointType _ = cst "TODO:FloatingPointType"--writeForStatement :: Java.ForStatement -> CT.Expr-writeForStatement _ = cst "TODO:ForStatement"--writeFormalParameter :: Java.FormalParameter -> CT.Expr-writeFormalParameter p = case p of-  Java.FormalParameterSimple s -> writeFormalParameter_Simple s-  Java.FormalParameterVariableArity v -> writeVariableArityParameter v--writeFormalParameter_Simple :: Java.FormalParameter_Simple -> CT.Expr-writeFormalParameter_Simple (Java.FormalParameter_Simple mods typ id) = spaceSep $ Y.catMaybes [-  if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods),-  Just $ writeUnannType typ,-  Just $ writeVariableDeclaratorId id]--writeIdentifier :: Java.Identifier -> CT.Expr-writeIdentifier (Java.Identifier s) = cst s--writeIfThenStatement :: Java.IfThenStatement -> CT.Expr-writeIfThenStatement (Java.IfThenStatement cond thn) = spaceSep [-  cst "if",-  parenList False [writeExpression cond],-  writeBlock (Java.Block [Java.BlockStatementStatement thn])]--writeIfThenElseStatement :: Java.IfThenElseStatement -> CT.Expr-writeIfThenElseStatement _ = cst "TODO:IfThenElseStatement"--writeImportDeclaration :: Java.ImportDeclaration -> CT.Expr-writeImportDeclaration imp = case imp of-  Java.ImportDeclarationSingleType (Java.SingleTypeImportDeclaration tn) -> suffixSemi $-    spaceSep [cst "import", writeTypeName tn]-  Java.ImportDeclarationTypeImportOnDemand d -> cst "TODO:ImportDeclarationTypeImportOnDemand"-  Java.ImportDeclarationSingleStaticImport d -> cst "TODO:ImportDeclarationSingleStaticImport"-  Java.ImportDeclarationStaticImportOnDemand d -> cst "TODO:ImportDeclarationStaticImportOnDemand"--writeInclusiveOrExpression :: Java.InclusiveOrExpression -> CT.Expr-writeInclusiveOrExpression (Java.InclusiveOrExpression ors)-  = infixWsList "|" (writeExclusiveOrExpression <$> ors)--writeInstanceInitializer :: Java.InstanceInitializer -> CT.Expr-writeInstanceInitializer _ = cst "TODO:InstanceInitializer"--writeIntegerLiteral :: Java.IntegerLiteral -> CT.Expr-writeIntegerLiteral (Java.IntegerLiteral i) = cst $ show i--writeIntegralType :: Java.IntegralType -> CT.Expr-writeIntegralType t = cst $ case t of-  Java.IntegralTypeByte -> "byte"-  Java.IntegralTypeShort -> "short"-  Java.IntegralTypeInt -> "int"-  Java.IntegralTypeLong -> "long"-  Java.IntegralTypeChar -> "char"--writeInterfaceBody :: Java.InterfaceBody -> CT.Expr-writeInterfaceBody (Java.InterfaceBody decls) = curlyBlock fullBlockStyle $ doubleNewlineSep-  (writeInterfaceMemberDeclaration <$> decls)--writeInterfaceDeclaration :: Java.InterfaceDeclaration -> CT.Expr-writeInterfaceDeclaration d = case d of-  Java.InterfaceDeclarationNormalInterface n -> writeNormalInterfaceDeclaration n-  Java.InterfaceDeclarationAnnotationType a -> writeAnnotationTypeDeclaration a--writeInterfaceMemberDeclaration :: Java.InterfaceMemberDeclaration -> CT.Expr-writeInterfaceMemberDeclaration d = case d of-  Java.InterfaceMemberDeclarationConstant c -> writeConstantDeclaration c-  Java.InterfaceMemberDeclarationInterfaceMethod im -> writeInterfaceMethodDeclaration im-  Java.InterfaceMemberDeclarationClass cd -> writeClassDeclaration cd-  Java.InterfaceMemberDeclarationInterface id -> writeInterfaceDeclaration id--writeInterfaceMethodDeclaration :: Java.InterfaceMethodDeclaration -> CT.Expr-writeInterfaceMethodDeclaration (Java.InterfaceMethodDeclaration mods header body) = spaceSep $ Y.catMaybes [-      if L.null mods then Nothing else Just $ spaceSep (writeInterfaceMethodModifier <$> mods),-      Just $ writeMethodHeader header,-      Just $ writeMethodBody body]--writeInterfaceMethodModifier :: Java.InterfaceMethodModifier -> CT.Expr-writeInterfaceMethodModifier m = case m of-  Java.InterfaceMethodModifierAnnotation a -> writeAnnotation a-  Java.InterfaceMethodModifierPublic -> cst "public"-  Java.InterfaceMethodModifierPrivate -> cst "private"-  Java.InterfaceMethodModifierAbstract -> cst "abstract"-  Java.InterfaceMethodModifierDefault -> cst "default"-  Java.InterfaceMethodModifierStatic -> cst "static"-  Java.InterfaceMethodModifierStrictfp -> cst "strictfp"--writeInterfaceModifier :: Java.InterfaceModifier -> CT.Expr-writeInterfaceModifier m = case m of-  Java.InterfaceModifierAnnotation a -> writeAnnotation a-  Java.InterfaceModifierPublic -> cst "public"-  Java.InterfaceModifierProtected -> cst "protected"-  Java.InterfaceModifierPrivate -> cst "private"-  Java.InterfaceModifierAbstract -> cst "abstract"-  Java.InterfaceModifierStatic -> cst "static"-  Java.InterfaceModifierStrictfb -> cst "strictfb"--writeInterfaceType :: Java.InterfaceType -> CT.Expr-writeInterfaceType (Java.InterfaceType ct) = writeClassType ct--writeLabeledStatement :: Java.LabeledStatement -> CT.Expr-writeLabeledStatement _ = cst "TODO:LabeledStatement"--writeLambdaBody :: Java.LambdaBody -> CT.Expr-writeLambdaBody b = case b of-  Java.LambdaBodyExpression e -> writeExpression e-  Java.LambdaBodyBlock b -> writeBlock b--writeLambdaExpression :: Java.LambdaExpression -> CT.Expr-writeLambdaExpression (Java.LambdaExpression params body) =-  infixWs "->" (writeLambdaParameters params) (writeLambdaBody body)--writeLambdaParameters :: Java.LambdaParameters -> CT.Expr-writeLambdaParameters p = case p of-  Java.LambdaParametersTuple l -> parenList False (writeLambdaParameters <$> l)-  Java.LambdaParametersSingle id -> writeIdentifier id--writeLeftHandSide :: Java.LeftHandSide -> CT.Expr-writeLeftHandSide lhs = case lhs of-  Java.LeftHandSideExpressionName en -> writeExpressionName en-  Java.LeftHandSideFieldAccess fa -> writeFieldAccess fa-  Java.LeftHandSideArrayAccess aa -> writeArrayAccess aa--writeLiteral :: Java.Literal -> CT.Expr-writeLiteral l = case l of-  Java.LiteralNull -> cst "null"-  Java.LiteralInteger il -> writeIntegerLiteral il-  Java.LiteralFloatingPoint fl -> writeFloatingPointLiteral fl-  Java.LiteralBoolean b -> cst $ if b then "true" else "false"-  Java.LiteralCharacter c -> writeCharacterLiteral c-  Java.LiteralString sl -> writeStringLiteral sl--writeLocalVariableDeclaration :: Java.LocalVariableDeclaration -> CT.Expr-writeLocalVariableDeclaration (Java.LocalVariableDeclaration mods t decls) = spaceSep $ Y.catMaybes [-  if L.null mods then Nothing else Just $ spaceSep (writeVariableModifier <$> mods),-  Just $ writeLocalName t,-  Just $ commaSep inlineStyle (writeVariableDeclarator <$> decls)]--writeLocalVariableDeclarationStatement :: Java.LocalVariableDeclarationStatement -> CT.Expr-writeLocalVariableDeclarationStatement (Java.LocalVariableDeclarationStatement d) = suffixSemi $ writeLocalVariableDeclaration d--writeLocalName :: Java.LocalVariableType -> CT.Expr-writeLocalName t = case t of-  Java.LocalVariableTypeType ut -> writeUnannType ut-  Java.LocalVariableTypeVar -> cst "var"--writeMarkerAnnotation :: Java.MarkerAnnotation -> CT.Expr-writeMarkerAnnotation (Java.MarkerAnnotation tname) = prefixAt $ writeTypeName tname--writeMethodBody :: Java.MethodBody -> CT.Expr-writeMethodBody b = case b of-  Java.MethodBodyBlock block -> writeBlock block-  Java.MethodBodyNone -> semi--writeMethodDeclaration :: Java.MethodDeclaration -> CT.Expr-writeMethodDeclaration (Java.MethodDeclaration anns mods header body) = newlineSep $ Y.catMaybes [-    if L.null anns then Nothing else Just $ newlineSep (writeAnnotation <$> anns),-    Just headerAndBody]-  where-    headerAndBody = spaceSep $ Y.catMaybes [-      if L.null mods then Nothing else Just $ spaceSep (writeMethodModifier <$> mods),-      Just $ writeMethodHeader header,-      Just $ writeMethodBody body]--writeMethodDeclarator :: Java.MethodDeclarator -> CT.Expr-writeMethodDeclarator (Java.MethodDeclarator id rparam params) = noSep [-  writeIdentifier id,-  -- Note: ignoring receiver param for now-  parenList False (writeFormalParameter <$> params)]--writeMethodHeader :: Java.MethodHeader -> CT.Expr-writeMethodHeader (Java.MethodHeader params result decl mthrows) = spaceSep $ Y.catMaybes [-  if L.null params then Nothing else Just $ angleBracesList inlineStyle (writeTypeParameter <$> params),-  Just $ writeResult result,-  Just $ writeMethodDeclarator decl,-  writeThrows <$> mthrows]--writeMethodInvocation :: Java.MethodInvocation -> CT.Expr-writeMethodInvocation (Java.MethodInvocation header args) = noSep [headerSec, argSec]-  where-    argSec = parenList True (writeExpression <$> args)-    headerSec = case header of-      Java.MethodInvocation_HeaderSimple mname -> writeMethodName mname-      Java.MethodInvocation_HeaderComplex (Java.MethodInvocation_Complex var targs id) -> case var of-          Java.MethodInvocation_VariantType tname -> dotSep [writeTypeName tname, idSec]-          Java.MethodInvocation_VariantExpression en -> dotSep [writeExpressionName en, idSec]-          Java.MethodInvocation_VariantPrimary p -> dotSep [writePrimary p, idSec]-          Java.MethodInvocation_VariantSuper -> dotSep [super, idSec]-          Java.MethodInvocation_VariantTypeSuper tname -> dotSep [writeTypeName tname, super, idSec]-        where-          super = cst "super"-          idSec = noSep $ Y.catMaybes [-            if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs),-            Just $ writeIdentifier id]--writeMethodModifier :: Java.MethodModifier -> CT.Expr-writeMethodModifier m = case m of-  Java.MethodModifierAnnotation ann -> writeAnnotation ann-  Java.MethodModifierPublic -> cst "public"-  Java.MethodModifierProtected -> cst "protected"-  Java.MethodModifierPrivate -> cst "private"-  Java.MethodModifierAbstract -> cst "abstract"-  Java.MethodModifierFinal -> cst "final"-  Java.MethodModifierSynchronized -> cst "synchronized"-  Java.MethodModifierNative -> cst "native"-  Java.MethodModifierStrictfb -> cst "strictfb"--writeMethodName :: Java.MethodName -> CT.Expr-writeMethodName (Java.MethodName id) = writeIdentifier id--writeMethodReference :: Java.MethodReference -> CT.Expr-writeMethodReference _ = cst "TODO:MethodReference"--writeMultiplicativeExpression :: Java.MultiplicativeExpression -> CT.Expr-writeMultiplicativeExpression e = case e of-  Java.MultiplicativeExpressionUnary u -> writeUnaryExpression u-  Java.MultiplicativeExpressionTimes (Java.MultiplicativeExpression_Binary lhs rhs) ->-    infixWs "*" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs)-  Java.MultiplicativeExpressionDivide (Java.MultiplicativeExpression_Binary lhs rhs) ->-    infixWs "/" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs)-  Java.MultiplicativeExpressionMod (Java.MultiplicativeExpression_Binary lhs rhs) ->-    infixWs "%" (writeMultiplicativeExpression lhs) (writeUnaryExpression rhs)--writeNormalAnnotation :: Java.NormalAnnotation -> CT.Expr-writeNormalAnnotation (Java.NormalAnnotation tname pairs) = prefixAt $ noSep [-  writeTypeName tname,-  commaSep inlineStyle (writeElementValuePair <$> pairs)]--writeNormalClassDeclaration :: Java.NormalClassDeclaration -> CT.Expr-writeNormalClassDeclaration (Java.NormalClassDeclaration mods id tparams msuperc superi body) =-    spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, implementsSec, bodySec]-  where-    modSec = if L.null mods-      then Nothing-      else Just $ spaceSep (writeClassModifier <$> mods)-    classSec = Just $ cst "class"-    idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params]-      where-        params = if L.null tparams-          then Nothing-          else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams)-    extendsSec = fmap (\c -> spaceSep [cst "extends", writeClassType c]) msuperc-    implementsSec = if L.null superi-      then Nothing-      else Just $ spaceSep [cst "implements", commaSep inlineStyle (writeInterfaceType <$> superi)]-    bodySec = Just $ writeClassBody body--writeNormalInterfaceDeclaration :: Java.NormalInterfaceDeclaration -> CT.Expr-writeNormalInterfaceDeclaration (Java.NormalInterfaceDeclaration mods id tparams extends body) =-    spaceSep $ Y.catMaybes [modSec, classSec, idSec, extendsSec, bodySec]-  where-    modSec = if L.null mods-      then Nothing-      else Just $ spaceSep (writeInterfaceModifier <$> mods)-    classSec = Just $ cst "interface"-    idSec = Just $ noSep $ Y.catMaybes [Just $ writeTypeIdentifier id, params]-      where-        params = if L.null tparams-          then Nothing-          else Just $ angleBracesList inlineStyle (writeTypeParameter <$> tparams)-    extendsSec = if L.null extends then Nothing else Just $-      spaceSep [cst "extends", commaSep inlineStyle (writeInterfaceType <$> extends)]-    bodySec = Just $ writeInterfaceBody body--writeNumericType :: Java.NumericType -> CT.Expr-writeNumericType nt = case nt of-  Java.NumericTypeIntegral it -> writeIntegralType it-  Java.NumericTypeFloatingPoint ft -> writeFloatingPointType ft--writePackageDeclaration :: Java.PackageDeclaration -> CT.Expr-writePackageDeclaration (Java.PackageDeclaration mods ids) = suffixSemi $ spaceSep $ Y.catMaybes [-    if L.null mods then Nothing else Just $ spaceSep (writePackageModifier <$> mods),-    Just $ spaceSep [cst "package", cst $ L.intercalate "." (Java.unIdentifier <$> ids)]]--writePackageName :: Java.PackageName -> CT.Expr-writePackageName (Java.PackageName ids) = dotSep (writeIdentifier <$> ids)--writePackageOrTypeName :: Java.PackageOrTypeName -> CT.Expr-writePackageOrTypeName (Java.PackageOrTypeName ids) = dotSep (writeIdentifier <$> ids)--writePackageModifier :: Java.PackageModifier -> CT.Expr-writePackageModifier (Java.PackageModifier ann) = writeAnnotation ann--writePostDecrementExpression :: Java.PostDecrementExpression -> CT.Expr-writePostDecrementExpression _ = cst "TODO:PostDecrementExpression"--writePostIncrementExpression :: Java.PostIncrementExpression -> CT.Expr-writePostIncrementExpression _ = cst "TODO:PostIncrementExpression"--writePostfixExpression :: Java.PostfixExpression -> CT.Expr-writePostfixExpression e = case e of-  Java.PostfixExpressionPrimary p -> writePrimary p-  Java.PostfixExpressionName en -> writeExpressionName en-  Java.PostfixExpressionPostIncrement pi -> writePostIncrementExpression pi-  Java.PostfixExpressionPostDecrement pd -> writePostDecrementExpression pd--writePreDecrementExpression:: Java.PreDecrementExpression -> CT.Expr-writePreDecrementExpression _ = cst "TODO:PreDecrementExpression"--writePreIncrementExpression :: Java.PreIncrementExpression -> CT.Expr-writePreIncrementExpression _ = cst "TODO:PreIncrementExpression"--writePrimary :: Java.Primary -> CT.Expr-writePrimary p = case p of-  Java.PrimaryNoNewArray n -> writePrimaryNoNewArray n-  Java.PrimaryArrayCreation a -> writeArrayCreationExpression a--writePrimaryNoNewArray :: Java.PrimaryNoNewArray -> CT.Expr-writePrimaryNoNewArray p = case p of-  Java.PrimaryNoNewArrayLiteral l -> writeLiteral l-  Java.PrimaryNoNewArrayClassLiteral cl -> writeClassLiteral cl-  Java.PrimaryNoNewArrayThis -> cst "this"-  Java.PrimaryNoNewArrayDotThis n -> dotSep [writeTypeName n, cst "this"]-  Java.PrimaryNoNewArrayParens e -> parenList False [writeExpression e]-  Java.PrimaryNoNewArrayClassInstance ci -> writeClassInstanceCreationExpression ci-  Java.PrimaryNoNewArrayFieldAccess fa -> writeFieldAccess fa-  Java.PrimaryNoNewArrayArrayAccess aa -> writeArrayAccess aa-  Java.PrimaryNoNewArrayMethodInvocation mi -> writeMethodInvocation mi-  Java.PrimaryNoNewArrayMethodReference mr -> writeMethodReference mr--writePrimitiveType :: Java.PrimitiveType -> CT.Expr-writePrimitiveType pt = case pt of-  Java.PrimitiveTypeNumeric nt -> writeNumericType nt-  Java.PrimitiveTypeBoolean -> cst "boolean"--writePrimitiveTypeWithAnnotations :: Java.PrimitiveTypeWithAnnotations -> CT.Expr-writePrimitiveTypeWithAnnotations (Java.PrimitiveTypeWithAnnotations pt anns) = spaceSep $ Y.catMaybes [-  if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns),-  Just $ writePrimitiveType pt]--writeReceiverParameter :: Java.ReceiverParameter -> CT.Expr-writeReceiverParameter _ = cst "TODO:ReceiverParameter"--writeReferenceType :: Java.ReferenceType -> CT.Expr-writeReferenceType rt = case rt of-  Java.ReferenceTypeClassOrInterface cit -> writeClassOrInterfaceType cit-  Java.ReferenceTypeVariable v -> writeName v-  Java.ReferenceTypeArray at -> writeArrayType at--writeRelationalExpression :: Java.RelationalExpression -> CT.Expr-writeRelationalExpression e = case e of-  Java.RelationalExpressionSimple s -> writeShiftExpression s-  Java.RelationalExpressionLessThan lt -> writeRelationalExpression_LessThan lt-  Java.RelationalExpressionGreaterThan gt -> writeRelationalExpression_GreaterThan gt-  Java.RelationalExpressionLessThanEqual lte -> writeRelationalExpression_LessThanEqual lte-  Java.RelationalExpressionGreaterThanEqual gte -> writeRelationalExpression_GreaterThanEqual gte-  Java.RelationalExpressionInstanceof i -> writeRelationalExpression_InstanceOf i--writeRelationalExpression_GreaterThan :: Java.RelationalExpression_GreaterThan -> CT.Expr-writeRelationalExpression_GreaterThan _ = cst "TODO:RelationalExpression_GreaterThan"--writeRelationalExpression_GreaterThanEqual :: Java.RelationalExpression_GreaterThanEqual -> CT.Expr-writeRelationalExpression_GreaterThanEqual _ = cst "TODO:RelationalExpression_GreaterThanEqual"--writeRelationalExpression_InstanceOf :: Java.RelationalExpression_InstanceOf -> CT.Expr-writeRelationalExpression_InstanceOf (Java.RelationalExpression_InstanceOf lhs rhs) =-  infixWs "instanceof" (writeRelationalExpression lhs) (writeReferenceType rhs)--writeRelationalExpression_LessThan :: Java.RelationalExpression_LessThan -> CT.Expr-writeRelationalExpression_LessThan _ = cst "TODO:RelationalExpression_LessThan"--writeRelationalExpression_LessThanEqual :: Java.RelationalExpression_LessThanEqual -> CT.Expr-writeRelationalExpression_LessThanEqual _ = cst "TODO:RelationalExpression_LessThanEqual"--writeResult :: Java.Result -> CT.Expr-writeResult r = case r of-  Java.ResultType t -> writeUnannType t-  Java.ResultVoid -> cst "void"--writeReturnStatement :: Java.ReturnStatement -> CT.Expr-writeReturnStatement (Java.ReturnStatement mex) = suffixSemi $ spaceSep $ Y.catMaybes [-  Just $ cst "return",-  writeExpression <$> mex]--writeShiftExpression :: Java.ShiftExpression -> CT.Expr-writeShiftExpression e = case e of-  Java.ShiftExpressionUnary a -> writeAdditiveExpression a-  Java.ShiftExpressionShiftLeft (Java.ShiftExpression_Binary lhs rhs) ->-    infixWs "<<" (writeShiftExpression lhs) (writeAdditiveExpression rhs)-  Java.ShiftExpressionShiftRight (Java.ShiftExpression_Binary lhs rhs) ->-    infixWs ">>" (writeShiftExpression lhs) (writeAdditiveExpression rhs)-  Java.ShiftExpressionShiftRightZeroFill (Java.ShiftExpression_Binary lhs rhs) ->-    infixWs ">>>" (writeShiftExpression lhs) (writeAdditiveExpression rhs)--writeSimpleTypeName :: Java.SimpleTypeName -> CT.Expr-writeSimpleTypeName (Java.SimpleTypeName tid) = writeTypeIdentifier tid--writeSingleElementAnnotation :: Java.SingleElementAnnotation -> CT.Expr-writeSingleElementAnnotation (Java.SingleElementAnnotation tname mv) = case mv of-  Nothing -> writeMarkerAnnotation (Java.MarkerAnnotation tname)-  Just v -> prefixAt $ noSep [writeTypeName tname, parenList False [writeElementValue v]]--writeStatement :: Java.Statement -> CT.Expr-writeStatement s = case s of-  Java.StatementWithoutTrailing s -> writeStatementWithoutTrailingSubstatement s-  Java.StatementLabeled l -> writeLabeledStatement l-  Java.StatementIfThen it -> writeIfThenStatement it-  Java.StatementIfThenElse ite -> writeIfThenElseStatement ite-  Java.StatementWhile w -> writeWhileStatement w-  Java.StatementFor f -> writeForStatement f--writeStatementExpression :: Java.StatementExpression -> CT.Expr-writeStatementExpression e = case e of-  Java.StatementExpressionAssignment ass -> writeAssignment ass-  Java.StatementExpressionPreIncrement pi -> writePreIncrementExpression pi-  Java.StatementExpressionPreDecrement pd -> writePreDecrementExpression pd-  Java.StatementExpressionPostIncrement pi -> writePostIncrementExpression pi-  Java.StatementExpressionPostDecrement pd -> writePostDecrementExpression pd-  Java.StatementExpressionMethodInvocation m -> writeMethodInvocation m-  Java.StatementExpressionClassInstanceCreation cic -> writeClassInstanceCreationExpression cic--writeStatementWithoutTrailingSubstatement :: Java.StatementWithoutTrailingSubstatement -> CT.Expr-writeStatementWithoutTrailingSubstatement s = case s of-  Java.StatementWithoutTrailingSubstatementBlock b -> writeBlock b-  Java.StatementWithoutTrailingSubstatementEmpty e -> writeEmptyStatement e-  Java.StatementWithoutTrailingSubstatementExpression e -> writeExpressionStatement e-  Java.StatementWithoutTrailingSubstatementAssert a -> writeAssertStatement a-  Java.StatementWithoutTrailingSubstatementSwitch s -> writeSwitchStatement s-  Java.StatementWithoutTrailingSubstatementDo d -> writeDoStatement d-  Java.StatementWithoutTrailingSubstatementBreak b -> writeBreakStatement b-  Java.StatementWithoutTrailingSubstatementContinue c -> writeContinueStatement c-  Java.StatementWithoutTrailingSubstatementReturn r -> writeReturnStatement r-  Java.StatementWithoutTrailingSubstatementSynchronized s -> writeSynchronizedStatement s-  Java.StatementWithoutTrailingSubstatementThrow t -> writeThrowStatement t-  Java.StatementWithoutTrailingSubstatementTry t -> writeTryStatement t--writeStaticInitializer :: Java.StaticInitializer -> CT.Expr-writeStaticInitializer _ = cst "TODO:StaticInitializer"--writeStringLiteral :: Java.StringLiteral -> CT.Expr-writeStringLiteral (Java.StringLiteral s) = cst $ show s--writeSwitchStatement :: Java.SwitchStatement -> CT.Expr-writeSwitchStatement _ = cst "TODO:SwitchStatement"--writeSynchronizedStatement :: Java.SynchronizedStatement -> CT.Expr-writeSynchronizedStatement _ = cst "TODO:SynchronizedStatement"--writeThrowStatement :: Java.ThrowStatement -> CT.Expr-writeThrowStatement (Java.ThrowStatement ex) = suffixSemi $ spaceSep [cst "throw", writeExpression ex]--writeThrows :: Java.Throws -> CT.Expr-writeThrows _ = cst "TODO:Throws"--writeTryStatement :: Java.TryStatement -> CT.Expr-writeTryStatement _ = cst "TODO:TryStatement"--writeType :: Java.Type -> CT.Expr-writeType t = case t of-  Java.TypePrimitive pt -> writePrimitiveTypeWithAnnotations pt-  Java.TypeReference rt -> writeReferenceType rt--writeTypeArgument :: Java.TypeArgument -> CT.Expr-writeTypeArgument a = case a of-  Java.TypeArgumentReference rt -> writeReferenceType rt-  Java.TypeArgumentWildcard w -> writeWildcard w--writeTypeArgumentsOrDiamond :: Java.TypeArgumentsOrDiamond -> CT.Expr-writeTypeArgumentsOrDiamond targs = case targs of-  Java.TypeArgumentsOrDiamondArguments args -> angleBracesList inlineStyle (writeTypeArgument <$> args)-  Java.TypeArgumentsOrDiamondDiamond -> cst "<>"--writeTypeBound :: Java.TypeBound -> CT.Expr-writeTypeBound _ = cst "TODO:TypeBound"--writeTypeDeclaration :: Java.TypeDeclaration -> CT.Expr-writeTypeDeclaration d = case d of-  Java.TypeDeclarationClass d -> writeClassDeclaration d-  Java.TypeDeclarationInterface d -> writeInterfaceDeclaration d-  Java.TypeDeclarationNone -> semi--writeTypeDeclarationWithComments :: Java.TypeDeclarationWithComments -> CT.Expr-writeTypeDeclarationWithComments (Java.TypeDeclarationWithComments d mc) = withComments mc $ writeTypeDeclaration d--writeTypeIdentifier :: Java.TypeIdentifier -> CT.Expr-writeTypeIdentifier (Java.TypeIdentifier id) = writeIdentifier id--writeTypeName :: Java.TypeName -> CT.Expr-writeTypeName (Java.TypeName id mqual) = dotSep $ Y.catMaybes [-  writePackageOrTypeName <$> mqual,-  Just $ writeTypeIdentifier id]--writeTypeParameter :: Java.TypeParameter -> CT.Expr-writeTypeParameter (Java.TypeParameter mods id bound) = spaceSep $ Y.catMaybes [-  if L.null mods then Nothing else Just $ spaceSep (writeTypeParameterModifier <$> mods),-  Just $ writeTypeIdentifier id,-  fmap (\b -> spaceSep [cst "extends", writeTypeBound b]) bound]--writeTypeParameterModifier :: Java.TypeParameterModifier -> CT.Expr-writeTypeParameterModifier (Java.TypeParameterModifier ann) = writeAnnotation ann--writeName :: Java.TypeVariable -> CT.Expr-writeName (Java.TypeVariable anns id) = spaceSep $ Y.catMaybes [-  if L.null anns then Nothing else Just $ spaceSep (writeAnnotation <$> anns),-  Just $ writeTypeIdentifier id]--writeUnannType :: Java.UnannType -> CT.Expr-writeUnannType (Java.UnannType t) = writeType t--writeUnaryExpression :: Java.UnaryExpression -> CT.Expr-writeUnaryExpression e = case e of-  Java.UnaryExpressionPreIncrement pi -> writePreIncrementExpression pi-  Java.UnaryExpressionPreDecrement pd -> writePreDecrementExpression pd-  Java.UnaryExpressionPlus p -> spaceSep [cst "+", writeUnaryExpression p]-  Java.UnaryExpressionMinus m -> spaceSep [cst "-", writeUnaryExpression m]-  Java.UnaryExpressionOther o -> writeUnaryExpressionNotPlusMinus o--writeUnaryExpressionNotPlusMinus :: Java.UnaryExpressionNotPlusMinus -> CT.Expr-writeUnaryExpressionNotPlusMinus e = case e of-  Java.UnaryExpressionNotPlusMinusPostfix p -> writePostfixExpression p-  Java.UnaryExpressionNotPlusMinusTilde u -> spaceSep [cst "~", writeUnaryExpression u]-  Java.UnaryExpressionNotPlusMinusNot u -> noSep [cst "!", writeUnaryExpression u]-  Java.UnaryExpressionNotPlusMinusCast c -> writeCastExpression c--writeUnqualifiedClassInstanceCreationExpression  :: Java.UnqualifiedClassInstanceCreationExpression -> CT.Expr-writeUnqualifiedClassInstanceCreationExpression (Java.UnqualifiedClassInstanceCreationExpression targs cit args mbody)-  = spaceSep $ Y.catMaybes [-    Just $ cst "new",-    if L.null targs then Nothing else Just $ angleBracesList inlineStyle (writeTypeArgument <$> targs),-    Just $ noSep [writeClassOrInterfaceTypeToInstantiate cit, parenList False (writeExpression <$> args)],-    writeClassBody <$> mbody]--writeVariableArityParameter :: Java.VariableArityParameter -> CT.Expr-writeVariableArityParameter _ = cst "TODO:VariableArityParameter"--writeVariableDeclarator :: Java.VariableDeclarator -> CT.Expr-writeVariableDeclarator (Java.VariableDeclarator id minit) =-    Y.maybe idSec (infixWs "=" idSec . writeVariableInitializer) minit-  where-    idSec = writeVariableDeclaratorId id--writeVariableDeclaratorId :: Java.VariableDeclaratorId -> CT.Expr-writeVariableDeclaratorId (Java.VariableDeclaratorId id mdims) = noSep $ Y.catMaybes [-  Just $ writeIdentifier id,-  writeDims <$> mdims]--writeVariableInitializer :: Java.VariableInitializer -> CT.Expr-writeVariableInitializer i = case i of-  Java.VariableInitializerExpression e -> writeExpression e-  Java.VariableInitializerArrayInitializer ai -> writeArrayInitializer ai--writeVariableModifier :: Java.VariableModifier -> CT.Expr-writeVariableModifier m = case m of-  Java.VariableModifierAnnotation ann -> writeAnnotation ann-  Java.VariableModifierFinal -> cst "final"--writeWhileStatement :: Java.WhileStatement -> CT.Expr-writeWhileStatement _ = cst "TODO:WhileStatement"--writeWildcard :: Java.Wildcard -> CT.Expr-writeWildcard (Java.Wildcard anns mbounds) = spaceSep $ Y.catMaybes [-  if L.null anns then Nothing else Just $ commaSep inlineStyle (writeAnnotation <$> anns),-  Just $ cst "*",-  writeWildcardBounds <$> mbounds]--writeWildcardBounds :: Java.WildcardBounds -> CT.Expr-writeWildcardBounds b = case b of-  Java.WildcardBoundsExtends rt -> spaceSep [cst "extends", writeReferenceType rt]-  Java.WildcardBoundsSuper rt -> spaceSep [cst "super", writeReferenceType rt]--prefixAt :: CT.Expr -> CT.Expr-prefixAt e = noSep [cst "@", e]--semi :: CT.Expr-semi = cst ";"--suffixSemi :: CT.Expr -> CT.Expr-suffixSemi e = noSep [e, semi]
− src/main/haskell/Hydra/Ext/Java/Settings.hs 
@@ -1,4 +0,0 @@-module Hydra.Ext.Java.Settings where--listsAsArrays :: Bool-listsAsArrays = False
− src/main/haskell/Hydra/Ext/Java/Utils.hs 
@@ -1,556 +0,0 @@-module Hydra.Ext.Java.Utils where--import Hydra.Kernel-import Hydra.Ext.Java.Language-import Hydra.Ext.Java.Names-import qualified Hydra.Ext.Java.Syntax as Java-import qualified Hydra.Lib.Strings as Strings--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---type PackageMap = M.Map Namespace Java.PackageName--data Aliases = Aliases {-  aliasesCurrentNamespace :: Namespace,-  aliasesPackages :: PackageMap,-  aliasesRecursiveVars :: S.Set Name } deriving Show--addExpressions :: [Java.MultiplicativeExpression] -> Java.AdditiveExpression-addExpressions exprs = L.foldl add (Java.AdditiveExpressionUnary $ L.head exprs) $ L.tail exprs-  where-    add ae me = Java.AdditiveExpressionPlus $ Java.AdditiveExpression_Binary ae me--addJavaTypeParameter :: Java.ReferenceType -> Java.Type -> Flow (Graph) Java.Type-addJavaTypeParameter rt t = case t of-  Java.TypeReference rt1 -> case rt1 of-    Java.ReferenceTypeClassOrInterface cit -> case cit of-      Java.ClassOrInterfaceTypeClass (Java.ClassType anns qual id args) -> pure $-        Java.TypeReference $ Java.ReferenceTypeClassOrInterface $-          Java.ClassOrInterfaceTypeClass $ Java.ClassType anns qual id (args ++ [Java.TypeArgumentReference rt])-      _ -> fail $ "expected a Java class type. Found: " ++ show cit-    Java.ReferenceTypeVariable tv -> pure $ javaTypeVariableToType tv-    _ -> fail $ "expected a Java class or interface type, or a variable. Found: " ++ show rt-  _ -> fail $ "expected a reference type. Found: " ++ show t--fieldExpression :: Java.Identifier -> Java.Identifier -> Java.ExpressionName-fieldExpression varId fieldId = Java.ExpressionName (Just $ Java.AmbiguousName [varId]) fieldId--fieldNameToJavaExpression :: Name -> Java.Expression-fieldNameToJavaExpression fname = javaPostfixExpressionToJavaExpression $-  Java.PostfixExpressionName $ Java.ExpressionName Nothing (fieldNameToJavaIdentifier fname)--fieldNameToJavaIdentifier :: Name -> Java.Identifier-fieldNameToJavaIdentifier (Name name) = javaIdentifier name--fieldNameToJavaVariableDeclarator :: Name -> Java.VariableDeclarator-fieldNameToJavaVariableDeclarator (Name n) = javaVariableDeclarator (javaIdentifier n) Nothing--fieldNameToJavaVariableDeclaratorId :: Name -> Java.VariableDeclaratorId-fieldNameToJavaVariableDeclaratorId (Name n) = javaVariableDeclaratorId $ javaIdentifier n--importAliasesForModule :: Module -> Aliases-importAliasesForModule mod = Aliases (moduleNamespace mod) M.empty S.empty--interfaceMethodDeclaration :: [Java.InterfaceMethodModifier] -> [Java.TypeParameter] -> String -> [Java.FormalParameter]-   -> Java.Result -> Maybe [Java.BlockStatement] -> Java.InterfaceMemberDeclaration-interfaceMethodDeclaration mods tparams methodName params result stmts = Java.InterfaceMemberDeclarationInterfaceMethod $-    Java.InterfaceMethodDeclaration mods header body-  where-    header = javaMethodHeader tparams methodName params result-    body = javaMethodBody stmts--isEscaped :: String -> Bool-isEscaped s = L.head s == '$'--javaAdditiveExpressionToJavaExpression :: Java.AdditiveExpression -> Java.Expression-javaAdditiveExpressionToJavaExpression = javaRelationalExpressionToJavaExpression .-  Java.RelationalExpressionSimple . Java.ShiftExpressionUnary--javaAssignmentStatement :: Java.LeftHandSide -> Java.Expression -> Java.Statement-javaAssignmentStatement lhs rhs = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementExpression $-    Java.ExpressionStatement $ Java.StatementExpressionAssignment ass-  where-    ass = Java.Assignment lhs Java.AssignmentOperatorSimple rhs--javaBoolean :: Bool -> Java.Literal-javaBoolean = Java.LiteralBoolean--javaBooleanExpression :: Bool -> Java.Expression-javaBooleanExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaBoolean--javaBooleanType :: Java.Type-javaBooleanType = javaPrimitiveTypeToJavaType Java.PrimitiveTypeBoolean--javaCastExpression :: Java.ReferenceType -> Java.UnaryExpression -> Java.CastExpression-javaCastExpression rt expr = Java.CastExpressionNotPlusMinus $ Java.CastExpression_NotPlusMinus rb expr-  where-    rb = Java.CastExpression_RefAndBounds rt []--javaCastExpressionToJavaExpression :: Java.CastExpression -> Java.Expression-javaCastExpressionToJavaExpression = javaUnaryExpressionToJavaExpression . Java.UnaryExpressionOther .-  Java.UnaryExpressionNotPlusMinusCast--javaClassDeclaration :: Aliases -> [Java.TypeParameter] -> Name -> [Java.ClassModifier]-   -> Maybe Name -> [Java.InterfaceType] -> [Java.ClassBodyDeclarationWithComments] -> Java.ClassDeclaration-javaClassDeclaration aliases tparams elName mods supname impls bodyDecls = Java.ClassDeclarationNormal $ Java.NormalClassDeclaration {-  Java.normalClassDeclarationModifiers = mods,-  Java.normalClassDeclarationIdentifier = javaDeclName elName,-  Java.normalClassDeclarationParameters = tparams,-  Java.normalClassDeclarationExtends = fmap (\n -> nameToJavaClassType aliases True [] n Nothing) supname,-  Java.normalClassDeclarationImplements = impls,-  Java.normalClassDeclarationBody = Java.ClassBody bodyDecls}--javaClassType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.ClassType-javaClassType args pkg id = Java.ClassType [] qual (javaTypeIdentifier id) targs-  where-    qual = maybe Java.ClassTypeQualifierNone Java.ClassTypeQualifierPackage pkg-    targs = Java.TypeArgumentReference <$> args--javaClassTypeToJavaType :: Java.ClassType -> Java.Type-javaClassTypeToJavaType = Java.TypeReference . Java.ReferenceTypeClassOrInterface . Java.ClassOrInterfaceTypeClass--javaConditionalAndExpressionToJavaExpression :: Java.ConditionalAndExpression -> Java.Expression-javaConditionalAndExpressionToJavaExpression condAndEx = Java.ExpressionAssignment $-  Java.AssignmentExpressionConditional $ Java.ConditionalExpressionSimple $ Java.ConditionalOrExpression [condAndEx]--javaConstructorCall :: Java.ClassOrInterfaceTypeToInstantiate -> [Java.Expression] -> Maybe Java.ClassBody -> Java.Expression-javaConstructorCall ci args mbody = javaPrimaryToJavaExpression $-  Java.PrimaryNoNewArray $-  Java.PrimaryNoNewArrayClassInstance $-  Java.ClassInstanceCreationExpression Nothing $-  Java.UnqualifiedClassInstanceCreationExpression [] ci args mbody--javaConstructorName :: Java.Identifier -> Maybe Java.TypeArgumentsOrDiamond -> Java.ClassOrInterfaceTypeToInstantiate-javaConstructorName id targs = Java.ClassOrInterfaceTypeToInstantiate [Java.AnnotatedIdentifier [] id] targs--javaDeclName :: Name -> Java.TypeIdentifier-javaDeclName = Java.TypeIdentifier . javaVariableName--javaEmptyStatement :: Java.Statement-javaEmptyStatement = Java.StatementWithoutTrailing $ Java.StatementWithoutTrailingSubstatementEmpty Java.EmptyStatement--javaEqualityExpressionToJavaExpression :: Java.EqualityExpression -> Java.Expression-javaEqualityExpressionToJavaExpression eqEx = javaConditionalAndExpressionToJavaExpression $-    Java.ConditionalAndExpression [javaEqualityExpressionToJavaInclusiveOrExpression eqEx]--javaEqualityExpressionToJavaInclusiveOrExpression :: Java.EqualityExpression -> Java.InclusiveOrExpression-javaEqualityExpressionToJavaInclusiveOrExpression eq = Java.InclusiveOrExpression [-  Java.ExclusiveOrExpression [Java.AndExpression [eq]]]--javaEquals :: Java.EqualityExpression -> Java.RelationalExpression -> Java.EqualityExpression-javaEquals lhs rhs = Java.EqualityExpressionEqual $ Java.EqualityExpression_Binary lhs rhs--javaEqualsNull :: Java.EqualityExpression -> Java.EqualityExpression-javaEqualsNull lhs = javaEquals lhs $ javaLiteralToJavaRelationalExpression Java.LiteralNull--javaExpressionNameToJavaExpression :: Java.ExpressionName -> Java.Expression-javaExpressionNameToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionName--javaExpressionToJavaPrimary :: Java.Expression -> Java.Primary-javaExpressionToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayParens--javaExpressionToJavaUnaryExpression :: Java.Expression -> Java.UnaryExpression-javaExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression . javaExpressionToJavaPrimary--javaFieldAccessToJavaExpression :: Java.FieldAccess -> Java.Expression-javaFieldAccessToJavaExpression = javaPrimaryToJavaExpression . Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayFieldAccess--javaIdentifier :: String -> Java.Identifier-javaIdentifier = Java.Identifier . sanitizeJavaName--javaIdentifierToJavaExpressionName :: Java.Identifier -> Java.ExpressionName-javaIdentifierToJavaExpressionName id = Java.ExpressionName Nothing id--javaIdentifierToJavaExpression :: Java.Identifier -> Java.Expression-javaIdentifierToJavaExpression = javaUnaryExpressionToJavaExpression . javaIdentifierToJavaUnaryExpression--javaIdentifierToJavaRelationalExpression :: Java.Identifier -> Java.RelationalExpression-javaIdentifierToJavaRelationalExpression id = javaPostfixExpressionToJavaRelationalExpression $-  Java.PostfixExpressionName $ Java.ExpressionName Nothing id--javaIdentifierToJavaUnaryExpression :: Java.Identifier -> Java.UnaryExpression-javaIdentifierToJavaUnaryExpression = javaRelationalExpressionToJavaUnaryExpression . javaIdentifierToJavaRelationalExpression--javaInstanceOf :: Java.RelationalExpression -> Java.ReferenceType -> Java.RelationalExpression-javaInstanceOf lhs rhs = Java.RelationalExpressionInstanceof $ Java.RelationalExpression_InstanceOf lhs rhs--javaInt :: Integral a => a -> Java.Literal-javaInt i = Java.LiteralInteger $ Java.IntegerLiteral $ fromIntegral i--javaIntExpression :: Integer -> Java.Expression-javaIntExpression = javaPrimaryToJavaExpression . javaLiteralToJavaPrimary . javaInt--javaIntType :: Java.Type-javaIntType = javaPrimitiveTypeToJavaType $ Java.PrimitiveTypeNumeric $ Java.NumericTypeIntegral Java.IntegralTypeInt--javaInterfaceDeclarationToJavaClassBodyDeclaration :: Java.NormalInterfaceDeclaration -> Java.ClassBodyDeclaration-javaInterfaceDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember .-  Java.ClassMemberDeclarationInterface . Java.InterfaceDeclarationNormalInterface--javaLambda :: Name -> Java.Expression -> Java.Expression-javaLambda var jbody = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyExpression jbody)-  where-    params = Java.LambdaParametersSingle $ variableToJavaIdentifier var--javaLambdaFromBlock :: Name -> Java.Block -> Java.Expression-javaLambdaFromBlock var block = Java.ExpressionLambda $ Java.LambdaExpression params (Java.LambdaBodyBlock block)-  where-    params = Java.LambdaParametersSingle $ variableToJavaIdentifier var--javaLiteralToJavaRelationalExpression :: Java.Literal -> Java.RelationalExpression-javaLiteralToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression .-  javaLiteralToJavaMultiplicativeExpression--javaLiteralToJavaExpression = javaRelationalExpressionToJavaExpression .-  javaMultiplicativeExpressionToJavaRelationalExpression .-  javaLiteralToJavaMultiplicativeExpression--javaLiteralToJavaMultiplicativeExpression = Java.MultiplicativeExpressionUnary . javaPrimaryToJavaUnaryExpression .-  javaLiteralToJavaPrimary--javaLiteralToJavaPrimary :: Java.Literal -> Java.Primary-javaLiteralToJavaPrimary = Java.PrimaryNoNewArray . Java.PrimaryNoNewArrayLiteral--javaMemberField :: [Java.FieldModifier] -> Java.Type -> Java.VariableDeclarator -> Java.ClassBodyDeclaration-javaMemberField mods jt var = Java.ClassBodyDeclarationClassMember $ Java.ClassMemberDeclarationField $-  Java.FieldDeclaration mods (Java.UnannType jt) [var]--javaMethodBody :: Maybe [Java.BlockStatement] -> Java.MethodBody-javaMethodBody stmts = Y.maybe Java.MethodBodyNone (Java.MethodBodyBlock . Java.Block) stmts--javaMethodDeclarationToJavaClassBodyDeclaration :: Java.MethodDeclaration -> Java.ClassBodyDeclaration-javaMethodDeclarationToJavaClassBodyDeclaration = Java.ClassBodyDeclarationClassMember . Java.ClassMemberDeclarationMethod--javaMethodHeader :: [Java.TypeParameter] -> String -> [Java.FormalParameter] -> Java.Result -> Java.MethodHeader-javaMethodHeader tparams methodName params result = Java.MethodHeader tparams result decl mthrows-  where-    decl = Java.MethodDeclarator (Java.Identifier methodName) Nothing params-    mthrows = Nothing--javaMethodInvocationToJavaExpression :: Java.MethodInvocation -> Java.Expression-javaMethodInvocationToJavaExpression = javaPrimaryToJavaExpression . javaMethodInvocationToJavaPrimary--javaMethodInvocationToJavaStatement :: Java.MethodInvocation -> Java.Statement-javaMethodInvocationToJavaStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementExpression .-  Java.ExpressionStatement . Java.StatementExpressionMethodInvocation--javaMethodInvocationToJavaPostfixExpression :: Java.MethodInvocation -> Java.PostfixExpression-javaMethodInvocationToJavaPostfixExpression = Java.PostfixExpressionPrimary . Java.PrimaryNoNewArray .-  Java.PrimaryNoNewArrayMethodInvocation--javaMethodInvocationToJavaPrimary :: Java.MethodInvocation -> Java.Primary-javaMethodInvocationToJavaPrimary = Java.PrimaryNoNewArray .-  Java.PrimaryNoNewArrayMethodInvocation--javaMultiplicativeExpressionToJavaRelationalExpression :: Java.MultiplicativeExpression -> Java.RelationalExpression-javaMultiplicativeExpressionToJavaRelationalExpression = Java.RelationalExpressionSimple .-  Java.ShiftExpressionUnary . Java.AdditiveExpressionUnary--javaPackageDeclaration :: Namespace -> Java.PackageDeclaration-javaPackageDeclaration (Namespace name) = Java.PackageDeclaration [] (Java.Identifier <$> Strings.splitOn "/" name)--javaPostfixExpressionToJavaEqualityExpression :: Java.PostfixExpression -> Java.EqualityExpression-javaPostfixExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary .-  javaUnaryExpressionToJavaRelationalExpression . Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix--javaPostfixExpressionToJavaExpression :: Java.PostfixExpression -> Java.Expression-javaPostfixExpressionToJavaExpression = javaRelationalExpressionToJavaExpression .-  javaPostfixExpressionToJavaRelationalExpression--javaPostfixExpressionToJavaInclusiveOrExpression :: Java.PostfixExpression -> Java.InclusiveOrExpression-javaPostfixExpressionToJavaInclusiveOrExpression = javaEqualityExpressionToJavaInclusiveOrExpression .-  javaPostfixExpressionToJavaEqualityExpression--javaPostfixExpressionToJavaRelationalExpression :: Java.PostfixExpression -> Java.RelationalExpression-javaPostfixExpressionToJavaRelationalExpression =-  javaUnaryExpressionToJavaRelationalExpression . javaPostfixExpressionToJavaUnaryExpression--javaPostfixExpressionToJavaUnaryExpression :: Java.PostfixExpression -> Java.UnaryExpression-javaPostfixExpressionToJavaUnaryExpression = Java.UnaryExpressionOther . Java.UnaryExpressionNotPlusMinusPostfix--javaPrimaryToJavaExpression :: Java.Primary -> Java.Expression-javaPrimaryToJavaExpression = javaPostfixExpressionToJavaExpression . Java.PostfixExpressionPrimary--javaPrimaryToJavaUnaryExpression :: Java.Primary -> Java.UnaryExpression-javaPrimaryToJavaUnaryExpression = Java.UnaryExpressionOther .-  Java.UnaryExpressionNotPlusMinusPostfix .-  Java.PostfixExpressionPrimary--javaPrimitiveTypeToJavaType :: Java.PrimitiveType -> Java.Type-javaPrimitiveTypeToJavaType pt = Java.TypePrimitive $ Java.PrimitiveTypeWithAnnotations pt []--javaRefType :: [Java.ReferenceType] -> Maybe Java.PackageName -> String -> Java.Type-javaRefType args pkg id = Java.TypeReference $ Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $-  javaClassType args pkg id--javaRelationalExpressionToJavaEqualityExpression :: Java.RelationalExpression -> Java.EqualityExpression-javaRelationalExpressionToJavaEqualityExpression = Java.EqualityExpressionUnary--javaRelationalExpressionToJavaExpression :: Java.RelationalExpression -> Java.Expression-javaRelationalExpressionToJavaExpression = javaEqualityExpressionToJavaExpression . javaRelationalExpressionToJavaEqualityExpression--javaRelationalExpressionToJavaUnaryExpression :: Java.RelationalExpression -> Java.UnaryExpression-javaRelationalExpressionToJavaUnaryExpression = javaPrimaryToJavaUnaryExpression .-  Java.PrimaryNoNewArray .-  Java.PrimaryNoNewArrayParens .-  javaRelationalExpressionToJavaExpression--javaReturnStatement :: Y.Maybe Java.Expression -> Java.Statement-javaReturnStatement = Java.StatementWithoutTrailing . Java.StatementWithoutTrailingSubstatementReturn .-  Java.ReturnStatement--javaStatementsToBlock :: [Java.Statement] -> Java.Block-javaStatementsToBlock stmts = Java.Block (Java.BlockStatementStatement <$> stmts)--javaString :: String -> Java.Literal-javaString = Java.LiteralString . Java.StringLiteral--javaStringMultiplicativeExpression :: String -> Java.MultiplicativeExpression-javaStringMultiplicativeExpression = javaLiteralToJavaMultiplicativeExpression . javaString--javaThrowIllegalArgumentException :: [Java.Expression] -> Java.Statement-javaThrowIllegalArgumentException args = javaThrowStatement $-  javaConstructorCall (javaConstructorName (Java.Identifier "IllegalArgumentException") Nothing) args Nothing--javaThrowIllegalStateException :: [Java.Expression] -> Java.Statement-javaThrowIllegalStateException args = javaThrowStatement $-  javaConstructorCall (javaConstructorName (Java.Identifier "IllegalStateException") Nothing) args Nothing--javaThrowStatement :: Java.Expression -> Java.Statement-javaThrowStatement = Java.StatementWithoutTrailing .-  Java.StatementWithoutTrailingSubstatementThrow . Java.ThrowStatement--javaThis :: Java.Expression-javaThis = javaPrimaryToJavaExpression $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis--javaTypeFromTypeName :: Aliases -> Name -> Java.Type-javaTypeFromTypeName aliases elName = javaTypeVariableToType $ Java.TypeVariable [] $-  nameToJavaTypeIdentifier aliases False elName--javaTypeIdentifier :: String -> Java.TypeIdentifier-javaTypeIdentifier = Java.TypeIdentifier . Java.Identifier--javaTypeIdentifierToJavaTypeArgument :: Java.TypeIdentifier -> Java.TypeArgument-javaTypeIdentifierToJavaTypeArgument id = Java.TypeArgumentReference $ Java.ReferenceTypeVariable $ Java.TypeVariable [] id--javaTypeName :: Java.Identifier -> Java.TypeName-javaTypeName id = Java.TypeName (Java.TypeIdentifier id) Nothing--javaTypeParameter :: String -> Java.TypeParameter-javaTypeParameter v = Java.TypeParameter [] (javaTypeIdentifier v) Nothing--javaTypeToJavaFormalParameter :: Java.Type -> Name -> Java.FormalParameter-javaTypeToJavaFormalParameter jt fname = Java.FormalParameterSimple $ Java.FormalParameter_Simple [] argType argId-  where-    argType = Java.UnannType jt-    argId = fieldNameToJavaVariableDeclaratorId fname--javaTypeToJavaReferenceType :: Java.Type -> Flow (Graph) Java.ReferenceType-javaTypeToJavaReferenceType t = case t of-  Java.TypeReference rt -> pure rt-  _ -> fail $ "expected a Java reference type. Found: " ++ show t--javaTypeToJavaResult :: Java.Type -> Java.Result-javaTypeToJavaResult = Java.ResultType . Java.UnannType--javaTypeToJavaTypeArgument :: Java.Type -> Java.TypeArgument-javaTypeToJavaTypeArgument t = case t of-  Java.TypeReference rt -> Java.TypeArgumentReference rt-  _ -> Java.TypeArgumentWildcard $ Java.Wildcard [] Nothing -- TODO--javaTypeVariable :: String -> Java.ReferenceType-javaTypeVariable v = Java.ReferenceTypeVariable $ Java.TypeVariable [] $ javaTypeIdentifier $ capitalize v--javaTypeVariableToType :: Java.TypeVariable -> Java.Type-javaTypeVariableToType = Java.TypeReference . Java.ReferenceTypeVariable--javaUnaryExpressionToJavaExpression :: Java.UnaryExpression -> Java.Expression-javaUnaryExpressionToJavaExpression = javaRelationalExpressionToJavaExpression .-  javaUnaryExpressionToJavaRelationalExpression--javaUnaryExpressionToJavaRelationalExpression :: Java.UnaryExpression -> Java.RelationalExpression-javaUnaryExpressionToJavaRelationalExpression = javaMultiplicativeExpressionToJavaRelationalExpression .-  Java.MultiplicativeExpressionUnary--javaVariableDeclarator :: Java.Identifier -> Y.Maybe Java.VariableInitializer -> Java.VariableDeclarator-javaVariableDeclarator id = Java.VariableDeclarator (javaVariableDeclaratorId id)--javaVariableDeclaratorId :: Java.Identifier -> Java.VariableDeclaratorId-javaVariableDeclaratorId id = Java.VariableDeclaratorId id Nothing--javaVariableName :: Name -> Java.Identifier-javaVariableName = javaIdentifier . localNameOfEager--makeConstructor :: Aliases -> Name -> Bool -> [Java.FormalParameter]-  -> [Java.BlockStatement] -> Java.ClassBodyDeclaration-makeConstructor aliases elName private params stmts = Java.ClassBodyDeclarationConstructorDeclaration $-    Java.ConstructorDeclaration mods cons Nothing body-  where-    nm = Java.SimpleTypeName $ nameToJavaTypeIdentifier aliases False elName-    cons = Java.ConstructorDeclarator [] nm Nothing params-    mods = [if private then Java.ConstructorModifierPrivate else Java.ConstructorModifierPublic]-    body = Java.ConstructorBody Nothing stmts--methodDeclaration :: [Java.MethodModifier] -> [Java.TypeParameter] -> [Java.Annotation] -> String-  -> [Java.FormalParameter] -> Java.Result -> Maybe [Java.BlockStatement] -> Java.ClassBodyDeclaration-methodDeclaration mods tparams anns methodName params result stmts =-    javaMethodDeclarationToJavaClassBodyDeclaration $-    Java.MethodDeclaration anns mods header body-  where-    header = javaMethodHeader tparams methodName params result-    body = javaMethodBody stmts--methodInvocation :: Y.Maybe (Either Java.ExpressionName Java.Primary) -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation-methodInvocation lhs methodName = Java.MethodInvocation header-  where-    header = case lhs of-      Nothing -> Java.MethodInvocation_HeaderSimple $ Java.MethodName methodName-      Just either -> Java.MethodInvocation_HeaderComplex $ Java.MethodInvocation_Complex variant targs methodName-        where-          targs = []-          variant = case either of-            Left name -> Java.MethodInvocation_VariantExpression name-            Right prim -> Java.MethodInvocation_VariantPrimary prim--methodInvocationStatic :: Java.Identifier -> Java.Identifier -> [Java.Expression] -> Java.MethodInvocation-methodInvocationStatic self methodName = methodInvocation (Just $ Left name) methodName-  where-    name = Java.ExpressionName Nothing self--nameToJavaClassType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ClassType-nameToJavaClassType aliases qualify args name mlocal = Java.ClassType [] pkg id args-  where-    (id, pkg) = nameToQualifiedJavaName aliases qualify name mlocal--nameToQualifiedJavaName :: Aliases -> Bool -> Name -> Maybe String -> (Java.TypeIdentifier, Java.ClassTypeQualifier)-nameToQualifiedJavaName aliases qualify name mlocal = (jid, pkg)-  where-    QualifiedName ns local = qualifyNameEager name-    alias = case ns of-      Nothing -> Nothing-      Just n -> case M.lookup n (aliasesPackages aliases) of-          Nothing -> Just $ javaPackageName $ Strings.splitOn "/" $ unNamespace n-          Just id -> Just id-    pkg = if qualify-      then Y.maybe none Java.ClassTypeQualifierPackage alias-      else none-    none = Java.ClassTypeQualifierNone-    jid = javaTypeIdentifier $ case mlocal of-      Nothing -> sanitizeJavaName local-      Just l -> sanitizeJavaName local ++ "." ++ sanitizeJavaName l--nameToJavaName :: Aliases -> Name -> Java.Identifier-nameToJavaName aliases name = Java.Identifier $ if isEscaped (unName name)-    then sanitizeJavaName local-    else case ns of-      Nothing -> local-      Just gname -> case M.lookup gname (aliasesPackages aliases) of-        Nothing -> fromParts $ Strings.splitOn "/" $ unNamespace gname-        Just (Java.PackageName parts) -> fromParts (Java.unIdentifier <$> parts)-  where-    QualifiedName ns local = qualifyNameEager name-    fromParts parts = L.intercalate "." $ parts ++ [sanitizeJavaName local]--nameToJavaReferenceType :: Aliases -> Bool -> [Java.TypeArgument] -> Name -> Maybe String -> Java.ReferenceType-nameToJavaReferenceType aliases qualify args name mlocal = Java.ReferenceTypeClassOrInterface $ Java.ClassOrInterfaceTypeClass $-  nameToJavaClassType aliases qualify args name mlocal--nameToJavaTypeIdentifier :: Aliases -> Bool -> Name -> Java.TypeIdentifier-nameToJavaTypeIdentifier aliases qualify name = fst $ nameToQualifiedJavaName aliases qualify name Nothing--overrideAnnotation :: Java.Annotation-overrideAnnotation = Java.AnnotationMarker $ Java.MarkerAnnotation $ javaTypeName $ Java.Identifier "Override"--referenceTypeToResult :: Java.ReferenceType -> Java.Result-referenceTypeToResult = javaTypeToJavaResult . Java.TypeReference--sanitizeJavaName :: String -> String-sanitizeJavaName name = if isEscaped name-  -- The '$' prefix allows names to be excluded from sanitization-  then unescape name-  else sanitizeWithUnderscores reservedWords name--toAcceptMethod :: Bool -> [Java.TypeParameter] -> Java.ClassBodyDeclaration-toAcceptMethod abstract vtparams = methodDeclaration mods tparams anns acceptMethodName [param] result body-  where-    mods = [Java.MethodModifierPublic] ++ if abstract then [Java.MethodModifierAbstract] else []-    tparams = [javaTypeParameter visitorReturnParameter]-    anns = if abstract-      then []-      else [overrideAnnotation]-    param = javaTypeToJavaFormalParameter ref (Name varName)-      where-        ref = javaClassTypeToJavaType $-          Java.ClassType-            []-            Java.ClassTypeQualifierNone-            (javaTypeIdentifier visitorName)-            (typeArgs ++ [Java.TypeArgumentReference visitorTypeVariable])-    typeArgs = (Java.TypeArgumentReference . typeParameterToReferenceType) <$> vtparams-    result = javaTypeToJavaResult $ Java.TypeReference visitorTypeVariable-    varName = "visitor"-    body = if abstract-      then Nothing-      else Just [Java.BlockStatementStatement $ javaReturnStatement $ Just returnExpr]-    returnExpr = javaMethodInvocationToJavaExpression $-        methodInvocationStatic (Java.Identifier varName) (Java.Identifier visitMethodName) [javaThis]--toAssignStmt :: Name -> Java.Statement-toAssignStmt fname = javaAssignmentStatement lhs rhs-  where-    lhs = Java.LeftHandSideFieldAccess $ thisField id-      where-        id = fieldNameToJavaIdentifier fname-    rhs = fieldNameToJavaExpression fname-    thisField = Java.FieldAccess $ Java.FieldAccess_QualifierPrimary $ Java.PrimaryNoNewArray Java.PrimaryNoNewArrayThis--toJavaArrayType :: Java.Type -> Flow (Graph) Java.Type-toJavaArrayType t = Java.TypeReference . Java.ReferenceTypeArray <$> case t of-  Java.TypeReference rt -> case rt of-    Java.ReferenceTypeClassOrInterface cit -> pure $-      Java.ArrayType (Java.Dims [[]]) $ Java.ArrayType_VariantClassOrInterface cit-    Java.ReferenceTypeArray (Java.ArrayType (Java.Dims d) v) -> pure $-      Java.ArrayType (Java.Dims $ d ++ [[]]) v-    _ -> fail $ "don't know how to make Java reference type into array type: " ++ show rt-  _ -> fail $ "don't know how to make Java type into array type: " ++ show t--typeParameterToTypeArgument :: Java.TypeParameter -> Java.TypeArgument-typeParameterToTypeArgument (Java.TypeParameter _ id _) = javaTypeIdentifierToJavaTypeArgument id--typeParameterToReferenceType :: Java.TypeParameter -> Java.ReferenceType-typeParameterToReferenceType = javaTypeVariable . unTypeParameter--unTypeParameter :: Java.TypeParameter -> String-unTypeParameter (Java.TypeParameter [] (Java.TypeIdentifier (Java.Identifier v)) Nothing) = v--unescape :: String -> String-unescape = L.tail--variableDeclarationStatement :: Aliases -> Java.Type -> Java.Identifier -> Java.Expression -> Java.BlockStatement-variableDeclarationStatement aliases jtype id rhs = Java.BlockStatementLocalVariableDeclaration $-    Java.LocalVariableDeclarationStatement $ Java.LocalVariableDeclaration [] (Java.LocalVariableTypeType $ Java.UnannType jtype) [vdec]-  where-    vdec = javaVariableDeclarator id (Just init)-      where-        init = Java.VariableInitializerExpression rhs--variableToJavaIdentifier :: Name -> Java.Identifier-variableToJavaIdentifier (Name var) = Java.Identifier $ if var == ignoredVariable-  then "ignored"-  else var -- TODO: escape--variantClassName :: Bool -> Name -> Name -> Name-variantClassName qualify elName (Name fname) = unqualifyName (QualifiedName ns local1)-  where-    QualifiedName ns local = qualifyNameEager elName-    flocal = capitalize fname-    local1 = if qualify-      then local ++ "." ++ flocal-      else if flocal == local then flocal ++ "_" else flocal--visitorTypeVariable :: Java.ReferenceType-visitorTypeVariable = javaTypeVariable "r"
− src/main/haskell/Hydra/Ext/Json/Coder.hs 
@@ -1,211 +0,0 @@-module Hydra.Ext.Json.Coder (jsonCoder, literalJsonCoder, untypedTermToJson) where--import Hydra.Core-import Hydra.Compute-import Hydra.Graph-import Hydra.Strip-import Hydra.Basics-import Hydra.CoreEncoding-import Hydra.Tier1-import Hydra.Tier2-import Hydra.Adapters-import Hydra.TermAdapters-import Hydra.Ext.Json.Language-import Hydra.Lib.Literals-import Hydra.AdapterUtils-import qualified Hydra.Json as Json-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---jsonCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value)-jsonCoder typ = do-  adapter <- languageAdapter jsonLanguage typ-  coder <- termCoder $ adapterTarget adapter-  return $ composeCoders (adapterCoder adapter) coder--literalJsonCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal Json.Value)-literalJsonCoder at = pure $ case at of-  LiteralTypeBoolean -> Coder {-    coderEncode = \(LiteralBoolean b) -> pure $ Json.ValueBoolean b,-    coderDecode = \s -> case s of-      Json.ValueBoolean b -> pure $ LiteralBoolean b-      _ -> unexpected "boolean" $ show s}-  LiteralTypeFloat _ -> Coder {-    coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ Json.ValueNumber f,-    coderDecode = \s -> case s of-      Json.ValueNumber f -> pure $ LiteralFloat $ FloatValueBigfloat f-      _ -> unexpected "number" $ show s}-  LiteralTypeInteger _ -> Coder {-    coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ Json.ValueNumber $ bigintToBigfloat i,-    coderDecode = \s -> case s of-      Json.ValueNumber f -> pure $ LiteralInteger $ IntegerValueBigint $ bigfloatToBigint f-      _ -> unexpected "number" $ show s}-  LiteralTypeString -> Coder {-    coderEncode = \(LiteralString s) -> pure $ Json.ValueString s,-    coderDecode = \s -> case s of-      Json.ValueString s' -> pure $ LiteralString s'-      _ -> unexpected "string" $ show s}--recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term Json.Value)-recordCoder rt = do-    coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt)-    return $ Coder (encode coders) (decode coders)-  where-    encode coders term = case stripTerm term of-      TermRecord (Record _ fields) -> Json.ValueObject . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields-        where-          encodeField (ft, coder) (Field fname fv) = case (fieldTypeType ft, fv) of-            (TypeOptional _, TermOptional Nothing) -> pure Nothing-            _ -> Just <$> ((,) <$> pure (unName fname) <*> coderEncode coder fv)-      _ -> unexpected "record" $ show term-    decode coders n = case n of-      Json.ValueObject m -> Terms.record (rowTypeTypeName rt) <$> CM.mapM (decodeField m) coders -- Note: unknown fields are ignored-        where-          decodeField a (FieldType fname _, coder) = do-            v <- coderDecode coder $ Y.fromMaybe Json.ValueNull $ M.lookup (unName fname) m-            return $ Field fname v-      _ -> unexpected "mapping" $ show n-    getCoder coders fname = Y.maybe error pure $ M.lookup fname coders-      where-        error = fail $ "no such field: " ++ fname--termCoder :: Type -> Flow Graph (Coder Graph Graph Term Json.Value)-termCoder typ = case stripType typ of-  TypeLiteral at -> do-    ac <- literalJsonCoder at-    return Coder {-      coderEncode = \(TermLiteral av) -> coderEncode ac av,-      coderDecode = \n -> case n of-        s -> Terms.literal <$> coderDecode ac s}-  TypeList lt -> do-    lc <- termCoder lt-    return Coder {-      coderEncode = \(TermList els) -> Json.ValueArray <$> CM.mapM (coderEncode lc) els,-      coderDecode = \n -> case n of-        Json.ValueArray nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes-        _ -> unexpected "sequence" $ show n}-  TypeOptional ot -> do-    oc <- termCoder ot-    return Coder {-      coderEncode = \t -> case fullyStripTerm t of-        TermOptional el -> Y.maybe (pure Json.ValueNull) (coderEncode oc) el-        _ -> unexpected "optional term" $ show t,-      coderDecode = \n -> case n of-        Json.ValueNull -> pure $ Terms.optional Nothing-        _ -> Terms.optional . Just <$> coderDecode oc n}-  TypeMap (MapType kt vt) -> do-      kc <- termCoder kt-      vc <- termCoder vt-      cx <- getState-      let encodeEntry (k, v) = (,) (toString cx k) <$> coderEncode vc v-      let decodeEntry (k, v) = (,) (fromString cx k) <$> coderDecode vc v-      return Coder {-        coderEncode = \(TermMap m) -> Json.ValueObject . M.fromList <$> CM.mapM encodeEntry (M.toList m),-        coderDecode = \n -> case n of-          Json.ValueObject m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m)-          _ -> unexpected "mapping" $ show n}-    where-      toString cx v = if isStringKey cx-        then case stripTerm v of-          TermLiteral (LiteralString s) -> s-        else show v-      fromString cx s = Terms.string $ if isStringKey cx then s else read s-      isStringKey cx = stripType kt == Types.string-  TypeRecord rt -> recordCoder rt-  TypeVariable name -> return $ Coder encode decode-    where-      encode term = pure $ Json.ValueString $ "variable '" ++ unName name ++ "' for: " ++ show term-      decode term = fail $ "type variable " ++ unName name ++ " does not support decoding"-  _ -> fail $ "unsupported type in JSON: " ++ show (typeVariant typ)---- | A simplistic, unidirectional encoding for terms as JSON values. Not type-aware; best used for human consumption.-untypedTermToJson :: Term -> Flow s Json.Value-untypedTermToJson term = case term of-    TermAnnotated (AnnotatedTerm term1 ann) -> do-        json <- untypedTermToJson term1-        pairs <- CM.mapM encodePair $ M.toList ann-        return $ Json.ValueObject $ M.fromList $ [-          ("term", json),-          ("annotations", Json.ValueObject $ M.fromList pairs)]-      where-        encodePair (Name k, v) = do-          json <- untypedTermToJson v-          return (k, json)-    TermApplication (Application lhs rhs) -> asRecord [-      Field _Application_function lhs,-      Field _Application_argument rhs]-    TermFunction f -> case f of-      FunctionElimination elm -> case elm of-        EliminationList term1 -> asVariant "fold" term1-        EliminationRecord (Projection _ fname) -> asVariant "project" $ TermVariable fname-        _ -> unexp $ "unexpected elimination variant: " ++ show (eliminationVariant elm)-      FunctionLambda (Lambda v d body) -> asRecord [-        Field _Lambda_parameter $ TermVariable v,-        Field _Lambda_domain $ TermOptional (coreEncodeType <$> d),-        Field _Lambda_body body]-      FunctionPrimitive name -> pure $ Json.ValueString $ unName name-    TermLet (Let bindings env) -> asRecord [-        Field _Let_bindings $ TermRecord $ Record (Name "") (fromBinding <$> bindings),-        Field _Let_environment env]-      where-        fromBinding (LetBinding k v _) = Field k v-    TermList terms -> Json.ValueArray <$> (CM.mapM untypedTermToJson terms)-    TermLiteral lit -> pure $ case lit of-      LiteralBinary s -> Json.ValueString s-      LiteralBoolean b -> Json.ValueBoolean b-      LiteralFloat f -> Json.ValueNumber $ floatValueToBigfloat f-      LiteralInteger i -> Json.ValueNumber $ bigintToBigfloat $ integerValueToBigint i-      LiteralString s -> Json.ValueString s-    TermOptional mt -> case mt of-      Nothing -> pure Json.ValueNull-      Just t -> untypedTermToJson t-    TermProduct els -> untypedTermToJson $ TermList els-    TermRecord (Record _ fields) -> do-      keyvals <- CM.mapM fieldToKeyval fields-      return $ Json.ValueObject $ M.fromList $ Y.catMaybes keyvals-    TermSet vals -> untypedTermToJson $ TermList $ S.toList vals-    TermSum (Sum idx size term1) -> asRecord [-      Field _Sum_index $ TermLiteral $ LiteralInteger $ IntegerValueInt32 idx,-      Field _Sum_size $ TermLiteral $ LiteralInteger $ IntegerValueInt32 size,-      Field _Sum_term term1]-    TermTypeAbstraction (TypeAbstraction v term) -> asRecord [-      Field _TypeAbstraction_parameter $ TermVariable v,-      Field _TypeAbstraction_body term]-    TermTypeApplication (TypedTerm term1 typ) -> asRecord [ -- Note: TermTypeApplication and TermTyped appear identical-      Field _TypedTerm_term term1,-      Field _TypedTerm_type $ coreEncodeType typ]-    TermTyped (TypedTerm term1 typ) -> asRecord [-      Field _TypedTerm_term term1,-      Field _TypedTerm_type $ coreEncodeType typ]-    TermUnion (Injection _ field) -> if fieldTerm field == Terms.unit-      then return $ Json.ValueString $ unName $ fieldName field-      else do-        mkeyval <- fieldToKeyval field-        return $ Json.ValueObject $ M.fromList $ case mkeyval of-          Nothing -> []-          Just keyval -> [keyval]-    TermVariable v -> pure $ Json.ValueString $ unName v-    TermWrap (WrappedTerm _ t) -> untypedTermToJson t-    t -> unexp $ "unsupported term variant: " ++ show (termVariant t)---     t -> fail $ "unexpected term variant: " ++ show (termVariant t)-  where-    unexp msg = pure $ Json.ValueString $ "FAIL: " ++ msg-    asRecord = untypedTermToJson . TermRecord . Record (Name "")-    asVariant name term = untypedTermToJson $ TermUnion $ Injection (Name "") $ Field (Name name) term-    fieldToKeyval f = do-        mjson <- forTerm $ fieldTerm f-        return $ case mjson of-          Nothing -> Nothing-          Just j -> Just (unName $ fieldName f, j)-      where-        forTerm t = case t of-          TermOptional mt -> case mt of-            Nothing -> pure Nothing-            Just t' -> forTerm t'-          t' -> Just <$> untypedTermToJson t'
− src/main/haskell/Hydra/Ext/Json/Eliminate.hs 
@@ -1,54 +0,0 @@-module Hydra.Ext.Json.Eliminate where--import Hydra.Kernel-import qualified Hydra.Json as Json--import qualified Data.Map as M---expectArray :: Json.Value -> Flow s [Json.Value]-expectArray value = case value of-  Json.ValueArray els -> pure els-  _ -> unexpected "JSON array" $ show value--expectNumber :: Json.Value -> Flow s Double-expectNumber value = case value of-  Json.ValueNumber d -> pure d-  _ -> unexpected "JSON number" $ show value--expectObject :: Json.Value -> Flow s (M.Map String Json.Value)-expectObject value = case value of-  Json.ValueObject m -> pure m-  _ -> unexpected "JSON object" $ show value--expectString :: Json.Value -> Flow s String-expectString value = case value of-  Json.ValueString s -> pure s-  _ -> unexpected "JSON string" $ show value--opt :: String -> M.Map String Json.Value -> Maybe Json.Value-opt = M.lookup--optArray :: String -> M.Map String Json.Value -> Flow s (Maybe [Json.Value])-optArray fname m = case opt fname m of-  Nothing -> pure Nothing-  Just a -> Just <$> expectArray a--optString :: String -> M.Map String Json.Value -> Flow s (Maybe String)-optString fname m = case opt fname m of-  Nothing -> pure Nothing-  Just s -> Just <$> expectString s--require :: String -> M.Map String Json.Value -> Flow s Json.Value-require fname m = case M.lookup fname m of-  Nothing -> fail $ "required attribute " ++ show fname ++ " not found"-  Just value -> pure value--requireArray :: String -> M.Map String Json.Value -> Flow s [Json.Value]-requireArray fname m = require fname m >>= expectArray--requireNumber :: String -> M.Map String Json.Value -> Flow s Double-requireNumber fname m = require fname m >>= expectNumber--requireString :: String -> M.Map String Json.Value -> Flow s String-requireString fname m = require fname m >>= expectString
− src/main/haskell/Hydra/Ext/Json/Language.hs 
@@ -1,33 +0,0 @@-module Hydra.Ext.Json.Language where--import Hydra.Core-import Hydra.Coders-import Hydra.Strip-import Hydra.Mantle--import qualified Data.Set as S---jsonLanguage :: Language-jsonLanguage = Language (LanguageName "hydra/ext/json") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],-  languageConstraintsTermVariants = S.fromList [-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantOptional,-    TermVariantRecord],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantOptional,-    TypeVariantRecord],-  languageConstraintsTypes = \typ -> case stripType typ of-    TypeOptional (TypeOptional _) -> False-    _ -> True }
− src/main/haskell/Hydra/Ext/Json/Serde.hs 
@@ -1,79 +0,0 @@-module Hydra.Ext.Json.Serde where--import Hydra.Core-import Hydra.Compute-import Hydra.Graph-import Hydra.Ext.Json.Coder-import Hydra.Tools.Bytestrings-import qualified Hydra.Json as Json--import qualified Data.ByteString.Lazy as BS-import qualified Control.Monad as CM-import qualified Data.Aeson as A-import qualified Data.Aeson.KeyMap as AKM-import qualified Data.Aeson.Key as AK-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.Vector as V-import qualified Data.Scientific as SC-import qualified Data.Char as C-import qualified Data.String as String---aesonValueToBytes :: A.Value -> BS.ByteString-aesonValueToBytes = A.encode--aesonValueToJsonValue :: A.Value -> Json.Value-aesonValueToJsonValue v = case v of-  A.Object km -> Json.ValueObject $ M.fromList (mapPair <$> AKM.toList km)-    where-      mapPair (k, v) = (AK.toString k, aesonValueToJsonValue v)-  A.Array a -> Json.ValueArray (aesonValueToJsonValue <$> V.toList a)-  A.String t -> Json.ValueString $ T.unpack t-  A.Number s -> Json.ValueNumber $ SC.toRealFloat s-  A.Bool b -> Json.ValueBoolean b-  A.Null -> Json.ValueNull--bytesToAesonValue :: BS.ByteString -> Either String A.Value-bytesToAesonValue = A.eitherDecode--bytesToJsonValue :: BS.ByteString -> Either String Json.Value-bytesToJsonValue bs = aesonValueToJsonValue <$> bytesToAesonValue bs--jsonByteStringCoder :: Type -> Flow Graph (Coder Graph Graph Term BS.ByteString)-jsonByteStringCoder typ = do-  coder <- jsonCoder typ-  return Coder {-    coderEncode = fmap jsonValueToBytes . coderEncode coder,-    coderDecode = \bs -> case bytesToJsonValue bs of-        Left msg -> fail $ "JSON parsing failed: " ++ msg-        Right v -> coderDecode coder v}---- | A convenience which maps typed terms to and from pretty-printed JSON strings, as opposed to JSON objects-jsonStringCoder :: Type -> Flow Graph (Coder Graph Graph Term String)-jsonStringCoder typ = do-  serde <- jsonByteStringCoder typ-  return Coder {-    coderEncode = fmap bytesToString . coderEncode serde,-    coderDecode = coderDecode serde . stringToBytes}--jsonValueToAesonValue :: Json.Value -> A.Value-jsonValueToAesonValue v = case v of-    Json.ValueArray l -> A.Array $ V.fromList (jsonValueToAesonValue <$> l)-    Json.ValueBoolean b -> A.Bool b-    Json.ValueNull -> A.Null-    Json.ValueNumber d -> A.Number $ SC.fromFloatDigits d-    Json.ValueObject m -> A.Object $ AKM.fromList (mapPair <$> M.toList m)-      where-        mapPair (k, v) = (AK.fromString k, jsonValueToAesonValue v)-    Json.ValueString s -> A.String $ T.pack s--jsonValueToBytes :: Json.Value -> BS.ByteString-jsonValueToBytes = aesonValueToBytes . jsonValueToAesonValue--jsonValueToString :: Json.Value -> String-jsonValueToString = bytesToString . jsonValueToBytes--stringToJsonValue :: String -> Either String Json.Value-stringToJsonValue = bytesToJsonValue . stringToBytes
− src/main/haskell/Hydra/Ext/Pegasus/Coder.hs 
@@ -1,188 +0,0 @@-module Hydra.Ext.Pegasus.Coder (moduleToPdl) where--import Hydra.Kernel-import Hydra.TermAdapters-import Hydra.Adapters-import Hydra.Ext.Pegasus.Language-import Hydra.Tools.Serialization-import Hydra.Ext.Pegasus.Serde-import qualified Hydra.Ext.Pegasus.Pdl as PDL-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---moduleToPdl :: Module -> Flow (Graph) (M.Map FilePath String)-moduleToPdl mod = do-    files <- moduleToPegasusSchemas mod-    return $ M.fromList (mapPair <$> M.toList files)-  where-    mapPair (path, sf) = (path, printExpr $ parenthesize $ exprSchemaFile sf)--constructModule ::-  M.Map Namespace String-  -> Module-  -> M.Map (Type) (Coder (Graph) (Graph) (Term) ())-  -> [(Element, TypedTerm)]-  -> Flow (Graph) (M.Map FilePath PDL.SchemaFile)-constructModule aliases mod coders pairs = do-    sortedPairs <- case (topologicalSortElements $ fst <$> pairs) of-      Left comps -> fail $ "types form a cycle (unsupported in PDL): " ++ show (L.head comps)-      Right sorted -> pure $ Y.catMaybes $ fmap (\n -> M.lookup n pairByName) sorted-    schemas <- CM.mapM toSchema sortedPairs-    return $ M.fromList (toPair <$> schemas)-  where-    ns = pdlNameForModule mod-    pkg = Nothing-    toPair (schema, imports) = (path, PDL.SchemaFile ns pkg imports [schema])-      where-        path = namespaceToFilePath False (FileExtension "pdl") (Namespace $ (unNamespace $ moduleNamespace mod) ++ "/" ++ local)-        local = PDL.unName $ PDL.qualifiedNameName $ PDL.namedSchemaQualifiedName schema--    pairByName = L.foldl (\m p -> M.insert (elementName $ fst p) p m) M.empty pairs-    toSchema (el, TypedTerm term typ) = do-      if isType typ-        then coreDecodeType term >>= typeToSchema el-        else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el)-    typeToSchema el typ = do-        res <- encodeAdaptedType aliases typ-        let ptype = case res of-              Left schema -> PDL.NamedSchema_TypeTyperef schema-              Right t -> t-        r <- getTermDescription $ elementData el-        let anns = doc r-        return (PDL.NamedSchema qname ptype anns, imports)-      where-        qname = pdlNameForElement aliases False $ elementName el-        imports = []---        imports = L.filter isExternal (pdlNameForElement aliases True <$> deps)---          where---            deps = S.toList $ termDependencyNames False False False $ elementData el---            isExternal qn = PDL.qualifiedNameNamespace qn /= PDL.qualifiedNameNamespace qname--moduleToPegasusSchemas :: Module -> Flow (Graph) (M.Map FilePath PDL.SchemaFile)-moduleToPegasusSchemas mod = do-  aliases <- importAliasesForModule mod-  transformModule pdlLanguage (encodeTerm aliases) (constructModule aliases) mod--doc :: Y.Maybe String -> PDL.Annotations-doc s = PDL.Annotations s False--encodeAdaptedType ::-  M.Map Namespace String -> Type-  -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type)-encodeAdaptedType aliases typ = do-  g <- getState-  let cx = AdapterContext g pdlLanguage M.empty-  ad <- withState cx $ termAdapter typ-  encodeType aliases $ adapterTarget ad--encodeTerm :: M.Map Namespace String -> Term -> Flow (Graph) ()-encodeTerm aliases term = fail "not yet implemented"--encodeType :: M.Map Namespace String -> Type -> Flow (Graph) (Either PDL.Schema PDL.NamedSchema_Type)-encodeType aliases typ = case typ of-    TypeAnnotated (AnnotatedType typ' _) -> encodeType aliases typ'-    TypeList lt -> Left . PDL.SchemaArray <$> encode lt-    TypeLiteral lt -> Left . PDL.SchemaPrimitive <$> case lt of-      LiteralTypeBinary -> pure PDL.PrimitiveTypeBytes-      LiteralTypeBoolean -> pure PDL.PrimitiveTypeBoolean-      LiteralTypeFloat ft -> case ft of-        FloatTypeFloat32 -> pure PDL.PrimitiveTypeFloat-        FloatTypeFloat64 -> pure PDL.PrimitiveTypeDouble-        _ -> unexpected "float32 or float64" $ show ft-      LiteralTypeInteger it -> case it of-        IntegerTypeInt32 -> pure PDL.PrimitiveTypeInt-        IntegerTypeInt64 -> pure PDL.PrimitiveTypeLong-        _ -> unexpected "int32 or int64" $ show it-      LiteralTypeString -> pure PDL.PrimitiveTypeString-    TypeMap (MapType kt vt) -> Left . PDL.SchemaMap <$> encode vt -- note: we simply assume string as a key type-    TypeVariable name -> pure $ Left $ PDL.SchemaNamed $ pdlNameForElement aliases True name-    TypeOptional ot -> fail $ "optionals unexpected at top level"-    TypeRecord rt -> do-      let includes = []-      rfields <- CM.mapM encodeRecordField $ rowTypeFields rt-      return $ Right $ PDL.NamedSchema_TypeRecord $ PDL.RecordSchema rfields includes-    TypeUnion rt -> if isEnum-        then do-          fs <- CM.mapM encodeEnumField $ rowTypeFields rt-          return $ Right $ PDL.NamedSchema_TypeEnum $ PDL.EnumSchema fs-        else Left . PDL.SchemaUnion . PDL.UnionSchema <$> CM.mapM encodeUnionField (rowTypeFields rt)-      where-        isEnum = L.foldl (\b t -> b && stripType t == Types.unit) True $ fmap fieldTypeType (rowTypeFields rt)-    _ -> unexpected "PDL-supported type" $ show typ-  where-    encode t = case stripType t of-      TypeRecord (RowType _ []) -> encode Types.int32 -- special case for the unit type-      _ -> do-        res <- encodeType aliases t-        case res of-          Left schema -> pure schema-          Right _ -> fail $ "type resolved to an unsupported nested named schema: " ++ show t-    encodeRecordField (FieldType (Name name) typ) = do-      anns <- getAnns typ-      (schema, optional) <- encodePossiblyOptionalType typ-      return PDL.RecordField {-        PDL.recordFieldName = PDL.FieldName name,-        PDL.recordFieldValue = schema,-        PDL.recordFieldOptional = optional,-        PDL.recordFieldDefault = Nothing,-        PDL.recordFieldAnnotations = anns}-    encodeUnionField (FieldType (Name name) typ) = do-      anns <- getAnns typ-      (s, optional) <- encodePossiblyOptionalType typ-      let schema = if optional-          then PDL.SchemaUnion $ PDL.UnionSchema (simpleUnionMember <$> [PDL.SchemaNull, s])-          else s-      return PDL.UnionMember {-        PDL.unionMemberAlias = Just $ PDL.FieldName name,-        PDL.unionMemberValue = schema,-        PDL.unionMemberAnnotations = anns}-    encodeEnumField (FieldType (Name name) typ) = do-      anns <- getAnns typ-      return PDL.EnumField {-        PDL.enumFieldName = PDL.EnumFieldName $ convertCase CaseConventionCamel CaseConventionUpperSnake name,-        PDL.enumFieldAnnotations = anns}-    encodePossiblyOptionalType typ = case stripType typ of-      TypeOptional ot -> do-        t <- encode ot-        return (t, True)-      _ -> do-        t <- encode typ-        return (t, False)-    getAnns typ = do-      r <- getTypeDescription typ-      return $ doc r--importAliasesForModule mod = do-    nss <- moduleDependencyNamespaces False True True False mod-    return $ M.fromList (toPair <$> S.toList nss)-  where-    toPair ns = (ns, slashesToDots $ unNamespace ns)--noAnnotations :: PDL.Annotations-noAnnotations = PDL.Annotations Nothing False--pdlNameForElement :: M.Map Namespace String -> Bool -> Name -> PDL.QualifiedName-pdlNameForElement aliases withNs name = PDL.QualifiedName (PDL.Name local)-    $ if withNs-      then PDL.Namespace <$> alias-      else Nothing-  where-    QualifiedName (Just ns) local = qualifyNameEager name-    alias = M.lookup ns aliases--pdlNameForModule :: Module -> PDL.Namespace-pdlNameForModule = PDL.Namespace . slashesToDots . h . moduleNamespace-  where-    h (Namespace n) = n--simpleUnionMember :: PDL.Schema -> PDL.UnionMember-simpleUnionMember schema = PDL.UnionMember Nothing schema noAnnotations--slashesToDots :: String -> String-slashesToDots = fmap (\c -> if c == '/' then '.' else c)
− src/main/haskell/Hydra/Ext/Pegasus/Language.hs 
@@ -1,41 +0,0 @@-module Hydra.Ext.Pegasus.Language where--import Hydra.Kernel--import qualified Data.Set as S---pdlLanguage :: Language-pdlLanguage = Language (LanguageName "hydra/ext/pegasus/pdl") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBinary,-    LiteralVariantBoolean,-    LiteralVariantFloat,-    LiteralVariantInteger,-    LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [-    FloatTypeFloat32,-    FloatTypeFloat64],-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList [-    IntegerTypeInt32,-    IntegerTypeInt64],-  languageConstraintsTermVariants = S.fromList [-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantWrap,-    TermVariantOptional,-    TermVariantRecord,-    TermVariantUnion],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantAnnotated,-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantWrap,-    TypeVariantOptional,-    TypeVariantRecord,-    TypeVariantUnion],-  languageConstraintsTypes = const True }
− src/main/haskell/Hydra/Ext/Pegasus/Serde.hs 
@@ -1,81 +0,0 @@-module Hydra.Ext.Pegasus.Serde where--import Hydra.Tools.Serialization-import Hydra.Tools.Formatting-import qualified Hydra.Ast as CT-import qualified Hydra.Ext.Pegasus.Pdl as PDL--import qualified Data.List as L-import qualified Data.Maybe as Y---exprAnnotations :: PDL.Annotations -> Y.Maybe CT.Expr-exprAnnotations (PDL.Annotations doc _) = cst . javaStyleComment <$> doc--exprEnumField :: PDL.EnumField -> CT.Expr-exprEnumField (PDL.EnumField (PDL.EnumFieldName name) anns) = withAnnotations anns $ cst name--exprImport :: PDL.QualifiedName -> CT.Expr-exprImport qn = spaceSep [cst "import", exprQualifiedName qn]--exprNamedSchema :: PDL.NamedSchema -> CT.Expr-exprNamedSchema (PDL.NamedSchema qn t anns) = withAnnotations anns $-  case t of-    PDL.NamedSchema_TypeRecord (PDL.RecordSchema fields _) -> spaceSep [cst "record", exprQualifiedName qn,-      curlyBracesList Nothing fullBlockStyle (exprRecordField <$> fields)]-    PDL.NamedSchema_TypeEnum (PDL.EnumSchema fields) -> spaceSep [cst "enum", exprQualifiedName qn,-      curlyBracesList Nothing fullBlockStyle (exprEnumField <$> fields)]-    PDL.NamedSchema_TypeTyperef schema -> spaceSep [cst "typeref", exprQualifiedName qn, cst "=", exprSchema schema]--exprPrimitiveType :: PDL.PrimitiveType -> CT.Expr-exprPrimitiveType pt = cst $ case pt of-  PDL.PrimitiveTypeBoolean -> "boolean"-  PDL.PrimitiveTypeBytes -> "bytes"-  PDL.PrimitiveTypeDouble -> "double"-  PDL.PrimitiveTypeFloat -> "float"-  PDL.PrimitiveTypeInt -> "int"-  PDL.PrimitiveTypeLong -> "long"-  PDL.PrimitiveTypeString -> "string"--exprQualifiedName :: PDL.QualifiedName -> CT.Expr-exprQualifiedName (PDL.QualifiedName (PDL.Name name) ns) = cst $ L.intercalate "." $ Y.catMaybes [h <$> ns, Just name]-  where-    h (PDL.Namespace ns) = ns--exprRecordField :: PDL.RecordField -> CT.Expr-exprRecordField (PDL.RecordField (PDL.FieldName name) schema optional def anns) = withAnnotations anns $-  spaceSep $ Y.catMaybes [ -- TODO: default-    Just $ cst $ name ++ ":",-    if optional then Just (cst "optional") else Nothing,-    Just $ exprSchema schema]--exprSchema :: PDL.Schema -> CT.Expr-exprSchema schema = case schema of-  PDL.SchemaArray s -> noSep [cst "array", bracketList inlineStyle [exprSchema s]]---  PDL.SchemaFixed i ->---  PDL.SchemaInline ns ->-  PDL.SchemaMap s -> noSep [cst "map", bracketList inlineStyle [cst "string", exprSchema s]]-  PDL.SchemaNamed qn -> exprQualifiedName qn-  PDL.SchemaNull -> cst "null"-  PDL.SchemaPrimitive pt -> exprPrimitiveType pt-  PDL.SchemaUnion (PDL.UnionSchema us) -> noSep [cst "union", bracketList fullBlockStyle (exprUnionMember <$> us)]--exprSchemaFile :: PDL.SchemaFile -> CT.Expr-exprSchemaFile (PDL.SchemaFile (PDL.Namespace ns) pkg imports schemas) = doubleNewlineSep $ Y.catMaybes-    [namespaceSec, packageSec, importsSec] ++ schemaSecs-  where-    namespaceSec = Just $ spaceSep [cst "namespace", cst ns]-    packageSec = fmap (\(PDL.Package p) -> spaceSep [cst "package", cst p]) pkg-    importsSec = if L.null imports-      then Nothing-      else Just $ newlineSep (exprImport <$> imports)-    schemaSecs = exprNamedSchema <$> schemas--exprUnionMember :: PDL.UnionMember -> CT.Expr-exprUnionMember (PDL.UnionMember alias schema anns) = withAnnotations anns $-  spaceSep $ Y.catMaybes [-    fmap (\(PDL.FieldName n) -> cst $ n ++ ":") alias,-    Just $ exprSchema schema]--withAnnotations :: PDL.Annotations -> CT.Expr -> CT.Expr-withAnnotations anns expr = newlineSep $ Y.catMaybes [exprAnnotations anns, Y.Just expr]
− src/main/haskell/Hydra/Ext/Pg/Coder.hs 
@@ -1,355 +0,0 @@-module Hydra.Ext.Pg.Coder (-  elementCoder,-) where--import Hydra.Kernel-import Hydra.Pg.Mapping-import Hydra.Ext.Pg.TermsToElements-import qualified Hydra.Pg.Model as PG-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---type ElementAdapter s t v = Adapter s s (Type) (PG.ElementTypeTree t) (Term) (PG.ElementTree v)--type PropertyAdapter s t v = Adapter s s (FieldType) (PG.PropertyType t) (Field) (PG.Property v)--type IdAdapter s t v = (Name, Adapter s s (Type) t (Term) v)--data AdjacentEdgeAdapter s a t v = AdjacentEdgeAdapter {-  adjacentEdgeAdapterDirection :: PG.Direction,-  adjacentEdgeAdapterField :: FieldType,-  adjacentEdgeAdapterLabel :: PG.EdgeLabel,-  adjacentEdgeAdapterAdapter :: ElementAdapter s t v}--data ProjectionSpec a = ProjectionSpec {-  projectionSpecField :: FieldType,-  projectionSpecValues :: ValueSpec,-  projectionSpecAlias :: Maybe String}---- TODO: deprecate "kind"-key_kind = Name "kind"--check :: Bool -> Flow s () -> Flow s ()-check b err = if b then pure () else err--checkRecordName expected actual = check (actual == expected) $-  unexpected ("record of type " ++ unName expected) ("record of type " ++ unName actual)--edgeCoder :: PG.Direction -> Schema s t v-  -> Type-  -> t-  -> Name-  -> PG.EdgeLabel -> PG.VertexLabel -> PG.VertexLabel-  -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> Maybe (IdAdapter s t v) -> [PropertyAdapter s t v]-  -> ElementAdapter s t v-edgeCoder dir schema source eidType tname label outLabel inLabel mIdAdapter outAdapter inAdapter propAdapters-    = Adapter lossy source (elementTypeTreeEdge et []) coder-  where-    et = PG.EdgeType label eidType outLabel inLabel $ propertyTypes propAdapters-    coder = Coder encode decode-      where-        encode term = case stripTerm term of-          TermOptional (Just ot) -> encode ot-          TermRecord (Record tname' fields) -> do-            checkRecordName tname tname'-            let fieldsm = fieldMap fields-            id <- case mIdAdapter of-              Nothing -> pure $ schemaDefaultEdgeId schema-              Just ad -> selectEdgeId fieldsm ad-            props <- encodeProperties fieldsm propAdapters-            outId <- getVertexId PG.DirectionOut fieldsm outAdapter-            inId <- getVertexId PG.DirectionIn fieldsm inAdapter-            return $ elementTreeEdge (PG.Edge label id outId inId props) []-          _ -> unexpected "record (1)" $ show term-        decode el = noDecoding "edge"-        getVertexId dir1 fieldsm adapter = if dir1 == dir-          then pure $ schemaDefaultVertexId schema-          else case adapter of-            Nothing -> fail $ "no adapter for " ++ show dir1 ++ " with " ++ show dir-            Just ad -> selectVertexId fieldsm ad--elementCoder :: (Show t, Show v) => Y.Maybe (PG.Direction, PG.VertexLabel)-  -> Schema s t v-  -> Type-  -> t -> t-  -> Flow s (ElementAdapter s t v)-elementCoder mparent schema source vidType eidType = case stripType source of-    TypeOptional ot -> elementCoder mparent schema ot vidType eidType-    TypeRecord (RowType name fields) -> withTrace ("adapter for " ++ unName name) $ do-      mOutSpec <- findProjectionSpec name outVertexKey outVertexLabelKey fields-      mInSpec <- findProjectionSpec name inVertexKey inVertexLabelKey fields--      kind <- case getTypeAnnotation key_kind source of-        Nothing -> pure $ if hasVertexAdapters mOutSpec mInSpec-          then PG.ElementKindEdge-          else PG.ElementKindVertex-        Just kindTerm -> do-          s <- Expect.string kindTerm-          case s of-            "vertex" -> return PG.ElementKindVertex-            "edge" -> if Y.isNothing mOutSpec || Y.isNothing mInSpec-              then fail $ "Record type marked as an edge type, but missing 'out' and/or 'in' fields: " ++ unName name-              else return PG.ElementKindEdge--      propSpecs <- findPropertySpecs kind fields-      propAdapters <- CM.mapM (propertyAdapter schema) propSpecs--      case kind of-        PG.ElementKindVertex -> do-          label <- PG.VertexLabel <$> findLabelString name vertexLabelKey-          idAdapter <- vertexIdAdapter name vertexIdKey fields-          outEdgeAdapters <- edgeAdapters label PG.DirectionOut fields-          inEdgeAdapters <- edgeAdapters label PG.DirectionIn fields-          return $ vertexCoder schema source vidType name label idAdapter propAdapters (outEdgeAdapters ++ inEdgeAdapters)-        PG.ElementKindEdge -> do-          label <- PG.EdgeLabel <$> findLabelString name edgeLabelKey-          idAdapter <- edgeIdAdapter name edgeIdKey fields-          outAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "out") mOutSpec-          inAdapter <- Y.maybe (pure Nothing) (\s -> Just <$> projectionAdapter vidType (schemaVertexIds schema) s "in") mInSpec-          outLabel <- case mOutSpec of-            Nothing -> pure parentLabel-            Just spec -> Y.maybe (fail "no out-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec-          inLabel <- case mInSpec of-            Nothing -> pure parentLabel-            Just spec -> Y.maybe (fail "no in-vertex label") (pure . PG.VertexLabel) $ projectionSpecAlias spec-          return $ edgeCoder dir schema source eidType name label outLabel inLabel idAdapter outAdapter inAdapter propAdapters--    _ -> unexpected "record type" $ show source-  where-    dir = Y.maybe PG.DirectionBoth fst mparent-    parentLabel = Y.maybe (PG.VertexLabel "NOLABEL") snd mparent--    vertexIdAdapter name idKey fields = do-      idSpec <- Y.fromJust <$> findId True name idKey fields-      idAdapter <- projectionAdapter vidType (schemaVertexIds schema) idSpec "id"-      return idAdapter--    edgeIdAdapter name idKey fields = do-      mIdSpec <- findId False name idKey fields-      case mIdSpec of-        Nothing -> pure Nothing-        Just idSpec -> Just <$> projectionAdapter eidType (schemaEdgeIds schema) idSpec "id"--    hasVertexAdapters mOutSpec mInSpec = case dir of-      PG.DirectionOut -> Y.isJust mInSpec-      PG.DirectionIn -> Y.isJust mOutSpec-      PG.DirectionBoth -> Y.isJust mOutSpec && Y.isJust mInSpec--    vertexLabelKey = Name $ annotationSchemaVertexLabel $ schemaAnnotations schema-    edgeLabelKey = Name $ annotationSchemaEdgeLabel $ schemaAnnotations schema-    vertexIdKey = Name $ annotationSchemaVertexId $ schemaAnnotations schema-    edgeIdKey = Name $ annotationSchemaEdgeId $ schemaAnnotations schema-    propertyKeyKey = Name $ annotationSchemaPropertyKey $ schemaAnnotations schema-    propertyValueKey = Name $ annotationSchemaPropertyValue $ schemaAnnotations schema-    outVertexKey = Name $ annotationSchemaOutVertex $ schemaAnnotations schema-    outVertexLabelKey = Name $ annotationSchemaOutVertexLabel $ schemaAnnotations schema-    inVertexKey = Name $ annotationSchemaInVertex $ schemaAnnotations schema-    inVertexLabelKey = Name $ annotationSchemaInVertexLabel $ schemaAnnotations schema-    outEdgeLabelKey = Name $ annotationSchemaOutEdgeLabel $ schemaAnnotations schema-    inEdgeLabelKey = Name $ annotationSchemaInEdgeLabel $ schemaAnnotations schema-    ignoreKey = Name $ annotationSchemaIgnore $ schemaAnnotations schema--    findLabelString tname labelKey = case getTypeAnnotation labelKey source of-      Nothing -> pure $ unName tname-      Just labelTerm -> Expect.string labelTerm--    findId required tname idKey fields = withTrace "find id field" $ do-      mid <- findField tname idKey fields-      case mid of-        Nothing -> if required-          then fail $ "no " ++ unName idKey ++ " field"-          else pure Nothing-        Just mi -> do-          spec <- case getTypeAnnotation idKey (fieldTypeType mi) of-            Nothing -> pure ValueSpecValue-            Just t -> decodeValueSpec t-          return $ Just $ ProjectionSpec mi spec Nothing--    findProjectionSpec tname key aliasKey fields = withTrace ("find " ++ show key ++ " projection") $ do-      mfield <- findField tname key fields-      case mfield of-        Nothing -> pure Nothing-        Just field -> do-          spec <- decodeValueSpec $ Y.fromJust $ getTypeAnnotation key $ fieldTypeType field-          alias <- case getTypeAnnotation aliasKey $ fieldTypeType field of-            Nothing -> pure Nothing-            Just t -> Just <$> Expect.string t-          return $ Just $ ProjectionSpec field spec alias--    findField tname key fields = withTrace ("find " ++ show key ++ " field") $ do-      let matches = L.filter (\f -> Y.isJust $ getTypeAnnotation key $ fieldTypeType f) fields-      if L.length matches > 1-        then fail $ "Multiple fields marked as '" ++ unName key ++ "' in record type " ++ unName tname ++ ": "-          ++ (L.intercalate ", " (unName . fieldTypeName <$> matches))-        else return $ if L.null matches then Nothing else Just $ L.head matches--    findPropertySpecs kind fields = CM.mapM toSpec $ L.filter isPropField fields-      where-        isPropField field = not (hasSpecialAnnotation || hasSpecialFieldName)-          where-            hasSpecialAnnotation = L.foldl (\b k -> b || hasAnnotation k) False (ignoreKey:specialKeys)-            hasSpecialFieldName = L.foldl (\b n -> b || hasName n) False specialKeys-            specialKeys = case kind of-              PG.ElementKindVertex -> [vertexIdKey, outEdgeLabelKey, inEdgeLabelKey]-              PG.ElementKindEdge -> [edgeIdKey, outVertexKey, inVertexKey]-            hasAnnotation key = Y.isJust $ getTypeAnnotation key $ fieldTypeType field-            hasName fname = fieldTypeName field == fname-        toSpec field = do-          alias <- case (getTypeAnnotation propertyKeyKey $ fieldTypeType field) of-            Nothing -> pure Nothing-            Just a -> Just <$> Expect.string a-          values <- case (getTypeAnnotation propertyValueKey $ fieldTypeType field) of-            Nothing -> pure ValueSpecValue-            Just sp -> decodeValueSpec sp-          return $ ProjectionSpec field values alias--    edgeAdapters vlabel dir fields = Y.catMaybes <$> CM.mapM toSpec fields-      where-        toSpec field = case getTypeAnnotation key (fieldTypeType field) of-          Nothing -> pure Nothing-          Just a -> do-            label <- PG.EdgeLabel <$> Expect.string a-            elad <- elementCoder (Just (dir, vlabel)) schema (fieldTypeType field) vidType eidType-            return $ Just $ AdjacentEdgeAdapter dir field label elad-        key = case dir of-          PG.DirectionOut -> outEdgeLabelKey-          PG.DirectionIn -> inEdgeLabelKey--elementTreeEdge :: PG.Edge v -> [PG.ElementTree v] -> PG.ElementTree v-elementTreeEdge edge = PG.ElementTree (PG.ElementEdge edge)--elementTreeVertex :: PG.Vertex v -> [PG.ElementTree v] -> PG.ElementTree v-elementTreeVertex vertex = PG.ElementTree (PG.ElementVertex vertex)--elementTypeTreeEdge :: PG.EdgeType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t-elementTypeTreeEdge etype = PG.ElementTypeTree (PG.ElementTypeEdge etype)--elementTypeTreeVertex :: PG.VertexType t -> [PG.ElementTypeTree t] -> PG.ElementTypeTree t-elementTypeTreeVertex vtype = PG.ElementTypeTree (PG.ElementTypeVertex vtype)--encodeProperties :: M.Map Name (Term) -> [PropertyAdapter s t v] -> Flow s (M.Map PG.PropertyKey v)-encodeProperties fields adapters = do-  props <- Y.catMaybes <$> CM.mapM (encodeProperty fields) adapters-  return $ M.fromList $ fmap (\(PG.Property key val) -> (key, val)) props--encodeProperty :: M.Map Name (Term) -> PropertyAdapter s t v -> Flow s (Maybe (PG.Property v))-encodeProperty fields adapter = do-  case M.lookup fname fields of-    Nothing -> case ftyp of-      TypeOptional _ -> pure Nothing-      _ -> fail $ "expected field not found in record: " ++ unName fname-    Just value -> case ftyp of-      TypeOptional _ -> case fullyStripTerm value of-        TermOptional ov -> case ov of-          Nothing -> pure Nothing-          Just v -> Just <$> encodeValue v-        _ -> unexpected "optional term" $ show value-      _ -> Just <$> encodeValue value-  where-    fname = fieldTypeName $ adapterSource adapter-    ftyp = stripType (fieldTypeType $ adapterSource adapter)-    encodeValue v = coderEncode (adapterCoder adapter) (Field fname v)---- TODO; infer lossiness-lossy = True--noDecoding :: String -> Flow s x-noDecoding cat = fail $ cat ++ " decoding is not yet supported"--projectionAdapter :: t-  -> Coder s s (Term) v-  -> ProjectionSpec a-  -> String-  -> Flow s (IdAdapter s t v)-projectionAdapter idtype coder spec key = do-    traversal <- parseValueSpec $ projectionSpecValues spec-    let field = projectionSpecField spec-    let encode = \typ -> traverseToSingleTerm (key ++ "-projection") traversal typ >>= coderEncode coder-    return (fieldTypeName field, Adapter lossy (fieldTypeType field) idtype $ Coder encode decode)-  where-    decode _ = noDecoding $ "edge '" ++ key ++ "'"--propertyAdapter :: Schema s t v -> ProjectionSpec a -> Flow s (PropertyAdapter s t v)-propertyAdapter schema (ProjectionSpec tfield values alias) = do-  let key = PG.PropertyKey $ case alias of-        Nothing -> unName $ fieldTypeName tfield-        Just k -> k-  pt <- coderEncode (schemaPropertyTypes schema) $ fieldTypeType tfield-  traversal <- parseValueSpec values-  let coder = Coder encode decode-        where-          encode dfield = withTrace ("encode property field " ++ show (unName $ fieldTypeName tfield)) $ do-            if fieldName dfield /= fieldTypeName tfield-              then unexpected ("field '" ++ unName (fieldTypeName tfield) ++ "'") $ show dfield-              else do-                result <- traverseToSingleTerm "property traversal" traversal $ fieldTerm dfield-                value <- coderEncode (schemaPropertyValues schema) result-                return $ PG.Property key value-          decode _ = noDecoding "property"-  return $ Adapter lossy tfield (PG.PropertyType key pt True) coder--propertyTypes propAdapters = toPropertyType <$> propAdapters-  where-    toPropertyType a = PG.PropertyType (PG.propertyTypeKey $ adapterTarget a) (PG.propertyTypeValue $ adapterTarget a) True--selectEdgeId fields (fname, ad) = case M.lookup fname fields of-  Nothing -> fail $ "no " ++ unName fname ++ " in record"-  Just t -> coderEncode (adapterCoder ad) t--selectVertexId :: M.Map Name (Term) -> IdAdapter s t v -> Flow s v-selectVertexId  fields (fname, ad) = case M.lookup fname fields of-  Nothing -> fail $ "no " ++ unName fname ++ " in record"-  Just t -> coderEncode (adapterCoder ad) t--traverseToSingleTerm :: String -> (Term -> Flow s [Term]) -> Term -> Flow s (Term)-traverseToSingleTerm desc traversal term = do-  terms <- traversal term-  case terms of-    [] -> fail $ desc ++ " did not resolve to a term"-    [t] -> pure t-    _ -> fail $ desc ++ " resolved to multiple terms"--vertexCoder :: (Show t, Show v)-  => Schema s t v-  -> Type-  -> t-   -> Name-  -> PG.VertexLabel -> IdAdapter s t v -> [PropertyAdapter s t v]-  -> [AdjacentEdgeAdapter s a t v]-  -> ElementAdapter s t v-vertexCoder schema source vidType tname label idAdapter propAdapters edgeAdapters = Adapter lossy source target coder-  where-    target = elementTypeTreeVertex vtype depTypes-    vtype = PG.VertexType label vidType $ propertyTypes propAdapters-    depTypes = adapterTarget . adjacentEdgeAdapterAdapter <$> edgeAdapters-    coder = Coder encode decode-      where-        encode term = case stripTerm term of-            TermOptional (Just ot) -> encode ot-            TermRecord (Record tname' fields) -> do-              checkRecordName tname tname'-              let fieldsm = fieldMap fields-              vid <- selectVertexId fieldsm idAdapter-              props <- encodeProperties (fieldMap fields) propAdapters-              deps <- Y.catMaybes <$> CM.mapM (findDeps vid fieldsm) edgeAdapters-              return $ elementTreeVertex (PG.Vertex label vid props) deps-            _ -> unexpected "record (2)" $ show term-          where-            findDeps vid fieldsm (AdjacentEdgeAdapter dir field label ad) = do-                case M.lookup (fieldTypeName field) fieldsm of-                  Nothing -> pure Nothing-                  Just fterm -> Just <$> (coderEncode (adapterCoder ad) fterm >>= fixTree)-              where-                fixTree tree = case PG.elementTreeSelf tree of-                  PG.ElementEdge e -> pure $ tree {PG.elementTreeSelf = PG.ElementEdge $ fixEdge e}-                  _ -> unexpected "edge tree" $ show tree-                fixEdge e = case dir of-                  PG.DirectionOut -> e {PG.edgeOut = vid}-                  PG.DirectionIn -> e {PG.edgeIn = vid}-        decode el = noDecoding "vertex"
− src/main/haskell/Hydra/Ext/Pg/TermsToElements.hs 
@@ -1,253 +0,0 @@-module Hydra.Ext.Pg.TermsToElements (-  decodeValueSpec,-  parseValueSpec,-  termToElementsAdapter,-) where--import Hydra.Kernel-import Hydra.Pg.Mapping-import qualified Hydra.Pg.Model as PG-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.List.Split as LS-import qualified Data.Map as M-import qualified Data.Maybe as Y---type PgAdapter s v = Adapter s s Type [PG.Label] Term [PG.Element v]--key_elements = Name "elements"--termToElementsAdapter :: Schema s t v -> Type -> Flow s (PgAdapter s v)-termToElementsAdapter schema typ = do-    case getTypeAnnotation key_elements typ of-      Nothing -> pure trivialAdapter-      Just term -> do-        specs <- Expect.list decodeElementSpec term >>= CM.mapM (parseElementSpec schema)-        let labels = L.nub (fst <$> specs)-        let encoders = snd <$> specs-        let encode term = L.concat <$> CM.mapM (\e -> e term) encoders-        return $ Adapter lossy typ labels $ Coder encode (\els -> noDecoding "element")-  where-    trivialAdapter = Adapter False typ [] $ Coder (\term -> pure []) (\el -> fail "no corresponding element type")---- TODO; infer lossiness-lossy = False--noDecoding :: String -> Flow s x-noDecoding cat = fail $ cat ++ " decoding is not yet supported"--parseEdgeIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v])-parseEdgeIdPattern schema spec = do-  fun <- parseValueSpec spec-  return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaEdgeIds schema)--parseEdgeSpec :: Schema s t v -> EdgeSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v])-parseEdgeSpec schema (EdgeSpec label id outV inV props) = do-  getId <- parseEdgeIdPattern schema id-  getOut <- parseVertexIdPattern schema outV-  getIn <- parseVertexIdPattern schema inV-  getProps <- CM.mapM (parsePropertySpec schema) props-  let encode term = withTrace "encode as edge" $ do-        tid <- requireUnique "edge id" getId term-        tout <- requireUnique "vertex id" getOut term-        tin <- requireUnique "edge id" getIn term-        tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps-        return [PG.ElementEdge $ PG.Edge label tid tout tin tprops]-  return (PG.LabelEdge label, encode)--parseElementSpec :: Schema s t v -> ElementSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v])-parseElementSpec schema spec = case spec of-  ElementSpecVertex vspec -> parseVertexSpec schema vspec-  ElementSpecEdge espec -> parseEdgeSpec schema espec--parsePattern :: String -> Flow s (Term -> Flow s [Term])-parsePattern pat = withTrace "parse path pattern" $ do-    (lits, paths) <- parsePattern [] [] "" pat-    return $ traverse lits paths-  where-    parsePattern lits paths cur s = case s of-      [] -> pure (L.reverse (nextLit:lits), L.reverse paths)-      ('$':'{':rest) -> parsePath (nextLit:lits) paths "" rest-      (c:rest) -> parsePattern lits paths (c:cur) rest-      where-        nextLit = L.reverse cur-        parsePath lits paths cur s = case s of-          [] -> fail $ "Unfinished path expression: " ++ pat-          ('}':rest) -> parsePattern lits (path:paths) "" rest-            where-              path = LS.splitOn "/" $ L.reverse cur-          (c:rest) -> parsePath lits paths (c:cur) rest-    traverse lits paths term = withTrace ("traverse pattern: " ++ pat) $ recurse [""] True lits paths-      where-        recurse values lp lits paths = if L.null values-            then pure []-            else if lp-            -- Try to apply a literal-            then case lits of-              -- All done. The last segment is always a literal.-              [] -> return $ Terms.string <$> values-              -- Append the literal and continue traversing.-              (l:rest) -> recurse (append l) False rest paths-            -- Try to apply a path-            else case paths of-              -- No more paths; continue with literals-              [] -> recurse values True lits []-              -- Apply the next path-              (path:rest) -> do-                  strings <- evalPath path term >>= CM.mapM toString-                  recurse (appendAll strings) True lits rest-          where-            append s = fmap (\v -> v ++ s) values-            appendAll strings = L.concat (append <$> strings)-    evalPath path term = case path of-        [] -> pure [term]-        (step:rest) -> do-          results <- evalStep step term-          L.concat <$> (CM.mapM (evalPath rest) results)-      where-        evalStep step term = if L.null step-          then pure [term]-          else case stripTerm term of-              TermList terms -> L.concat <$> CM.mapM (evalStep step) terms-              TermOptional mt -> case mt of-                Nothing -> pure []-                Just term' -> evalStep step term'-              TermRecord (Record _ fields) -> case M.lookup (Name step) (fieldMap fields) of-                Nothing -> fail $ "No such field " ++ step ++ " in record: " ++ show term-                Just term' -> pure [term']-              TermUnion (Injection _ field) -> if unName (fieldName field) == step-                then evalStep step $ fieldTerm field-                else pure [] -- Note: not checking the step against the union type; assuming it is correct but that it references a field unused by the injection-              TermWrap (WrappedTerm _ term') -> evalStep step term'-              _ -> fail $ "Can't traverse through term for step " ++ show step ++ ": " ++ show term--    -- TODO: replace this with a more standard function-    toString term = case stripTerm term of-      TermLiteral lit -> pure $ case lit of-        LiteralBinary b -> b-        LiteralBoolean b -> show b-        LiteralInteger i -> case i of-          IntegerValueBigint v -> show v-          IntegerValueInt8 v -> show v-          IntegerValueInt16 v -> show v-          IntegerValueInt32 v -> show v-          IntegerValueInt64 v -> show v-          IntegerValueUint8 v -> show v-          IntegerValueUint16 v -> show v-          IntegerValueUint32 v -> show v-          IntegerValueUint64 v -> show v-        LiteralFloat f -> case f of-          FloatValueBigfloat v -> show v-          FloatValueFloat32 v -> show v-          FloatValueFloat64 v -> show v-        LiteralString s -> s-      TermOptional mt -> case mt of-        Nothing -> pure "nothing"-        Just t -> toString t-      _ -> pure $ show term--parsePropertySpec :: Schema s t v -> PropertySpec -> Flow s (Term -> Flow s [(PG.PropertyKey, v)])-parsePropertySpec schema (PropertySpec key value) = withTrace "parse property spec" $ do-  fun <- parseValueSpec value-  return $ \term -> withTrace ("encode property " ++ PG.unPropertyKey key) $ do-    results <- fun term-    values <- CM.mapM (coderEncode $ schemaPropertyValues schema) results-    return $ fmap (\v -> (key, v)) values--parseValueSpec :: ValueSpec -> Flow s (Term -> Flow s [Term])-parseValueSpec spec = case spec of-  ValueSpecValue -> pure $ \term -> pure [term]-  ValueSpecPattern pat -> parsePattern pat--parseVertexIdPattern :: Schema s t v -> ValueSpec -> Flow s (Term -> Flow s [v])-parseVertexIdPattern schema spec = do-  fun <- parseValueSpec spec-  return $ \term -> fun term >>= CM.mapM (coderEncode $ schemaVertexIds schema)--parseVertexSpec :: Schema s t v -> VertexSpec -> Flow s (PG.Label, Term -> Flow s [PG.Element v])-parseVertexSpec schema (VertexSpec label id props) = do-  getId <- parseVertexIdPattern schema id-  getProps <- CM.mapM (parsePropertySpec schema) props-  let encode term = withTrace "encode as vertex" $ do-        tid <- requireUnique "vertex id" getId term-        tprops <- M.fromList <$> CM.mapM (\g -> requireUnique "property key" g term) getProps-        return [PG.ElementVertex $ PG.Vertex label tid tprops]-  return (PG.LabelVertex label, encode)--requireUnique :: String -> (Term -> Flow s [x]) -> Term -> Flow s x-requireUnique context fun term = do-  results <- fun term-  case results of-    [] -> fail $ "No value found: " ++ context-    [value] -> pure value-    _ -> fail $ "Multiple values found: " ++ context----- Element spec decoding. TODO: this should code should really be generated rather than hand-written.--decodeEdgeLabel :: Term -> Flow s PG.EdgeLabel-decodeEdgeLabel t = PG.EdgeLabel <$> Expect.string t--decodeEdgeSpec :: Term -> Flow s EdgeSpec-decodeEdgeSpec term = withTrace "decode edge spec" $ matchRecord (\fields -> EdgeSpec-  <$> readField fields _EdgeSpec_label decodeEdgeLabel-  <*> readField fields _EdgeSpec_id decodeValueSpec-  <*> readField fields _EdgeSpec_out decodeValueSpec-  <*> readField fields _EdgeSpec_in decodeValueSpec-  <*> readField fields _EdgeSpec_properties (Expect.list decodePropertySpec)) term--decodeElementSpec :: Term -> Flow s ElementSpec-decodeElementSpec term = withTrace "decode element spec" $ matchInjection [-  (_ElementSpec_vertex, \t -> ElementSpecVertex <$> decodeVertexSpec t),-  (_ElementSpec_edge, \t -> ElementSpecEdge <$> decodeEdgeSpec t)] term--decodePropertyKey :: Term -> Flow s PG.PropertyKey-decodePropertyKey t = PG.PropertyKey <$> Expect.string t--decodePropertySpec :: Term -> Flow s PropertySpec-decodePropertySpec term = withTrace "decode property spec" $ matchRecord (\fields -> PropertySpec-  <$> readField fields _PropertySpec_key decodePropertyKey-  <*> readField fields _PropertySpec_value decodeValueSpec) term--decodeValueSpec :: Term -> Flow s ValueSpec-decodeValueSpec term = withTrace "decode value spec" $ case stripTerm term of-  -- Allow an abbreviated specification consisting of only the pattern string-  TermLiteral (LiteralString s) -> pure $ ValueSpecPattern s-  _ -> matchInjection [-    (_ValueSpec_value, \t -> pure ValueSpecValue),-    (_ValueSpec_pattern, \t -> ValueSpecPattern <$> Expect.string t)] term--decodeVertexLabel :: Term -> Flow s PG.VertexLabel-decodeVertexLabel t = PG.VertexLabel <$> Expect.string t--decodeVertexSpec :: Term -> Flow s VertexSpec-decodeVertexSpec term = withTrace "decode vertex spec" $ matchRecord (\fields -> VertexSpec-  <$> readField fields _VertexSpec_label decodeVertexLabel-  <*> readField fields _VertexSpec_id decodeValueSpec-  <*> readField fields _VertexSpec_properties (Expect.list decodePropertySpec)) term----- General-purpose code for decoding--matchInjection :: [(Name, Term -> Flow s x)] -> Term -> Flow s x-matchInjection cases encoded = do-  mp <- Expect.map (\k -> Name <$> Expect.string k) pure encoded-  f <- case M.toList mp of-    [] -> fail "empty injection"-    [(k, v)] -> pure $ Field k v-    _ -> fail $ "invalid injection: " ++ show mp-  case snd <$> (L.filter (\c -> fst c == fieldName f) cases) of-    [] -> fail $ "unexpected field: " ++ unName (fieldName f)-    [fun] -> fun (fieldTerm f)-    _ -> fail "duplicate field name in cases"--matchRecord :: (M.Map Name Term -> Flow s x) -> Term -> Flow s x-matchRecord cons term = Expect.map (\k -> Name <$> Expect.string k) pure term >>= cons--readField fields fname fun = case M.lookup fname fields of-  Nothing -> fail $ "no such field: " ++ unName fname-  Just t -> fun t
− src/main/haskell/Hydra/Ext/Protobuf/Coder.hs 
@@ -1,303 +0,0 @@-module Hydra.Ext.Protobuf.Coder (moduleToProtobuf) where--import Hydra.Kernel-import Hydra.Ext.Protobuf.Language-import qualified Hydra.Ext.Protobuf.Proto3 as P3-import qualified Hydra.Lib.Strings as Strings-import Hydra.Ext.Protobuf.Language-import Hydra.Ext.Protobuf.Serde-import Hydra.Tools.Serialization-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.Annotations-import Hydra.Lib.Io--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Text.Read as TR-import qualified Data.Maybe as Y---key_proto_field_index = Name "proto_field_index"---- | Note: follows the Protobuf Style Guide (https://protobuf.dev/programming-guides/style)-moduleToProtobuf :: Module -> Flow Graph (M.Map FilePath String)-moduleToProtobuf mod = do-    files <- transformModule protobufLanguage encodeTerm constructModule mod-    return $ M.fromList (mapPair <$> M.toList files)-  where-    mapPair (path, sf) = (path, printExpr $ parenthesize $ writeProtoFile sf)-    encodeTerm _ = fail "term-level encoding is not yet supported"------javaMultipleFilesOptionName = "java_multiple_files"-javaPackageOptionName = "java_package"--checkIsStringType :: Type -> Flow Graph ()-checkIsStringType typ = case simplifyType typ of-  TypeLiteral lt -> case lt of-    LiteralTypeString -> pure ()-    _ -> unexpected "string type" $ show lt-  TypeVariable name -> requireType name >>= checkIsStringType-  _ -> unexpected "literal (string) type" $ show typ--constructModule :: Module-  -> M.Map Type (Coder Graph Graph Term ())-  -> [(Element, TypedTerm)]-  -> Flow Graph (M.Map FilePath P3.ProtoFile)-constructModule mod@(Module ns els _ _ desc) _ pairs = do-    schemaImports <- (fmap namespaceToFileReference . S.toList) <$> moduleDependencyNamespaces True False False False mod-    types <- CM.mapM toType pairs-    definitions <- CM.mapM toDef types-    let pfile = P3.ProtoFile {-      P3.protoFilePackage = namespaceToPackageName ns,-      P3.protoFileImports = schemaImports ++ (wrapperImport $ snd <$> types) ++ (emptyImport $ snd <$> types),-      P3.protoFileTypes = definitions,-      P3.protoFileOptions = descOption:javaOptions}-    return $ M.singleton path pfile-  where-    javaOptions = [-      P3.Option javaMultipleFilesOptionName $ P3.ValueBoolean True,-      P3.Option javaPackageOptionName $ P3.ValueString $ P3.unPackageName $ namespaceToPackageName ns]-    descOption = P3.Option descriptionOptionName $ P3.ValueString $-      (Y.maybe "" (\d -> d ++ "\n\n") desc) ++ warningAutoGeneratedFile-    path = P3.unFileReference $ namespaceToFileReference ns-    toType (el, (TypedTerm term typ)) = do-      if isType typ-        then do-          t <- coreDecodeType term-          return (el, t)-        else fail $ "mapping of non-type elements to PDL is not yet supported: " ++ unName (elementName el)-    toDef (el, typ) = do-      typ <- coreDecodeType $ elementData el-      adaptAndEncodeType protobufLanguage (encodeDefinition ns (elementName el)) $ flattenType typ-    checkFields checkType checkFieldType types = L.foldl (||) False (hasMatches <$> types)-      where-        hasMatches = foldOverType TraversalOrderPre (\b t -> b || hasMatch t) False-        hasMatch typ = case checkType typ of-          Just b -> b-          Nothing -> case typ of-            TypeRecord rt -> checkRowType rt-            TypeUnion rt -> checkRowType rt-            _ -> False-        checkRowType (RowType _ fields) = L.foldl (||) False (checkField <$> fields)-        checkField (FieldType _ typ) = checkFieldType $ stripType typ-    wrapperImport types = if checkFields (const Nothing) isOptionalScalarField types-        then [P3.FileReference "google/protobuf/wrappers.proto"]-        else []-      where-        isOptionalScalarField typ = case typ of-          TypeOptional ot -> case stripType ot of-            TypeLiteral _ -> True-            _ -> False-          _ -> False-    emptyImport types = if checkFields checkType isUnitField types-        then [P3.FileReference "google/protobuf/empty.proto"]-        else []-      where-        checkType typ = if isEnumDefinition typ-          then Just False-          else Nothing-        isUnitField typ = case typ of-          TypeRecord (RowType name _) -> name == _Unit-          _ -> False--encodeDefinition :: Namespace -> Name -> Type -> Flow Graph P3.Definition-encodeDefinition localNs name typ = withTrace ("encoding " ++ unName name) $ do-    resetCount key_proto_field_index-    nextIndex-    options <- findOptions typ-    encode options typ-  where-    wrapAsRecordType t = TypeRecord $ RowType name [FieldType (Name "value") t]-    encode options typ = case simplifyType typ of-      TypeRecord rt -> P3.DefinitionMessage <$> encodeRecordType localNs options rt-      TypeUnion rt -> if isEnumDefinition typ-        then P3.DefinitionEnum <$> encodeEnumDefinition options rt-        else encode options $ wrapAsRecordType $ TypeUnion rt-      t -> encode options $ wrapAsRecordType t--encodeEnumDefinition :: [P3.Option] -> RowType -> Flow Graph P3.EnumDefinition-encodeEnumDefinition options (RowType tname fields) = do-    values <- CM.zipWithM encodeEnumField fields [1..]-    return $ P3.EnumDefinition {-      P3.enumDefinitionName = encodeTypeName tname,-      P3.enumDefinitionValues = unspecifiedField:values,-      P3.enumDefinitionOptions = options}-  where-    unspecifiedField = P3.EnumValue {-      P3.enumValueName = encodeEnumValueName tname $ Name "unspecified",-      P3.enumValueNumber = 0,-      P3.enumValueOptions = []}-    encodeEnumField (FieldType fname ftype) idx = do-      opts <- findOptions ftype-      return $ P3.EnumValue {-        P3.enumValueName = encodeEnumValueName tname fname,-        P3.enumValueNumber = idx,-        P3.enumValueOptions = opts}--encodeEnumValueName :: Name -> Name -> P3.EnumValueName-encodeEnumValueName tname fname = P3.EnumValueName (prefix ++ "_" ++ suffix)-  where-    prefix = nonAlnumToUnderscores $ convertCaseCamelToUpperSnake $ localNameOfEager tname-    suffix = nonAlnumToUnderscores $ convertCaseCamelToUpperSnake $ unName fname--encodeFieldName :: Bool -> Name -> P3.FieldName-encodeFieldName preserve = P3.FieldName . toPname . unName-  where-    toPname = if preserve-      then id-      else convertCaseCamelToLowerSnake--encodeFieldType :: Namespace -> FieldType -> Flow Graph P3.Field-encodeFieldType localNs (FieldType fname ftype) = withTrace ("encode field " ++ show (unName fname)) $ do-    options <- findOptions ftype-    ft <- encodeType ftype-    idx <- nextIndex-    preserve <- readBooleanAnnotation key_preserveFieldName ftype-    return $ P3.Field {-      P3.fieldName = encodeFieldName preserve fname,-      P3.fieldJsonName = Nothing,-      P3.fieldType = ft,-      P3.fieldNumber = idx,-      P3.fieldOptions = options}-  where-    encodeType typ = case simplifyType typ of-      TypeList lt -> do-        P3.FieldTypeRepeated <$> encodeSimpleType lt-      TypeMap (MapType kt vt) -> do---        checkIsStringType kt-        P3.FieldTypeMap <$> encodeSimpleType vt-      TypeOptional ot -> case stripType ot of-        TypeLiteral lt -> P3.FieldTypeSimple <$> encodeScalarTypeWrapped lt-        _ -> encodeType ot -- TODO-      TypeUnion (RowType _ fields) -> do-        pfields <- CM.mapM (encodeFieldType localNs) fields-        return $ P3.FieldTypeOneof pfields-      _ -> do-        P3.FieldTypeSimple <$> encodeSimpleType typ-    encodeSimpleType typ = case simplifyType typ of-      TypeLiteral lt -> P3.SimpleTypeScalar <$> encodeScalarType lt-      TypeRecord (RowType name _) -> if name == _Unit-        then pure $ P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf.Empty"-        else forNominal name-      TypeUnion (RowType name _) -> forNominal name-      TypeVariable name -> forNominal name-      t -> unexpected "simple type" $ show $ removeTypeAnnotations t-      where-        forNominal name = pure $ P3.SimpleTypeReference $ encodeTypeReference localNs name--encodeRecordType :: Namespace -> [P3.Option] -> RowType -> Flow Graph P3.MessageDefinition-encodeRecordType localNs options (RowType tname fields) = do-    pfields <- CM.mapM (encodeFieldType localNs) fields-    return P3.MessageDefinition {-      P3.messageDefinitionName = encodeTypeName tname,-      P3.messageDefinitionFields = pfields,-      P3.messageDefinitionOptions = options}--encodeScalarType :: LiteralType -> Flow s P3.ScalarType-encodeScalarType lt = case lt of-  LiteralTypeBinary -> return P3.ScalarTypeBytes-  LiteralTypeBoolean -> return P3.ScalarTypeBool-  LiteralTypeFloat ft -> case ft of-    FloatTypeFloat32 -> return P3.ScalarTypeFloat-    FloatTypeFloat64 -> return P3.ScalarTypeDouble-    _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft-  LiteralTypeInteger it -> case it of-    IntegerTypeInt32 -> return P3.ScalarTypeInt32-    IntegerTypeInt64 -> return P3.ScalarTypeInt64-    IntegerTypeUint32 -> return P3.ScalarTypeUint32-    IntegerTypeUint64 -> return P3.ScalarTypeUint64-    _ -> unexpected "32-bit or 64-bit integer type" $ show it-  LiteralTypeString -> return P3.ScalarTypeString--encodeScalarTypeWrapped :: LiteralType -> Flow s P3.SimpleType-encodeScalarTypeWrapped lt = toType <$> case lt of-    LiteralTypeBinary -> return "Bytes"-    LiteralTypeBoolean -> return "Bool"-    LiteralTypeFloat ft -> case ft of-      FloatTypeFloat32 -> return "Float"-      FloatTypeFloat64 -> return "Double"-      _ -> unexpected "32-bit or 64-bit floating-point type" $ show ft-    LiteralTypeInteger it -> case it of-      IntegerTypeInt32 -> return "Int32"-      IntegerTypeInt64 -> return "Int64"-      IntegerTypeUint32 -> return "UInt32"-      IntegerTypeUint64 -> return "UInt64"-      _ -> unexpected "32-bit or 64-bit integer type" $ show it-    LiteralTypeString -> return "String"-  where-    toType label = P3.SimpleTypeReference $ P3.TypeName $ "google.protobuf." ++ label ++ "Value"--encodeTypeName :: Name -> P3.TypeName-encodeTypeName = P3.TypeName . localNameOfEager--encodeTypeReference :: Namespace -> Name -> P3.TypeName-encodeTypeReference localNs name = P3.TypeName $ if nsParts == Just localNsParts-    then local-    else case nsParts of-      Nothing -> local-      Just parts -> L.intercalate "." (parts ++ [local])-  where-    QualifiedName ns local = qualifyNameEager name-    nsParts = fmap (\n -> L.init $ Strings.splitOn "/" $ unNamespace n) ns-    localNsParts = L.init $ Strings.splitOn "/" $ unNamespace localNs---- Eliminate type lambdas and type applications, simply replacing type variables with the string type-flattenType :: Type -> Type-flattenType = rewriteType f-  where-   f recurse typ = case typ of-     TypeLambda (LambdaType v body) -> recurse $ replaceFreeName v Types.string body-     TypeApplication (ApplicationType lhs _) -> recurse lhs-     _ -> recurse typ--findOptions :: Type -> Flow Graph [P3.Option]-findOptions typ = do-  mdesc <- getTypeDescription typ-  bdep <- readBooleanAnnotation key_deprecated typ-  let mdescAnn = fmap (\desc -> P3.Option descriptionOptionName $ P3.ValueString desc) mdesc-  let mdepAnn = if bdep then Just (P3.Option deprecatedOptionName $ P3.ValueBoolean True) else Nothing-  return $ Y.catMaybes [mdescAnn, mdepAnn]--isEnumFields :: [FieldType] -> Bool-isEnumFields fields = L.foldl (&&) True $ fmap isEnumField fields-  where-    isEnumField = isUnitType . simplifyType . fieldTypeType--isEnumDefinition :: Type -> Bool-isEnumDefinition typ = case simplifyType typ of-  TypeUnion (RowType _ fields) -> isEnumFields fields-  _ -> False--isEnumDefinitionReference :: Name -> Flow Graph Bool-isEnumDefinitionReference name = isEnumDefinition <$> ((elementData <$> requireElement name) >>= coreDecodeType)--namespaceToFileReference :: Namespace -> P3.FileReference-namespaceToFileReference (Namespace ns) = P3.FileReference $ pns ++ ".proto"-  where-    pns = Strings.intercalate "/" (convertCaseCamelToLowerSnake <$> (Strings.splitOn "/" ns))--namespaceToPackageName :: Namespace -> P3.PackageName-namespaceToPackageName (Namespace ns) = P3.PackageName $ Strings.intercalate "." $-  convertCaseCamelToLowerSnake <$> (L.init $ Strings.splitOn "/" ns)--nextIndex :: Flow s Int-nextIndex = nextCount key_proto_field_index--readBooleanAnnotation :: Name -> Type -> Flow Graph Bool-readBooleanAnnotation key typ = do-  let ann = typeAnnotationInternal typ-  case TR.readMaybe $ show ann of-    Just kv -> case getAnnotation key kv of-      Just _ -> return True-      Nothing -> return False-    Nothing -> return False---- Note: this should probably be done in the term adapters-simplifyType :: Type -> Type-simplifyType typ = case stripType typ of-  TypeWrap (WrappedType _ t) -> simplifyType t-  t -> t
− src/main/haskell/Hydra/Ext/Protobuf/Serde.hs 
@@ -1,147 +0,0 @@-module Hydra.Ext.Protobuf.Serde (-  deprecatedOptionName,-  descriptionOptionName,-  writeProtoFile) where--import Hydra.Tools.Serialization-import Hydra.Tools.Formatting-import qualified Hydra.Ast as CT-import qualified Hydra.Ext.Protobuf.Proto3 as P3--import qualified Data.List as L-import qualified Data.Maybe as Y---deprecatedOptionName = "deprecated"--- A special Protobuf option for descriptions (documentation)-descriptionOptionName = "_description"--excludeInternalOptions :: [P3.Option] -> [P3.Option]-excludeInternalOptions = L.filter (\opt -> L.head (P3.optionName opt) /= '_' )--protoBlock :: [CT.Expr] -> CT.Expr-protoBlock = brackets curlyBraces fullBlockStyle . doubleNewlineSep--semi :: CT.Expr -> CT.Expr-semi e = noSep [e, cst ";"]--optDesc :: Bool -> [P3.Option] -> CT.Expr -> CT.Expr-optDesc doubleNewline opts expr = if L.null descs-    then expr-    else sep [cst $ asComment (unValue $ P3.optionValue $ L.head descs), expr]-  where-    sep = if doubleNewline then doubleNewlineSep else newlineSep-    descs = L.filter (\(P3.Option name value) -> name == descriptionOptionName) opts-    asComment = L.intercalate "\n" . fmap (\s -> "// " ++ s) . lines-    unValue v = case v of-      P3.ValueBoolean b -> if b then "true" else "false"-      P3.ValueString s -> s--writeDefinition :: P3.Definition -> CT.Expr-writeDefinition def = case def of-  P3.DefinitionEnum enum -> writeEnumDefinition enum-  P3.DefinitionMessage msg -> writeMessageDefinition msg--writeEnumDefinition :: P3.EnumDefinition -> CT.Expr-writeEnumDefinition (P3.EnumDefinition name values options) = optDesc False options $ spaceSep [-  cst "enum",-  cst $ P3.unTypeName name,-  protoBlock (writeEnumValue <$> values)]--writeEnumValue :: P3.EnumValue -> CT.Expr-writeEnumValue (P3.EnumValue name number options) = optDesc False options $ semi $ spaceSep [-    cst $ P3.unEnumValueName name,-    cst "=",-    cst $ show number]--writeField :: P3.Field -> CT.Expr-writeField (P3.Field name jsonName typ num options) = optDesc False options $ case typ of-  P3.FieldTypeOneof fields -> spaceSep [-    cst "oneof",-    cst $ P3.unFieldName name,-    protoBlock (writeField <$> fields)]-  _ -> semi $ spaceSep $ Y.catMaybes [ -- TODO: jsonName-    Just $ writeFieldType typ,-    Just $ cst $ P3.unFieldName name,-    Just $ cst "=",-    Just $ cst $ show num,-    writeFieldOptions options]--writeFieldOption :: P3.Option -> CT.Expr-writeFieldOption (P3.Option name value) = spaceSep [cst name, cst "=", writeValue value]--writeFieldOptions :: [P3.Option] -> Y.Maybe CT.Expr-writeFieldOptions options0 = if L.null options-    then Nothing-    else Just $ bracketList inlineStyle (writeFieldOption <$> options)-  where-    options = excludeInternalOptions options0--writeFieldType :: P3.FieldType -> CT.Expr-writeFieldType ftyp = case ftyp of-  P3.FieldTypeMap st -> noSep [cst "map", angleBracesList inlineStyle [cst "string", writeSimpleType st]]-  P3.FieldTypeRepeated st -> spaceSep [cst "repeated", writeSimpleType st]-  P3.FieldTypeSimple st -> writeSimpleType st--writeFileOption :: P3.Option -> CT.Expr-writeFileOption (P3.Option name value) = semi $ spaceSep [cst "option", cst name, cst "=", writeValue value]--writeFileOptions :: [P3.Option] -> Y.Maybe CT.Expr-writeFileOptions options0 = if L.null options-    then Nothing-    else Just $ newlineSep $ writeFileOption <$> options-  where-    options = excludeInternalOptions options0--writeImport :: P3.FileReference -> CT.Expr-writeImport (P3.FileReference path) = semi $ spaceSep [cst "import", cst $ show path]--writeMessageDefinition :: P3.MessageDefinition -> CT.Expr-writeMessageDefinition (P3.MessageDefinition name fields options) = optDesc False options $ spaceSep [-  cst "message",-  cst $ P3.unTypeName name,-  protoBlock (writeField <$> fields)]--writeProtoFile :: P3.ProtoFile -> CT.Expr-writeProtoFile (P3.ProtoFile pkg imports defs options) = optDesc True options $ doubleNewlineSep-    $ Y.catMaybes [headerSec, importsSec, optionsSec, defsSec]-  where-    headerSec = Just $ newlineSep [-      semi $ cst "syntax = \"proto3\"",-      semi $ spaceSep [cst "package", cst (P3.unPackageName pkg)]]-    importsSec = if L.null imports-      then Nothing-      else Just $ newlineSep $ writeImport <$> imports-    optionsSec = writeFileOptions options1-    defsSec = if L.null defs-      then Nothing-      else Just $ doubleNewlineSep $ writeDefinition <$> defs-    options1 = L.filter (\(P3.Option name value) -> name /= descriptionOptionName) options--writeScalarType :: P3.ScalarType -> CT.Expr-writeScalarType sct = cst $ case sct of-  P3.ScalarTypeBool -> "bool"-  P3.ScalarTypeBytes -> "bytes"-  P3.ScalarTypeDouble -> "double"-  P3.ScalarTypeFixed32 -> "fixed32"-  P3.ScalarTypeFixed64 -> "fixed64"-  P3.ScalarTypeFloat -> "float"-  P3.ScalarTypeInt32 -> "int32"-  P3.ScalarTypeInt64 -> "int64"-  P3.ScalarTypeSfixed32 -> "sfixed32"-  P3.ScalarTypeSfixed64 -> "sfixed64"-  P3.ScalarTypeSint32 -> "sint32"-  P3.ScalarTypeSint64 -> "sint64"-  P3.ScalarTypeString -> "string"-  P3.ScalarTypeUint32 -> "uint32"-  P3.ScalarTypeUint64 -> "uint64"--writeSimpleType :: P3.SimpleType -> CT.Expr-writeSimpleType st = case st of-  P3.SimpleTypeReference name -> cst $ P3.unTypeName name-  P3.SimpleTypeScalar sct -> writeScalarType sct--writeValue :: P3.Value -> CT.Expr-writeValue v = cst $ case v of-  P3.ValueBoolean b -> if b then "true" else "false"-  P3.ValueString s -> show s
− src/main/haskell/Hydra/Ext/Rdf/Serde.hs 
@@ -1,81 +0,0 @@--- | Serialize RDF using an approximation (because it does not yet support Unicode escape sequences) of the N-triples format--module Hydra.Ext.Rdf.Serde (-  rdfGraphToNtriples,-) where--import Hydra.Tools.Serialization-import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf-import qualified Hydra.Ast as CT--import qualified Data.List as L-import qualified Data.Set as S----- IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>'--- TODO: Unicode escape sequences-escapeIriStr :: String -> String-escapeIriStr s = L.concat (esc <$> s)-  where-    esc c = if c >= '\128' || c <= '\32' || S.member c others-      then "?"-      else [c]-    others = S.fromList $ "<>\"{}|^`\\"---- STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'--- TODO: Unicode escape sequences-escapeLiteralString :: String -> String-escapeLiteralString s = L.concat (esc <$> s)-  where-    esc c = if c >= '\128'-      then "?"-      else case c of-        '\"' -> "\\\""-        '\\' -> "\\\\"-        '\n' -> "\\n"-        '\r' -> "\\r"-        _ -> [c]--rdfGraphToNtriples :: Rdf.Graph -> String-rdfGraphToNtriples = printExpr . writeGraph--writeBlankNode :: Rdf.BlankNode -> CT.Expr-writeBlankNode bnode = noSep [cst "_:", cst $ Rdf.unBlankNode bnode]--writeGraph :: Rdf.Graph -> CT.Expr-writeGraph g = newlineSep (writeTriple <$> (S.toList $ Rdf.unGraph g))--writeIri :: Rdf.Iri -> CT.Expr-writeIri iri = noSep [cst "<", cst $ escapeIriStr $ Rdf.unIri iri, cst ">"]---- LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)*--- Note: we simply trust language tags to be valid-writeLanguageTag :: Rdf.LanguageTag -> CT.Expr-writeLanguageTag lang = noSep [cst "@", cst $ Rdf.unLanguageTag lang]--writeLiteral :: Rdf.Literal -> CT.Expr-writeLiteral lit = noSep [cst lex, suffix]-  where-    suffix = case Rdf.literalLanguageTag lit of-      Nothing -> noSep [cst "^^", writeIri dt]-      Just lang -> writeLanguageTag lang-    lex = "\"" ++ (escapeLiteralString $ Rdf.literalLexicalForm lit) ++ "\""-    dt = Rdf.literalDatatypeIri lit--writeNode :: Rdf.Node -> CT.Expr-writeNode n = case n of-  Rdf.NodeIri iri -> writeIri iri-  Rdf.NodeBnode bnode -> writeBlankNode bnode-  Rdf.NodeLiteral lit -> writeLiteral lit--writeResource :: Rdf.Resource -> CT.Expr-writeResource r = case r of-  Rdf.ResourceIri iri -> writeIri iri-  Rdf.ResourceBnode bnode -> writeBlankNode bnode--writeTriple :: Rdf.Triple -> CT.Expr-writeTriple t = spaceSep [-    writeResource $ Rdf.tripleSubject t,-    writeIri $ Rdf.triplePredicate t,-    writeNode $ Rdf.tripleObject t,-    cst "."]
− src/main/haskell/Hydra/Ext/Rdf/Utils.hs 
@@ -1,89 +0,0 @@-module Hydra.Ext.Rdf.Utils where--import Hydra.Kernel-import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S---key_rdfBlankNodeCounter = Name "rdfBlankNodeCounter"--descriptionsToGraph :: [Rdf.Description] -> Rdf.Graph-descriptionsToGraph ds = Rdf.Graph $ S.fromList $ triplesOf ds--emptyDescription :: Rdf.Node -> Rdf.Description-emptyDescription node = Rdf.Description node emptyGraph--emptyGraph :: Rdf.Graph-emptyGraph = Rdf.Graph S.empty--emptyLangStrings :: Rdf.LangStrings-emptyLangStrings = Rdf.LangStrings M.empty--encodeLiteral :: Literal -> Flow (Graph) Rdf.Literal-encodeLiteral lit = case lit of-    LiteralBinary s -> fail "base 64 encoding not yet implemented"-    LiteralBoolean b -> pure $ xsd (\b -> if b then "true" else "false") b "boolean"-    LiteralFloat f -> pure $ case f of-      FloatValueBigfloat v -> xsd show v "decimal"-      FloatValueFloat32 v -> xsd show v "float"-      FloatValueFloat64 v -> xsd show v "double"-    LiteralInteger i -> pure $ case i of-      IntegerValueBigint v -> xsd show v "integer"-      IntegerValueInt8 v   -> xsd show v "byte"-      IntegerValueInt16 v  -> xsd show v "short"-      IntegerValueInt32 v  -> xsd show v "int"-      IntegerValueInt64 v  -> xsd show v "long"-      IntegerValueUint8 v  -> xsd show v "unsignedByte"-      IntegerValueUint16 v -> xsd show v "unsignedShort"-      IntegerValueUint32 v -> xsd show v "unsignedInt"-      IntegerValueUint64 v -> xsd show v "unsignedLong"-    LiteralString s -> pure $ xsd id s "string"-  where-    -- TODO: using Haskell's built-in show function is a cheat, and may not be correct/optimal in all cases-    xsd ser x local = Rdf.Literal (ser x) (xmlSchemaDatatypeIri local) Nothing--forObjects :: Rdf.Resource -> Rdf.Iri -> [Rdf.Node] -> [Rdf.Triple]-forObjects subj pred objs = (Rdf.Triple subj pred) <$> objs--iri :: String -> String -> Rdf.Iri-iri ns local = Rdf.Iri $ ns ++ local--keyIri :: String -> Rdf.Iri-keyIri = iri "urn:key:" -- Note: not an official URN scheme--mergeGraphs :: [Rdf.Graph] -> Rdf.Graph-mergeGraphs graphs = Rdf.Graph $ L.foldl S.union S.empty (Rdf.unGraph <$> graphs)--nameToIri :: Name -> Rdf.Iri-nameToIri name = Rdf.Iri $ "urn:" ++ unName name--nextBlankNode :: Flow (Graph) Rdf.Resource-nextBlankNode = do-  count <- nextCount key_rdfBlankNodeCounter-  return $ Rdf.ResourceBnode $ Rdf.BlankNode $ "b" ++ show count---- Note: these are not "proper" URNs, as they do not use an established URN scheme-propertyIri :: Name -> Name -> Rdf.Iri-propertyIri rname fname = Rdf.Iri $ "urn:" ++ unNamespace gname ++ "#" ++ decapitalize local ++ capitalize (unName fname)-  where-    QualifiedName (Just gname) local = qualifyNameLazy rname--rdfIri :: String -> Rdf.Iri-rdfIri = iri "http://www.w3.org/1999/02/22-rdf-syntax-ns#"--resourceToNode :: Rdf.Resource -> Rdf.Node-resourceToNode r = case r of-  Rdf.ResourceIri i -> Rdf.NodeIri i-  Rdf.ResourceBnode b -> Rdf.NodeBnode b--subjectsOf :: [Rdf.Description] -> [Rdf.Node]-subjectsOf descs = Rdf.descriptionSubject <$> descs--triplesOf :: [Rdf.Description] -> [Rdf.Triple]-triplesOf descs = L.concat ((S.toList . Rdf.unGraph . Rdf.descriptionGraph) <$> descs)--xmlSchemaDatatypeIri :: String -> Rdf.Iri-xmlSchemaDatatypeIri = iri "http://www.w3.org/2001/XMLSchema#"
− src/main/haskell/Hydra/Ext/Scala/Coder.hs 
@@ -1,227 +0,0 @@-module Hydra.Ext.Scala.Coder (moduleToScala) where--import Hydra.Kernel-import Hydra.Dsl.Terms-import Hydra.Ext.Scala.Language-import Hydra.Ext.Scala.Utils-import Hydra.Adapters-import Hydra.Tools.Serialization-import Hydra.Ext.Scala.Serde-import qualified Hydra.Dsl.Types as Types-import qualified Hydra.Ext.Scala.Meta as Scala-import qualified Hydra.Lib.Strings as Strings--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---moduleToScala :: Module -> Flow Graph (M.Map FilePath String)-moduleToScala mod = do-  pkg <- moduleToScalaPackage mod-  let s = printExpr $ parenthesize $ writePkg pkg-  return $ M.fromList [(namespaceToFilePath False (FileExtension "scala") $ moduleNamespace mod, s)]--moduleToScalaPackage :: Module -> Flow Graph Scala.Pkg-moduleToScalaPackage = transformModule scalaLanguage encodeUntypedTerm constructModule--constructModule :: Module -> M.Map Type (Coder Graph Graph Term Scala.Data) -> [(Element, TypedTerm)]-  -> Flow Graph Scala.Pkg-constructModule mod coders pairs = do-    defs <- CM.mapM toDef pairs-    let pname = toScalaName $ h $ moduleNamespace mod-    let pref = Scala.Data_RefName pname-    imports <- findImports-    return $ Scala.Pkg pname pref (imports ++ defs)-  where-    h (Namespace n) = n-    findImports = do-        elImps <- moduleDependencyNamespaces False False True False mod-        primImps <- moduleDependencyNamespaces False True False False mod-        return $ (toElImport <$> S.toList elImps) ++ (toPrimImport <$> S.toList primImps)-      where-        toElImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [-          Scala.Importer (Scala.Data_RefName $ toScalaName ns) [Scala.ImporteeWildcard]]-        toPrimImport (Namespace ns) = Scala.StatImportExport $ Scala.ImportExportStatImport $ Scala.Import [-          Scala.Importer (Scala.Data_RefName $ toScalaName ns) []]-    toScalaName name = Scala.Data_Name $ Scala.PredefString $ L.intercalate "." $ Strings.splitOn "/" name-    toDef (el, TypedTerm term typ) = withTrace ("element " ++ unName (elementName el)) $ do-        let coder = Y.fromJust $ M.lookup typ coders-        rhs <- coderEncode coder term-        Scala.StatDefn <$> case rhs of-          Scala.DataApply _ -> toVal rhs-          Scala.DataFunctionData fun -> case stripType typ of-            TypeFunction (FunctionType _ cod) -> toDefn fun cod-            _ -> fail $ "expected function type, but found " ++ show typ-          Scala.DataLit _ -> toVal rhs-          Scala.DataRef _ -> toVal rhs -- TODO-          _ -> fail $ "unexpected RHS: " ++ show rhs-      where-        lname = localNameOfEager $ elementName el--        freeTypeVars = S.toList $ freeVariablesInType typ--        toDefn (Scala.Data_FunctionDataFunction (Scala.Data_Function params body)) cod = do-          let tparams = stparam <$> freeTypeVars-          scod <- encodeType cod-          return $ Scala.DefnDef $ Scala.Defn_Def []-            (Scala.Data_Name $ Scala.PredefString lname) tparams [params] (Just scod) body--        toVal rhs = pure $ Scala.DefnVal $ Scala.Defn_Val [] [namePat] Nothing rhs-          where-            namePat = Scala.PatVar $ Scala.Pat_Var $ Scala.Data_Name $ Scala.PredefString lname--encodeFunction :: M.Map Name Term -> Function -> Y.Maybe Term -> Flow Graph Scala.Data-encodeFunction meta fun arg = case fun of-    FunctionLambda (Lambda (Name v) _ body) -> slambda v <$> encodeTerm body <*> findSdom-    FunctionPrimitive name -> pure $ sprim name-    FunctionElimination e -> case e of-      EliminationWrap name -> pure $ sname $ "ELIM-NOMINAL(" ++ show name ++ ")" -- TODO-      EliminationOptional c -> pure $ sname "ELIM-OPTIONAL" -- TODO-      EliminationRecord p -> fail "unapplied projection not yet supported"-      EliminationUnion (CaseStatement _ def cases) -> do-          let v = "v"-          dom <- findDomain-          ftypes <- withSchemaContext $ fieldTypes dom-          cx <- getState-          let sn = nameOfType cx dom-          scases <- CM.mapM (encodeCase ftypes sn) cases-          -- TODO: default-          case arg of-            Nothing -> slambda v <$> pure (Scala.DataMatch $ Scala.Data_Match (sname v) scases) <*> findSdom-            Just a -> do-              sa <- encodeTerm a-              return $ Scala.DataMatch $ Scala.Data_Match sa scases-        where-          encodeCase ftypes sn f@(Field fname fterm) = do-  --            dom <- findDomain (termMeta fterm)           -- Option #1: use type inference-              let dom = Y.fromJust $ M.lookup fname ftypes -- Option #2: look up the union type-              let patArgs = if dom == Types.unit then [] else [svar v]-              -- Note: PatExtract has the right syntax, though this may or may not be the Scalameta-intended way to use it-              let pat = Scala.PatExtract $ Scala.Pat_Extract (sname $ qualifyUnionFieldName "MATCHED." sn fname) patArgs-              body <- encodeTerm $ applyVar fterm v-              return $ Scala.Case pat Nothing body-            where-              v = Name "y"-          applyVar fterm avar@(Name v) = case stripTerm fterm of-            TermFunction (FunctionLambda (Lambda v1 _ body)) -> if isFreeIn v1 body-              then body-              else substituteVariable v1 avar body-            _ -> apply fterm (var v)-  where-    findSdom = Just <$> (findDomain >>= encodeType)-    findDomain = do-        cx <- getState-        r <- getType meta-        case r of-          Nothing -> fail "expected a typed term"-          Just t -> domainOf t-      where-        domainOf t = case stripType t of-          TypeFunction (FunctionType dom _) -> pure dom-          _ -> fail $ "expected a function type, but found " ++ show t--encodeLiteral :: Literal -> Flow Graph Scala.Lit-encodeLiteral av = case av of-    LiteralBoolean b -> pure $ Scala.LitBoolean b-    LiteralFloat fv -> case fv of-      FloatValueFloat32 f -> pure $ Scala.LitFloat f-      FloatValueFloat64 f -> pure $ Scala.LitDouble f-      _ -> unexpected "floating-point number" $ show fv-    LiteralInteger iv -> case iv of-      IntegerValueInt16 i -> pure $ Scala.LitShort $ fromIntegral i-      IntegerValueInt32 i -> pure $ Scala.LitInt i-      IntegerValueInt64 i -> pure $ Scala.LitLong $ fromIntegral i-      IntegerValueUint8 i -> pure $ Scala.LitByte $ fromIntegral i-      _ -> unexpected "integer" $ show iv-    LiteralString s -> pure $ Scala.LitString s-    _ -> unexpected "literal value" $ show av--encodeTerm :: Term -> Flow Graph Scala.Data-encodeTerm term = case stripTerm term of-    TermApplication (Application fun arg) -> case stripTerm fun of-        TermFunction f -> case f of-          FunctionElimination e -> case e of-            EliminationWrap name -> fallback-            EliminationOptional c -> fallback-            EliminationRecord (Projection _ (Name fname)) -> do-              sarg <- encodeTerm arg-              return $ Scala.DataRef $ Scala.Data_RefSelect $ Scala.Data_Select sarg-                (Scala.Data_Name $ Scala.PredefString fname)-            EliminationUnion _ -> do-              cx <- getState-              encodeFunction (termAnnotationInternal fun) f (Just arg)-          _ -> fallback-        _ -> fallback-      where-        fallback = sapply <$> encodeTerm fun <*> ((: []) <$> encodeTerm arg)-    TermFunction f -> do-      cx <- getState-      encodeFunction (termAnnotationInternal term) f Nothing-    TermList els -> sapply (sname "Seq") <$> CM.mapM encodeTerm els-    TermLiteral v -> Scala.DataLit <$> encodeLiteral v-    TermMap m -> sapply (sname "Map") <$> CM.mapM toPair (M.toList m)-      where-        toPair (k, v) = sassign <$> encodeTerm k <*> encodeTerm v-    TermWrap (WrappedTerm _ term') -> encodeTerm term'-    TermOptional m -> case m of-      Nothing -> pure $ sname "None"-      Just t -> (\s -> sapply (sname "Some") [s]) <$> encodeTerm t-    TermRecord (Record name fields) -> do-      let n = scalaTypeName False name-      args <- CM.mapM encodeTerm (fieldTerm <$> fields)-      return $ sapply (sname n) args-    TermSet s -> sapply (sname "Set") <$> CM.mapM encodeTerm (S.toList s)-    TermUnion (Injection sn (Field fn ft)) -> do-      let lhs = sname $ qualifyUnionFieldName "UNION." (Just sn) fn-      args <- case stripTerm ft of-        TermRecord (Record _ []) -> pure []-        _ -> do-          arg <- encodeTerm ft-          return [arg]-      return $ sapply lhs args-    TermVariable (Name v) -> pure $ sname v-    _ -> fail $ "unexpected term: " ++ show term---encodeType :: Type -> Flow Graph Scala.Type-encodeType t = case stripType t of-  TypeFunction (FunctionType dom cod) -> do-    sdom <- encodeType dom-    scod <- encodeType cod-    return $ Scala.TypeFunctionType $ Scala.Type_FunctionTypeFunction $ Scala.Type_Function [sdom] scod-  TypeList lt -> stapply1 <$> pure (stref "Seq") <*> encodeType lt-  TypeLiteral lt -> case lt of---    TypeBinary ->-    LiteralTypeBoolean -> pure $ stref "Boolean"-    LiteralTypeFloat ft -> case ft of---      FloatTypeBigfloat ->-      FloatTypeFloat32 -> pure $ stref "Float"-      FloatTypeFloat64 -> pure $ stref "Double"-    LiteralTypeInteger it -> case it of---      IntegerTypeBigint ->---      IntegerTypeInt8 ->-      IntegerTypeInt16 -> pure $ stref "Short"-      IntegerTypeInt32 -> pure $ stref "Int"-      IntegerTypeInt64 -> pure $ stref "Long"-      IntegerTypeUint8 -> pure $ stref "Byte"---      IntegerTypeUint16 ->---      IntegerTypeUint32 ->---      IntegerTypeUint64 ->-    LiteralTypeString -> pure $ stref "String"-  TypeMap (MapType kt vt) -> stapply2 <$> pure (stref "Map") <*> encodeType kt <*> encodeType vt-  TypeOptional ot -> stapply1 <$> pure (stref "Option") <*> encodeType ot---  TypeRecord sfields ->-  TypeSet st -> stapply1 <$> pure (stref "Set") <*> encodeType st---  TypeUnion sfields ->-  TypeLambda (LambdaType v body) -> do-    sbody <- encodeType body-    return $ Scala.TypeLambda $ Scala.Type_Lambda [stparam v] sbody---   TypeVariable name -> pure $ stref $ scalaTypeName True name-  TypeVariable (Name v) -> pure $ Scala.TypeVar $ Scala.Type_Var $ Scala.Type_Name v-  _ -> fail $ "can't encode unsupported type in Scala: " ++ show t--encodeUntypedTerm :: Term -> Flow Graph Scala.Data-encodeUntypedTerm term = inferTermType term >>= encodeTerm
− src/main/haskell/Hydra/Ext/Scala/Language.hs 
@@ -1,71 +0,0 @@-module Hydra.Ext.Scala.Language where--import Hydra.Kernel--import qualified Data.Set as S---scalaLanguage :: Language-scalaLanguage = Language (LanguageName "hydra/ext/scala") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.fromList eliminationVariants,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBoolean,-    LiteralVariantFloat,-    LiteralVariantInteger,-    LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [-    -- Bigfloat is excluded for now-    FloatTypeFloat32,-    FloatTypeFloat64],-  languageConstraintsFunctionVariants = S.fromList functionVariants,-  languageConstraintsIntegerTypes = S.fromList [-    IntegerTypeBigint,-    IntegerTypeInt16,-    IntegerTypeInt32,-    IntegerTypeInt64,-    IntegerTypeUint8],-  languageConstraintsTermVariants = S.fromList [-    TermVariantApplication,-    TermVariantFunction,-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantOptional,-    TermVariantRecord,-    TermVariantSet,-    TermVariantUnion,-    TermVariantVariable,-    TermVariantWrap],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantAnnotated,-    TypeVariantFunction,-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantOptional,-    TypeVariantRecord,-    TypeVariantSet,-    TypeVariantUnion,-    TypeVariantLambda,-    TypeVariantVariable,-    TypeVariantWrap],-  languageConstraintsTypes = const True }--reservedWords :: S.Set [Char]-reservedWords = S.fromList $ keywords ++ classNames-  where-    -- Classes in the Scala Standard Library 2.13.8-    -- Note: numbered class names like Function1, Product16, and the names of exception/error classes are omitted,-    --       as they are unlikely to occur by chance.-    classNames = [-      "Any", "AnyVal", "App", "Array", "Boolean", "Byte", "Char", "Console", "DelayedInit", "Double", "DummyExplicit",-      "Dynamic", "Enumeration", "Equals", "Float", "Function", "Int", "Long", "MatchError", "None",-      "Nothing", "Null", "Option", "PartialFunction", "Predef", "Product", "Proxy",-      "SerialVersionUID", "Short", "Singleton", "Some", "Specializable", "StringContext",-      "Symbol", "Unit", "ValueOf"]-    -- Not an official or comprehensive list; taken from https://www.geeksforgeeks.org/scala-keywords-    keywords = [-      "abstract", "case", "catch", "class", "def", "do", "else", "extends", "false", "final", "finally", "for",-      "forSome", "if", "implicit", "import", "lazy", "match", "new", "null", "object", "override", "package", "private",-      "protected", "return", "sealed", "super", "this", "throw", "trait", "true", "try", "type", "val", "var", "while",-      "with", "yield"]
− src/main/haskell/Hydra/Ext/Scala/Prepare.hs 
@@ -1,64 +0,0 @@-module Hydra.Ext.Scala.Prepare (-  prepareType,-) where--import Hydra.Kernel-import qualified Hydra.Dsl.Types as Types--import qualified Data.Set as S---prepareLiteralType :: LiteralType -> (LiteralType, Literal -> Literal, S.Set String)-prepareLiteralType at = case at of-  LiteralTypeBinary -> subst LiteralTypeString-    "binary strings" "character strings"-    $ \(LiteralBinary v) -> LiteralString v-  LiteralTypeFloat ft -> (LiteralTypeFloat rtyp, \(LiteralFloat v) -> LiteralFloat $ rep v, msgs)-    where-      (rtyp, rep, msgs) = prepareFloatType ft-  LiteralTypeInteger it -> (LiteralTypeInteger rtyp, \(LiteralInteger v) -> LiteralInteger $ rep v, msgs)-    where-      (rtyp, rep, msgs) = prepareIntegerType it-  _ -> same at--prepareFloatType :: FloatType -> (FloatType, FloatValue -> FloatValue, S.Set String)-prepareFloatType ft = case ft of-  FloatTypeBigfloat -> subst FloatTypeFloat64-    "arbitrary-precision floating-point numbers" "64-bit floating-point numbers (doubles)"-    $ \(FloatValueBigfloat v) -> FloatValueFloat64 v-  _ -> same ft--prepareIntegerType :: IntegerType -> (IntegerType, IntegerValue -> IntegerValue, S.Set String)-prepareIntegerType it = case it of-  IntegerTypeBigint -> subst IntegerTypeInt64-    "arbitrary-precision integers" "64-bit integers"-    $ \(IntegerValueBigint v) -> IntegerValueInt64 $ fromIntegral v-  IntegerTypeUint8 -> subst IntegerTypeInt8-    "unsigned 8-bit integers" "signed 8-bit integers"-    $ \(IntegerValueUint8 v) -> IntegerValueInt8 $ fromIntegral v-  IntegerTypeUint32 -> subst IntegerTypeInt32-    "unsigned 32-bit integers" "signed 32-bit integers"-    $ \(IntegerValueUint32 v) -> IntegerValueInt32 $ fromIntegral v-  IntegerTypeUint64 -> subst IntegerTypeInt64-    "unsigned 64-bit integers" "signed 64-bit integers"-    $ \(IntegerValueUint64 v) -> IntegerValueInt64 $ fromIntegral v-  _ -> same it--prepareType :: Graph -> Type -> (Type, Term -> Term, S.Set String)-prepareType cx typ = case stripType typ of-  TypeLiteral at -> (Types.literal rtyp, \(TermLiteral av) -> TermLiteral $ rep av, msgs)-    where-      (rtyp, rep, msgs) = prepareLiteralType at---  TypeFunction (FunctionType dom cod) ->---  TypeList lt ->---  TypeMap (MapType kt vt) ->---  TypeWrap name ->---  TypeRecord fields ->---  TypeSet st ->---  TypeUnion fields ->--same :: a -> (a, b -> b, S.Set c)-same x = (x, id, S.empty)--subst :: a -> [Char] -> [Char] -> b -> (a, b, S.Set [Char])-subst t from to r = (t, r, S.fromList ["replace " ++ from ++ " with " ++ to])
− src/main/haskell/Hydra/Ext/Scala/Serde.hs 
@@ -1,139 +0,0 @@-module Hydra.Ext.Scala.Serde where--import Hydra.Ast-import Hydra.Tools.Serialization-import qualified Hydra.Lib.Literals as Literals-import qualified Hydra.Ext.Scala.Meta as Scala--import qualified Data.List as L-import qualified Data.Maybe as Y---dotOp :: Op-dotOp = Op (Symbol ".") (Padding WsNone WsNone) (Precedence 0) AssociativityLeft--functionArrowOp :: Op-functionArrowOp = op "=>" (negate 1) AssociativityRight--matchOp :: Op-matchOp = Op (Symbol "match") (Padding WsSpace $ WsBreakAndIndent "  ") (Precedence 0) AssociativityNone--writeCase :: Scala.Case -> Expr-writeCase (Scala.Case pat _ term) = spaceSep [cst "case", writePat pat, cst "=>", writeTerm term]--writeDefn :: Scala.Defn -> Expr-writeDefn def = case def of-  Scala.DefnDef (Scala.Defn_Def _ name tparams [params] scod body) -> spaceSep [-      cst "def", nameAndParams, cst "=", writeTerm body]-    where-      nameAndParams = noSep $ Y.catMaybes [-        Just $ writeData_Name name,-        if L.null tparams then Nothing else Just $ bracketList inlineStyle (writeType_Param <$> tparams),-        Just $ parenList False (writeData_Param <$> params),-        fmap (\t -> spaceSep [cst ":", writeType t]) scod]-  Scala.DefnVal (Scala.Defn_Val _ [Scala.PatVar (Scala.Pat_Var (Scala.Data_Name (Scala.PredefString name)))] typ term) -> spaceSep [-      cst "val", nameAndType, cst "=", writeTerm term]-    where-      nameAndType = Y.maybe (cst name) (\t -> spaceSep [cst $ name ++ ":", writeType t]) typ--writeImportExportStat :: Scala.ImportExportStat -> Expr-writeImportExportStat ie = case ie of-  Scala.ImportExportStatImport (Scala.Import importers) -> newlineSep (writeImporter <$> importers)---  Scala.ImportExportStatExport exp ->--writeImporter :: Scala.Importer -> Expr-writeImporter (Scala.Importer (Scala.Data_RefName (Scala.Data_Name (Scala.PredefString ref))) importees) = spaceSep [-    cst "import", noSep [cst ref, forImportees importees]]-  where-    forImportee it = cst $ case it of-      Scala.ImporteeWildcard -> "*"-      Scala.ImporteeName (Scala.Importee_Name (Scala.NameValue name)) -> name-    forImportees its = if L.null its-      then cst ""-      else if L.length its == 1-      then noSep [cst ".", forImportee $ L.head its]-      else noSep [cst ".", curlyBracesList Nothing inlineStyle (forImportee <$> its)]-writeLit :: Scala.Lit -> Expr-writeLit lit = case lit of---  Scala.LitNull-  Scala.LitInt i -> cst $ Literals.showInt32 i---  Scala.LitDouble Double---  Scala.LitFloat Float---  Scala.LitByte Integer---  Scala.LitShort Integer---  Scala.LitChar Integer---  Scala.LitLong Int64-  Scala.LitBoolean b -> cst $ if b then "true" else "false"-  Scala.LitUnit -> cst "()"-  Scala.LitString s -> cst $ Literals.showString s---  Scala.LitSymbol sym ->-  _ -> cst $ Literals.showString $ "TODO:literal:" ++ show lit--writeName :: Scala.Name -> Expr-writeName name = case name of-  Scala.NameValue s -> cst s--writePat :: Scala.Pat -> Expr-writePat pat = case pat of-  Scala.PatExtract (Scala.Pat_Extract fun args) -> noSep [writeTerm fun, parenList False (writePat <$> args)]-  Scala.PatVar (Scala.Pat_Var tname) -> writeData_Name tname--writePkg :: Scala.Pkg -> Expr-writePkg (Scala.Pkg name _ stats) = doubleNewlineSep $ package:(writeStat <$> stats)-  where-    package = spaceSep [cst "package", writeData_Name name]--writeStat :: Scala.Stat -> Expr-writeStat stat = case stat of---  Scala.StatTerm Term ->---  Scala.StatDecl Decl ->-  Scala.StatDefn def -> writeDefn def-  Scala.StatImportExport ie -> writeImportExportStat ie--writeTerm :: Scala.Data -> Expr-writeTerm term = case term of-  Scala.DataLit lit -> writeLit lit-  Scala.DataRef ref -> writeData_Ref ref-  Scala.DataApply (Scala.Data_Apply fun args) -> noSep [writeTerm fun, parenList False (writeTerm <$> args)]-  Scala.DataAssign assign -> cst ">ASSIGN"-  Scala.DataTuple (Scala.Data_Tuple args) -> parenList False (writeTerm <$> args)-  Scala.DataMatch (Scala.Data_Match expr cases) -> ifx matchOp (writeTerm expr) $ newlineSep (writeCase <$> cases)-  Scala.DataFunctionData ft -> writeData_FunctionData ft--writeData_FunctionData :: Scala.Data_FunctionData -> Expr-writeData_FunctionData ft = case ft of-  Scala.Data_FunctionDataFunction (Scala.Data_Function params body) ->-    spaceSep [parenList False (writeData_Param <$> params), cst "=>", writeTerm body]--writeData_Name :: Scala.Data_Name -> Expr-writeData_Name (Scala.Data_Name (Scala.PredefString name)) = cst name--writeData_Param :: Scala.Data_Param -> Expr-writeData_Param (Scala.Data_Param _ name stype _) = noSep $ Y.catMaybes [-  Just $ writeName name,-  fmap (\t -> spaceSep [cst ":", writeType t]) stype]--writeData_Ref :: Scala.Data_Ref -> Expr-writeData_Ref ref = case ref of-  Scala.Data_RefName name -> writeData_Name name-  Scala.Data_RefSelect sel -> writeData_Select sel--writeData_Select :: Scala.Data_Select -> Expr-writeData_Select (Scala.Data_Select arg name) = ifx dotOp (writeTerm arg) (writeTerm proj)-  where-    proj = Scala.DataRef $ Scala.Data_RefName name--writeType :: Scala.Type -> Expr-writeType typ = case typ of-  Scala.TypeRef (Scala.Type_RefName name) -> writeType_Name name-  Scala.TypeApply (Scala.Type_Apply fun args) -> noSep [writeType fun, bracketList inlineStyle (writeType <$> args)]-  Scala.TypeFunctionType (Scala.Type_FunctionTypeFunction (Scala.Type_Function [dom] cod)) -> ifx functionArrowOp (writeType dom) (writeType cod)-  Scala.TypeLambda (Scala.Type_Lambda params body) -> noSep [writeType body, bracketList inlineStyle (writeType_Param <$> params)]-  Scala.TypeVar (Scala.Type_Var name) -> writeType_Name name-  _ -> cst $ "UNKNOWN TYPE: " ++ show typ--writeType_Name :: Scala.Type_Name -> Expr-writeType_Name (Scala.Type_Name name) = cst name--writeType_Param :: Scala.Type_Param -> Expr-writeType_Param (Scala.Type_Param [] n [] [] [] []) = writeName n
− src/main/haskell/Hydra/Ext/Scala/Utils.hs 
@@ -1,68 +0,0 @@-module Hydra.Ext.Scala.Utils where--import Hydra.Kernel-import qualified Hydra.Ext.Scala.Meta as Scala-import qualified Hydra.Lib.Strings as Strings-import Hydra.Ext.Scala.Language--import qualified Data.List as L-import qualified Data.Set as S-import qualified Data.Maybe as Y---nameOfType :: Graph -> Type -> Y.Maybe Name-nameOfType cx t = case stripType t of-  TypeVariable name -> Just name-  TypeLambda (LambdaType _ body) -> nameOfType cx body-  _ -> Nothing--qualifyUnionFieldName :: String -> Y.Maybe Name -> Name -> String-qualifyUnionFieldName dlft sname (Name fname) = (Y.maybe dlft (\n -> scalaTypeName True n ++ ".") sname) ++ fname--scalaTypeName :: Bool -> Name -> String-scalaTypeName qualify name@(Name n) = if qualify || S.member local reservedWords-    then L.intercalate "." $ Strings.splitOn "/" n-    else local-  where-    local = localNameOfLazy name--sapply :: Scala.Data -> [Scala.Data] -> Scala.Data-sapply fun args = Scala.DataApply $ Scala.Data_Apply fun args--sassign :: Scala.Data -> Scala.Data -> Scala.Data-sassign lhs rhs = Scala.DataAssign $ Scala.Data_Assign lhs rhs--slambda :: String -> Scala.Data -> Y.Maybe Scala.Type -> Scala.Data-slambda v body sdom = Scala.DataFunctionData $ Scala.Data_FunctionDataFunction-    $ Scala.Data_Function [Scala.Data_Param mods name sdom def] body-  where-    mods = []-    name = Scala.NameValue v-    def = Nothing--sname :: String -> Scala.Data-sname = Scala.DataRef . Scala.Data_RefName . Scala.Data_Name . Scala.PredefString--sprim :: Name -> Scala.Data-sprim name = sname $ prefix ++ "." ++ qualifiedNameLocal qname-  where-    qname = qualifyNameLazy name-    prefix = L.last $ Strings.splitOn "/" $ unNamespace $ Y.fromJust $ qualifiedNameNamespace qname--stapply :: Scala.Type -> [Scala.Type] -> Scala.Type-stapply t args = Scala.TypeApply $ Scala.Type_Apply t args--stapply1 :: Scala.Type -> Scala.Type -> Scala.Type-stapply1 t1 t2 = stapply t1 [t2]--stapply2 :: Scala.Type -> Scala.Type -> Scala.Type -> Scala.Type-stapply2 t1 t2 t3 = stapply t1 [t2, t3]--stparam :: Name -> Scala.Type_Param-stparam (Name v) = Scala.Type_Param [] (Scala.NameValue v) [] [] [] []--stref :: String -> Scala.Type-stref = Scala.TypeRef . Scala.Type_RefName . Scala.Type_Name--svar :: Name -> Scala.Pat-svar (Name v) = (Scala.PatVar . Scala.Pat_Var . Scala.Data_Name . Scala.PredefString) v
− src/main/haskell/Hydra/Ext/Shacl/Coder.hs 
@@ -1,197 +0,0 @@-module Hydra.Ext.Shacl.Coder where--import Hydra.Kernel-import Hydra.Ext.Rdf.Utils-import qualified Hydra.Ext.Org.W3.Rdf.Syntax as Rdf-import qualified Hydra.Ext.Org.W3.Shacl.Model as Shacl-import qualified Hydra.Dsl.Literals as Literals-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---shaclCoder :: Module -> Flow Graph (Shacl.ShapesGraph, Graph -> Flow Graph Rdf.Graph)-shaclCoder mod = do-    g <- getState-    -- Note: untested since deprecation of element schemas-    typeEls <- CM.filterM (isType g) $ moduleElements mod-    shapes <- CM.mapM toShape typeEls-    let sg = Shacl.ShapesGraph $ S.fromList shapes-    let termFlow = \g -> do-          fail "not implemented"-    return (sg, termFlow)-  where-    isType g el = do-      typ <- requireTermType $ elementData el-      return $ stripType typ == TypeVariable _Type-    toShape el = do-      typ <- coreDecodeType $ elementData el-      common <- encodeType typ-      return $ Shacl.Definition (elementIri el) $ Shacl.ShapeNode $ Shacl.NodeShape common--common :: [Shacl.CommonConstraint] -> Shacl.CommonProperties-common constraints = defaultCommonProperties {-  Shacl.commonPropertiesConstraints = S.fromList constraints}--defaultCommonProperties :: Shacl.CommonProperties-defaultCommonProperties = Shacl.CommonProperties {-  Shacl.commonPropertiesConstraints = S.empty,-  Shacl.commonPropertiesDeactivated = Nothing,-  Shacl.commonPropertiesMessage = emptyLangStrings,-  Shacl.commonPropertiesSeverity = Shacl.SeverityInfo,-  Shacl.commonPropertiesTargetClass = S.empty,-  Shacl.commonPropertiesTargetNode = S.empty,-  Shacl.commonPropertiesTargetObjectsOf = S.empty,-  Shacl.commonPropertiesTargetSubjectsOf = S.empty}--elementIri :: Element -> Rdf.Iri-elementIri = nameToIri . elementName--encodeField :: Name -> Rdf.Resource -> Field -> Flow Graph [Rdf.Triple]-encodeField rname subject field = do-  node <- nextBlankNode-  descs <- encodeTerm node (fieldTerm field)-  return $ triplesOf descs ++-    forObjects subject (propertyIri rname $ fieldName field) (subjectsOf descs)--encodeFieldType :: Name -> Maybe Integer -> FieldType -> Flow Graph (Shacl.Definition Shacl.PropertyShape)-encodeFieldType rname order (FieldType fname ft) = do-    shape <- forType (Just 1) (Just 1) ft-    return $ Shacl.Definition iri shape-  where-    iri = propertyIri rname fname-    forType mn mx t = case stripType t of-      TypeOptional ot -> forType (Just 0) mx ot-      TypeSet st -> forType mn Nothing st-      _ -> do-        cp <- encodeType t-        let baseProp = property iri-        return $ baseProp {-          Shacl.propertyShapeCommon = cp,-          Shacl.propertyShapeConstraints = S.fromList $ Y.catMaybes [-            Shacl.PropertyShapeConstraintMinCount <$> mn,-            Shacl.PropertyShapeConstraintMaxCount <$> mx],-          Shacl.propertyShapeOrder = order}--encodeLiteralType :: LiteralType -> Shacl.CommonProperties-encodeLiteralType lt = case lt of-    LiteralTypeBinary -> xsd "base64Binary"-    LiteralTypeBoolean -> xsd "boolean"-    LiteralTypeFloat ft -> case ft of-      FloatTypeBigfloat -> xsd "decimal"-      FloatTypeFloat32 -> xsd "float"-      FloatTypeFloat64 -> xsd "double"-    LiteralTypeInteger it -> case it of-      IntegerTypeBigint -> xsd "integer"-      IntegerTypeInt8 -> xsd "byte"-      IntegerTypeInt16 -> xsd "short"-      IntegerTypeInt32 -> xsd "int"-      IntegerTypeInt64 -> xsd "long"-      IntegerTypeUint8 -> xsd "unsignedByte"-      IntegerTypeUint16 -> xsd "unsignedShort"-      IntegerTypeUint32 -> xsd "unsignedInt"-      IntegerTypeUint64 -> xsd "unsignedLong"-    LiteralTypeString -> xsd "string"-  where-    xsd local = common [Shacl.CommonConstraintDatatype $ xmlSchemaDatatypeIri local]--encodeTerm :: Rdf.Resource -> Term -> Flow Graph [Rdf.Description]-encodeTerm subject term = case term of-  TermAnnotated (AnnotatedTerm inner ann) -> encodeTerm subject inner -- TODO: extract an rdfs:comment-  TermList terms -> encodeList subject terms-    where-      encodeList subj terms = if L.null terms-        then pure [emptyDescription $ (Rdf.NodeIri $ rdfIri "nil")]-          else do-            node <- nextBlankNode-            fdescs <- encodeTerm node $ L.head terms-            let firstTriples = triplesOf fdescs ++-                  forObjects subj (rdfIri "first") (subjectsOf fdescs)-            next <- nextBlankNode-            rdescs <- encodeList next $ L.tail terms-            let restTriples = triplesOf rdescs ++-                  forObjects subj (rdfIri "rest") (subjectsOf rdescs)-            return [Rdf.Description (resourceToNode subj) (Rdf.Graph $ S.fromList $ firstTriples ++ restTriples)]-  TermLiteral lit -> do-    node <- Rdf.NodeLiteral <$> encodeLiteral lit-    return [emptyDescription node]-  TermMap m -> do-      triples <- L.concat <$> (CM.mapM (forKeyVal subject) $ M.toList m)-      return [Rdf.Description (resourceToNode subject) $ Rdf.Graph $ S.fromList triples]-    where-      forKeyVal subj (k, v) = do-        -- Note: only string-valued keys are supported-        ks <- Expect.string $ stripTerm k-        node <- nextBlankNode-        descs <- encodeTerm node v-        let pred = keyIri ks-        let objs = subjectsOf descs-        let triples = forObjects subj pred objs-        return $ triples ++ triplesOf descs-  TermWrap (WrappedTerm name inner) -> do-    descs <- encodeTerm subject inner-    return $ (withType name $ L.head descs):(L.tail descs)-  TermOptional mterm -> case mterm of-    Nothing -> pure []-    Just inner -> encodeTerm subject inner-  TermRecord (Record rname fields) -> do-    tripless <- CM.mapM (encodeField rname subject) fields-    return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList $ L.concat tripless)]-  TermSet terms -> L.concat <$> CM.mapM encodeEl (S.toList terms)-    where-      encodeEl term = do-        node <- nextBlankNode-        encodeTerm node term-  TermUnion (Injection rname field) -> do-    triples <- encodeField rname subject field-    return [withType rname $ Rdf.Description (resourceToNode subject) (Rdf.Graph $ S.fromList triples)]-  _ -> unexpected "RDF-compatible term" $ show term--encodeType :: Type -> Flow Graph Shacl.CommonProperties-encodeType typ = case stripType typ of-    TypeList _ -> any-    TypeLiteral lt -> pure $ encodeLiteralType lt-    TypeMap _ -> any-    TypeWrap name -> any -- TODO: include name-    TypeRecord (RowType rname fields) -> do-      props <- CM.zipWithM (encodeFieldType rname) (Just <$> [0..]) fields-      return $ common [Shacl.CommonConstraintProperty $ S.fromList (Shacl.ReferenceDefinition <$> props)]-    TypeSet _ -> any-    TypeUnion (RowType rname fields) -> do-        props <- CM.mapM (encodeFieldType rname Nothing) fields-        let shapes = (Shacl.ReferenceAnonymous . toShape) <$> props-        return $ common [Shacl.CommonConstraintXone $ S.fromList shapes]-      where-        toShape prop = node [Shacl.CommonConstraintProperty $ S.fromList [Shacl.ReferenceDefinition prop]]-    _ -> unexpected "type" $ show typ-  where-    -- SHACL's built-in vocabulary is less expressive than Hydra's type system, so for now, SHACL validation simply ends-    -- when inexpressible types are encountered. However, certain constructs such as lists can be validated using-    -- secondary structures. For example, see shsh:ListShape in the SHACL documentation. TODO: explore these constructions.-    any = pure $ common []--node :: [Shacl.CommonConstraint] -> Shacl.Shape-node = Shacl.ShapeNode . Shacl.NodeShape . common--property :: Rdf.Iri -> Shacl.PropertyShape-property iri = Shacl.PropertyShape {-  Shacl.propertyShapeCommon = defaultCommonProperties,-  Shacl.propertyShapeConstraints = S.empty,-  Shacl.propertyShapeDefaultValue = Nothing,-  Shacl.propertyShapeDescription = emptyLangStrings,-  Shacl.propertyShapeName = emptyLangStrings,-  Shacl.propertyShapeOrder = Nothing,-  Shacl.propertyShapePath = iri}--withType :: Name -> Rdf.Description -> Rdf.Description-withType name (Rdf.Description subj (Rdf.Graph triples)) = Rdf.Description subj (Rdf.Graph $ S.insert triple triples)-  where-    subjRes = case subj of-      Rdf.NodeIri iri -> Rdf.ResourceIri iri-      Rdf.NodeBnode bnode -> Rdf.ResourceBnode bnode-    triple = Rdf.Triple subjRes (rdfIri "type") (Rdf.NodeIri $ nameToIri name)
− src/main/haskell/Hydra/Ext/Shacl/Language.hs 
@@ -1,34 +0,0 @@-module Hydra.Ext.Shacl.Language where--import Hydra.Kernel--import qualified Data.Set as S---shaclLanguage :: Language-shaclLanguage = Language (LanguageName "hydra/ext/shacl") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList literalVariants,-  languageConstraintsFloatTypes = S.fromList floatTypes,-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList integerTypes,-  languageConstraintsTermVariants = S.fromList [-    TermVariantList,-    TermVariantLiteral,-    TermVariantMap,-    TermVariantWrap,-    TermVariantOptional,-    TermVariantRecord,-    TermVariantSet,-    TermVariantUnion],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantAnnotated,-    TypeVariantList,-    TypeVariantLiteral,-    TypeVariantMap,-    TypeVariantWrap,-    TypeVariantOptional,-    TypeVariantRecord,-    TypeVariantSet,-    TypeVariantUnion],-  languageConstraintsTypes = const True }
− src/main/haskell/Hydra/Ext/Yaml/Coder.hs 
@@ -1,116 +0,0 @@-module Hydra.Ext.Yaml.Coder (yamlCoder) where--import Hydra.Kernel-import Hydra.TermAdapters-import Hydra.Ext.Yaml.Language-import Hydra.AdapterUtils-import qualified Hydra.Ext.Org.Yaml.Model as YM-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.Map as M-import qualified Data.Maybe as Y---literalCoder :: LiteralType -> Flow (Graph) (Coder (Graph) (Graph) Literal YM.Scalar)-literalCoder at = pure $ case at of-  LiteralTypeBoolean -> Coder {-    coderEncode = \(LiteralBoolean b) -> pure $ YM.ScalarBool b,-    coderDecode = \s -> case s of-      YM.ScalarBool b -> pure $ LiteralBoolean b-      _ -> unexpected "boolean" $ show s}-  LiteralTypeFloat _ -> Coder {-    coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ YM.ScalarFloat f,-    coderDecode = \s -> case s of-      YM.ScalarFloat f -> pure $ LiteralFloat $ FloatValueBigfloat f-      _ -> unexpected "floating-point value" $ show s}-  LiteralTypeInteger _ -> Coder {-    coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ YM.ScalarInt i,-    coderDecode = \s -> case s of-      YM.ScalarInt i -> pure $ LiteralInteger $ IntegerValueBigint i-      _ -> unexpected "integer" $ show s}-  LiteralTypeString -> Coder {-    coderEncode = \(LiteralString s) -> pure $ YM.ScalarStr s,-    coderDecode = \s -> case s of-      YM.ScalarStr s' -> pure $ LiteralString s'-      _ -> unexpected "string" $ show s}--recordCoder :: RowType -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node)-recordCoder rt = do-    coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt)-    return $ Coder (encode coders) (decode coders)-  where-    encode coders term = case stripTerm term of-      TermRecord (Record _ fields) -> YM.NodeMapping . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields-        where-          encodeField (ft, coder) (Field (Name fn) fv) = case (fieldTypeType ft, fv) of-            (TypeOptional _, TermOptional Nothing) -> pure Nothing-            _ -> Just <$> ((,) <$> pure (yamlString fn) <*> coderEncode coder fv)-      _ -> unexpected "record" $ show term-    decode coders n = case n of-      YM.NodeMapping m -> Terms.record (rowTypeTypeName rt) <$>-          CM.mapM (decodeField m) coders -- Note: unknown fields are ignored-        where-          decodeField a (FieldType fname@(Name fn) ft, coder) = do-            v <- coderDecode coder $ Y.fromMaybe yamlNull $ M.lookup (yamlString fn) m-            return $ Field fname v-      _ -> unexpected "mapping" $ show n-    getCoder coders fname = Y.maybe error pure $ M.lookup fname coders-      where-        error = fail $ "no such field: " ++ fname--termCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node)-termCoder typ = case stripType typ of-  TypeLiteral at -> do-    ac <- literalCoder at-    return Coder {-      coderEncode = \t -> case t of-         TermLiteral av -> YM.NodeScalar <$> coderEncode ac av-         _ -> unexpected "literal" $ show t,-      coderDecode = \n -> case n of-        YM.NodeScalar s -> Terms.literal <$> coderDecode ac s-        _ -> unexpected "scalar node" $ show n}-  TypeList lt -> do-    lc <- termCoder lt-    return Coder {-      coderEncode = \t -> case t of-         TermList els -> YM.NodeSequence <$> CM.mapM (coderEncode lc) els-         _ -> unexpected "list" $ show t,-      coderDecode = \n -> case n of-        YM.NodeSequence nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes-        _ -> unexpected "sequence" $ show n}-  TypeOptional ot -> do-    oc <- termCoder ot-    return Coder {-      coderEncode = \t -> case t of-         TermOptional el -> Y.maybe (pure yamlNull) (coderEncode oc) el-         _ -> unexpected "optional" $ show t,-      coderDecode = \n -> case n of-        YM.NodeScalar YM.ScalarNull -> pure $ Terms.optional Nothing-        _ -> Terms.optional . Just <$> coderDecode oc n}-  TypeMap (MapType kt vt) -> do-    kc <- termCoder kt-    vc <- termCoder vt-    let encodeEntry (k, v) = (,) <$> coderEncode kc k <*> coderEncode vc v-    let decodeEntry (k, v) = (,) <$> coderDecode kc k <*> coderDecode vc v-    return Coder {-      coderEncode = \t -> case t of-        TermMap m -> YM.NodeMapping . M.fromList <$> CM.mapM encodeEntry (M.toList m)-        _ -> unexpected "term" $ show t,-      coderDecode = \n -> case n of-        YM.NodeMapping m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m)-        _ -> unexpected "mapping" $ show n}-  TypeRecord rt -> recordCoder rt-  _ -> fail $ "unsupported type variant: " ++ show (typeVariant typ)--yamlCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) YM.Node)-yamlCoder typ = do-  adapter <- languageAdapter yamlLanguage typ-  coder <- termCoder $ adapterTarget adapter-  return $ composeCoders (adapterCoder adapter) coder--yamlNull :: YM.Node-yamlNull = YM.NodeScalar YM.ScalarNull--yamlString :: String -> YM.Node-yamlString = YM.NodeScalar . YM.ScalarStr
− src/main/haskell/Hydra/Ext/Yaml/Language.hs 
@@ -1,26 +0,0 @@-module Hydra.Ext.Yaml.Language where--import Hydra.Kernel--import qualified Data.Set as S---yamlLanguage :: Language-yamlLanguage = Language (LanguageName "hydra/ext/yaml") $ LanguageConstraints {-  languageConstraintsEliminationVariants = S.empty,-  languageConstraintsLiteralVariants = S.fromList [-    LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],-  languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],-  languageConstraintsFunctionVariants = S.empty,-  languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],-  languageConstraintsTermVariants = S.fromList [-    TermVariantLiteral,-    TermVariantList,-    TermVariantMap,-    TermVariantOptional,-    TermVariantRecord],-  languageConstraintsTypeVariants = S.fromList [-    TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantOptional, TypeVariantRecord],-  languageConstraintsTypes = \typ -> case stripType typ of-    TypeOptional (TypeOptional _) -> False-    _ -> True }
− src/main/haskell/Hydra/Ext/Yaml/Modules.hs 
@@ -1,39 +0,0 @@-module Hydra.Ext.Yaml.Modules (moduleToYaml) where--import Hydra.Kernel-import Hydra.Adapters-import Hydra.Ext.Yaml.Serde-import Hydra.Ext.Yaml.Language-import qualified Hydra.Ext.Org.Yaml.Model as YM-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M---constructModule ::-  Module-  -> M.Map (Type) (Coder (Graph) (Graph) (Term) YM.Node)-  -> [(Element, TypedTerm)]-  -> Flow (Graph) YM.Node-constructModule mod coders pairs = do-    keyvals <- withTrace "encoding terms" (CM.mapM toYaml pairs)-    return $ YM.NodeMapping $ M.fromList keyvals-  where-    toYaml (el, (TypedTerm term typ)) = withTrace ("element " ++ unName (elementName el)) $ do-      encode <- case M.lookup typ coders of-        Nothing -> fail $ "no coder found for type " ++ show typ-        Just coder -> pure $ coderEncode coder-      node <- encode term-      return (YM.NodeScalar $ YM.ScalarStr $ localNameOf $ elementName el, node)-    ns = unNamespace $ moduleNamespace mod-    localNameOf name = L.drop (1 + L.length ns) $ unName name--moduleToYaml :: Module -> Flow (Graph) (M.Map FilePath String)-moduleToYaml mod = withTrace ("print module " ++ (unNamespace $ moduleNamespace mod)) $ do-    node <- transformModule yamlLanguage encodeTerm constructModule mod-    return $ M.fromList [(path, hydraYamlToString node)]-  where-    path = namespaceToFilePath False (FileExtension "yaml") $ moduleNamespace mod-    encodeTerm _ = fail $ "only type definitions are expected in this mapping to YAML"
− src/main/haskell/Hydra/Ext/Yaml/Serde.hs 
@@ -1,80 +0,0 @@-module Hydra.Ext.Yaml.Serde where--import Hydra.Kernel-import Hydra.Ext.Yaml.Coder-import Hydra.Tools.Bytestrings-import qualified Hydra.Ext.Org.Yaml.Model as YM--import qualified Data.ByteString.Lazy as BS-import qualified Control.Monad as CM-import qualified Data.YAML as DY-import qualified Data.YAML.Event as DYE-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.ByteString.Lazy.Char8 as LB---bytesToHsYaml :: BS.ByteString -> Flow (Graph) (DY.Node DY.Pos)-bytesToHsYaml bs = case DY.decodeNode bs of-    Left (pos, msg) -> fail $ "YAML parser failure at " ++ show pos ++ ": " ++ msg-    Right docs -> if L.null docs-      then fail "no YAML document"-      else if L.length docs > 1-      then fail "multiple YAML documents"-      else case L.head docs of-        (DY.Doc node) -> pure node--bytesToHydraYaml :: BS.ByteString -> Flow (Graph) YM.Node-bytesToHydraYaml = bytesToHsYaml CM.>=> hsYamlToHydraYaml--hsYamlToBytes :: DY.Node () -> BS.ByteString-hsYamlToBytes node = DY.encodeNode [DY.Doc node]--hsYamlToHydraYaml :: DY.Node x -> Flow (Graph) YM.Node-hsYamlToHydraYaml hs = case hs of-  DY.Scalar _ s -> YM.NodeScalar <$> case s of-     DY.SNull -> pure YM.ScalarNull-     DY.SBool b -> pure $ YM.ScalarBool b-     DY.SFloat f -> pure $ YM.ScalarFloat f-     DY.SInt i -> pure $ YM.ScalarInt i-     DY.SStr t -> pure $ YM.ScalarStr $ T.unpack t-     DY.SUnknown _ _ -> fail "YAML unknown scalars are unsupported"-  DY.Mapping _ _ m -> YM.NodeMapping . M.fromList <$> CM.mapM mapPair (M.toList m)-    where-      mapPair (k, v) = (,) <$> hsYamlToHydraYaml k <*> hsYamlToHydraYaml v-  DY.Sequence _ _ s -> YM.NodeSequence <$> CM.mapM hsYamlToHydraYaml s-  DY.Anchor {} -> fail "YAML anchors are unsupported"--hydraYamlToBytes :: YM.Node -> BS.ByteString-hydraYamlToBytes = hsYamlToBytes . hydraYamlToHsYaml--hydraYamlToHsYaml :: YM.Node -> DY.Node ()-hydraYamlToHsYaml hy = case hy of-  YM.NodeMapping m -> DY.Mapping () DYE.untagged $ M.fromList $ mapPair <$> M.toList m-    where-      mapPair (k, v) = (,) (hydraYamlToHsYaml k) (hydraYamlToHsYaml v)-  YM.NodeScalar s -> DY.Scalar () $ case s of-    YM.ScalarBool b -> DY.SBool b-    YM.ScalarFloat f -> DY.SFloat f-    YM.ScalarInt i -> DY.SInt i-    YM.ScalarNull -> DY.SNull-    YM.ScalarStr s -> DY.SStr $ T.pack s-  YM.NodeSequence s -> DY.Sequence () DYE.untagged $ hydraYamlToHsYaml <$> s--hydraYamlToString :: YM.Node -> String-hydraYamlToString = bytesToString . hydraYamlToBytes--yamlByteStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) BS.ByteString)-yamlByteStringCoder typ = do-  coder <- yamlCoder typ-  return Coder {-    coderEncode = fmap hydraYamlToBytes . coderEncode coder,-    coderDecode = bytesToHydraYaml CM.>=> coderDecode coder}--yamlStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) String)-yamlStringCoder typ = do-  serde <- yamlByteStringCoder typ-  return Coder {-    coderEncode = fmap LB.unpack . coderEncode serde,-    coderDecode = coderDecode serde . LB.pack}
− src/main/haskell/Hydra/Flows.hs 
@@ -1,22 +0,0 @@--- | Functions and type class implementations for working with Hydra's built-in Flow monad--module Hydra.Flows where--import Hydra.Kernel-import qualified Hydra.Lib.Flows as Flows--import qualified Control.Monad as CM-import qualified System.IO as IO---fromEither :: Show e => Either e a -> Flow c a-fromEither x = case x of-  Left e -> Flows.fail $ show e-  Right a -> return a--fromFlowIo :: s -> Flow s a -> IO.IO a-fromFlowIo cx f = case mv of-    Just v -> return v-    Nothing -> CM.fail $ traceSummary trace-  where-    FlowState mv _ trace = unFlow f cx emptyTrace
+ src/main/haskell/Hydra/Generation.hs view
@@ -0,0 +1,128 @@+-- | Entry point for Hydra code generation utilities++module Hydra.Generation where++import Hydra.Kernel+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Ext.Haskell.Coder+import Hydra.Ext.Org.Json.Coder+import Hydra.Staging.Yaml.Modules+import Hydra.Sources.Libraries++import qualified Control.Monad as CM+import qualified System.FilePath as FP+import qualified Data.List as L+import qualified Data.Map as M+import qualified System.Directory as SD+import qualified Data.Maybe as Y+++-- TODO: deprecated+generateSources :: (Module -> Flow Graph (M.Map FilePath String)) -> FilePath -> [Module] -> IO ()+generateSources printModule basePath mods = do+    mfiles <- runFlow bootstrapGraph generateFiles+    case mfiles of+      Nothing -> fail "Transformation failed"+      Just files -> mapM_ writePair files+  where+    generateFiles = withTrace "generate files" $ withState (modulesToGraph mods) $ do+      g <- getState+      g1 <- inferGraphTypes g+      withState g1 $ do+          maps <- CM.mapM forModule $ refreshModule (graphElements g1) <$> mods+          return $ L.concat (M.toList <$> maps)+        where+          refreshModule els mod = mod {+            moduleElements = Y.catMaybes ((\e -> M.lookup (bindingName e) els) <$> moduleElements mod)}++    writePair (path, s) = do+        let fullPath = FP.combine basePath path+        SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath+        writeFile fullPath withNewline+      where+        withNewline = if L.isSuffixOf "\n" s then s else s ++ "\n"++    forModule mod = withTrace ("module " ++ unNamespace (moduleNamespace mod)) $ printModule mod++generateSourcesSimple :: (Module -> [Definition] -> Flow Graph (M.Map FilePath String)) -> Language -> Bool+                      -> FilePath -> [Module] -> IO ()+generateSourcesSimple printDefinitions lang doExpand basePath mods = do+    mschemaFiles <- runFlow bootstrapGraph generateSchemaFiles+    case mschemaFiles of+      Nothing -> fail "Failed to generate schema files"+      Just files -> mapM_ writePair files+    mdataFiles <- runFlow bootstrapGraph generateDataFiles+    case mdataFiles of+      Nothing -> fail "Failed to generate data files"+      Just files -> mapM_ writePair files+  where+    constraints = languageConstraints lang+    isTypeElement el = case deannotateTerm (bindingTerm el) of+      TermUnion inj -> injectionTypeName inj == _Type+      _ -> False+    -- Note: we assume that no module contains both type-level and term-level elements+    isSchemaModule mod = not $ L.null $ L.filter isTypeElement $ moduleElements mod+    (schemaModules, dataModules) = L.partition isSchemaModule mods++    generateSchemaFiles = withTrace "generate schema files" $ do+        (tmap, defLists) <- schemaGraphToDefinitions constraints g0 nameLists+        withState g0 $ do+          maps <- CM.zipWithM forEachModule schemaModules defLists+          return $ L.concat (M.toList <$> maps)+      where+        g0 = modulesToGraph schemaModules+        nameLists = fmap (fmap bindingName . moduleElements) schemaModules+        forEachModule mod defs = withTrace ("schema module " ++ unNamespace (moduleNamespace mod)) $+          printDefinitions mod (fmap DefinitionType defs)++    generateDataFiles = withTrace "generate data files" $ do+        (g1, defLists) <- dataGraphToDefinitions constraints doExpand g0 nameLists+        withState g1 $ do+          maps <- CM.zipWithM forEachModule dataModules defLists+          return $ L.concat (M.toList <$> maps)+      where+        g0 = modulesToGraph dataModules+        nameLists = fmap (fmap bindingName . moduleElements) dataModules+        forEachModule mod defs = withTrace ("data module " ++ unNamespace (moduleNamespace mod)) $+          printDefinitions mod (fmap DefinitionTerm defs)++    writePair (path, s) = do+        let fullPath = FP.combine basePath path+        SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath+        writeFile fullPath withNewline+      where+        withNewline = if L.isSuffixOf "\n" s then s else s ++ "\n"++-- TODO: move into the kernel+modulesToGraph :: [Module] -> Graph+modulesToGraph mods = elementsToGraph parent (Just schemaGraph) dataElements+  where+    parent = bootstrapGraph+    dataElements = L.concat (moduleElements <$> closedMods)+    schemaElements = L.concat (moduleElements <$> (L.concat (moduleTypeDependencies <$> closedMods)))+    schemaGraph = elementsToGraph bootstrapGraph Nothing schemaElements+    closedMods = L.concat (close <$> mods)+    close mod = mod:(L.concat (close <$> moduleTermDependencies mod))++printTrace :: Bool -> Trace -> IO ()+printTrace isError t = do+  CM.unless (L.null $ traceMessages t) $ do+      putStrLn $ if isError then "Flow failed. Messages:" else "Messages:"+      putStrLn $ indentLines $ traceSummary t++runFlow :: s -> Flow s a -> IO (Maybe a)+runFlow s f = do+    printTrace (Y.isNothing v) t+    return v+  where+    FlowState v _ t = unFlow f s emptyTrace++writeHaskell :: FilePath -> [Module] -> IO ()+writeHaskell = generateSources moduleToHaskell++-- writeJson :: FP.FilePath -> [Module] -> IO ()+-- writeJson = generateSources Json.printModule++writeYaml :: FP.FilePath -> [Module] -> IO ()+writeYaml = generateSources moduleToYaml
− src/main/haskell/Hydra/Inference/AlgorithmW.hs 
@@ -1,835 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverlappingInstances #-}---- Implementation of Hindley Milner algorithm W--- to system F translation by Ryan Wisnesky, with extensions for Hydra by Joshua Shinavier--- License: Apache 2.0 https://www.apache.org/licenses/LICENSE-2.0--module Hydra.Inference.AlgorithmW where--import Hydra.Minimal--import Prelude-import Control.Monad.Except-import Control.Monad.State-import Data.List (nub)-import Debug.Trace---natType = TyLit $ LiteralTypeInteger IntegerTypeInt32-constNeg = Const $ TypedPrim $ TypedPrimitive (Name "hydra/lib/math.neg") $ Forall [] $ TyFn natType natType--- Note: Hydra has no built-in pred or succ functions, but neg has the expected type-constPred = constNeg-constSucc = constNeg-nat = Const . Lit . int32-str = Const . Lit . string---- A typed primitive corresponds to the Hydra primitive of the same name-data TypedPrimitive = TypedPrimitive Name TypSch deriving (Eq)------------------------------ STLC--type Var = String--data Prim- = Lit Literal- | TypedPrim TypedPrimitive- | If0- | Fst | Snd | Pair | TT- | Nil | Cons | FoldList- | FF | Inl | Inr | Case | Con Var | Fold Var- deriving Eq--instance Show Prim where-  show (Lit l) = show l-  show (TypedPrim (TypedPrimitive name _)) = unName name ++ "()"-  show FoldList = "fold"-  show Fst = "fst"-  show Snd = "snd"-  show Nil = "nil"-  show Cons = "cons"-  show TT = "tt"-  show FF = "ff"-  show Inl = "inl"-  show Inr = "inr"-  show Case = "case"-  show If0 = "if0"-  show Pair = "pair"-  show (Con  n) = n-  show (Fold n) = "fold_" ++ n--data Expr = Const Prim- | Var Var- | Tuple [Expr]- | Proj Int Int Expr- | Inj Int Int Expr- | Case' Expr [Expr]- | App Expr Expr- | Abs Var Expr- | Letrec [(Var, Expr)] Expr- deriving (Eq)--instance Show Expr where-  show (Case' t ts) = "case " ++ show t ++ " of " ++ x ++ " end"-   where x = foldl (\p q -> p ++ "\n\t\t" ++ q) "" $ map show ts-  show (Proj i j e) = show e ++ "." ++ show i ++ " (arity " ++ show j ++ ")"-  show (Inj i j e) = "inj " ++ show i ++ " (arity " ++ show j ++ ") " ++ show e-  show (Tuple ts) = "<" ++ show (map show ts) ++ ">"-  show (Const p) = show p-  show (Var v) = v-  show (App (App (App a' a) b) b') = "(" ++ show a' ++ " " ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")"-  show (App (App a b) b') = "(" ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")"-  show (App a b) = "(" ++ show a ++ " " ++ show b ++ ")"-  show (Abs a b) = "(\\" ++ a ++ ". " ++ show b ++ ")"-  show (Letrec ab c) = "letrec " ++ d ++ show c-    where d = foldr (\(p, q) r -> p ++ " = " ++ show q ++ " \n\t\t" ++ r) "in " ab--data MTy = TyVar Var-  | TyLit LiteralType-  | TyList MTy-  | TyFn MTy MTy-  | TyProd MTy MTy-  | TySum MTy MTy-  | TyUnit-  | TyVoid-  | TyTuple [MTy]-  | TyVariant [MTy]-  | TyCon Var [MTy]- deriving (Eq)--instance Show MTy where-  show (TyLit lt) = case lt of-    LiteralTypeInteger it -> drop (length "IntegerType") $ show it-    LiteralTypeFloat ft -> drop (length "FloatType") $ show ft-    _ -> drop (length "LiteralType") $ show lt-  show (TyTuple ts) = "(Tuple " ++ show (map show ts) ++ ")"-  show (TyVariant ts) = "(Variant " ++ show (map show ts) ++ ")"-  show (TyVar v) = v-  show (TyList t) = "(List " ++ (show t) ++ ")"-  show (TyFn t1 t2) = "(" ++ show t1 ++ " -> " ++ show t2 ++ ")"-  show (TyProd t1 t2) = "(" ++ show t1 ++ " * " ++ show t2 ++  ")"-  show (TySum t1 t2) = "(" ++ show t1 ++ " + " ++ show t2 ++  ")"-  show TyUnit = "Unit"-  show TyVoid = "Void"-  show (TyCon c ts) = c ++ " " ++ ts'-   where ts' = foldr (\p r -> show p ++ "" ++ r) "" ts--instance Show TypSch where-  show (Forall [] t) = show t-  show (Forall x t) = "forall " ++ d ++ show t-   where d = foldr (\p q ->  p ++ " " ++ q) ", " x--data TypSch = Forall [Var] MTy- deriving Eq---type ADTs = [(Var, [Var], [(Var, [MTy])])]-------------------------------- System F--data FExpr = FConst Prim- | FVar Var- | FTuple [FExpr]- | FProj Int FExpr- | FInj Int [FTy] FExpr- | FCase FExpr FTy [FExpr]- | FApp FExpr FExpr- | FAbs Var FTy FExpr- | FTyApp FExpr [FTy]- | FTyAbs [Var] FExpr- | FLetrec [(Var, FTy, FExpr)] FExpr- deriving (Eq)--instance Show FExpr where-  show (FCase t t' []) = "ff " ++ show t ++ " " ++ show t' ++ " "-  show (FCase t t' ts) = "case " ++ show t ++ " of " ++ show (map show ts) ++ " end"-  show (FProj i e) = show e ++ "." ++ show i-  show (FInj i j e) = "inj " ++ show i ++ " (arity " ++ show j ++ ") " ++ show e-  show (FTuple es) = "<" ++ show (map show es) ++ ">"-  show (FConst p) = show p-  show (FVar v) = v-  show (FTyApp e t) = "(" ++ show e ++ " " ++ show t ++ ")"-  show (FApp (FApp (FApp a' a) b) b') = "(" ++ show a' ++ " " ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")"-  show (FApp (FApp a b) b') = "(" ++ show a ++ " " ++ show b ++ " " ++ show b' ++ ")"-  show (FApp a b) = "(" ++ show a ++ " " ++ show b ++ ")"-  show (FAbs a t b) = "(\\" ++ a ++ ":" ++ show t ++ ". " ++ show b ++ ")"-  show (FLetrec ab c) = "letrecs " ++ d ++ show c-    where d = foldr (\(p, t, q) r -> p ++ ":" ++ show t ++ " = " ++ show q ++ " \n\t\t" ++ r) "in " ab-  show (FTyAbs ab c) = "(/\\" ++ d ++ show c ++ ")"-    where d = foldr (\p r -> p ++ " " ++ r) ". " ab--data FTy = FTyVar Var-  | FTyLit LiteralType-  | FTyList FTy-  | FTyFn FTy FTy-  | FTyProd FTy FTy-  | FTySum FTy FTy-  | FTyUnit-  | FTyVoid-  | FTyTuple [FTy]-  | FTyVariant [FTy]-  | FTyCon Var [FTy]-  | FForall [Var] FTy- deriving (Eq)--instance Show FTy where-  show (FTyLit lt) = show $ TyLit lt-  show (FTyVariant ts) = "(Variant " ++ show (map show ts) ++ ")"-  show (FTyTuple ts) = "(Tuple " ++ show (map show ts) ++ ")"-  show (FTyVar v) = v-  show (FTyList t) = "(List " ++ (show t) ++ ")"-  show (FTyFn t1 t2) = "(" ++ show t1 ++ " -> " ++ show t2 ++ ")"-  show (FTyProd t1 t2) = "(" ++ show t1 ++ " * " ++ show t2 ++  ")"-  show (FTySum t1 t2) = "(" ++ show t1 ++ " + " ++ show t2 ++  ")"-  show FTyUnit = "Unit"-  show FTyVoid = "Void"-  show (FForall x t) = "(forall " ++ d ++ show t ++ ")"-   where d = foldr (\p q -> p ++ " " ++ q) ", " x-  show (FTyCon c ts) = c ++ " " ++ ts'-   where ts' = foldr (\p r -> show p ++ "" ++ r) " " ts--mTyToFTy :: MTy -> FTy-mTyToFTy (TyVar v) = FTyVar v-mTyToFTy (TyLit lt) = FTyLit lt-mTyToFTy TyUnit = FTyUnit-mTyToFTy TyVoid = FTyVoid-mTyToFTy (TyList x) = FTyList $ mTyToFTy x-mTyToFTy (TyFn x y) = FTyFn (mTyToFTy x) (mTyToFTy y)-mTyToFTy (TyProd x y) = FTyProd (mTyToFTy x) (mTyToFTy y)-mTyToFTy (TySum x y) = FTySum (mTyToFTy x) (mTyToFTy y)-mTyToFTy (TyTuple ts) = FTyTuple (map mTyToFTy ts)-mTyToFTy (TyVariant ts) = FTyVariant (map mTyToFTy ts)-mTyToFTy (TyCon c ts) = FTyCon c $ map mTyToFTy ts--tyToFTy :: TypSch -> FTy-tyToFTy (Forall [] t) = mTyToFTy t-tyToFTy (Forall vs t) = FForall vs (mTyToFTy t)------------------------- Contexts--type Ctx = [(Var, TypSch)]--class Vars a where-  vars :: a -> [Var]--instance Vars Ctx where- vars [] = []- vars ((v,t):l) = vars t ++ vars l--instance Vars TypSch where- vars (Forall vs t) = filter (\v -> not $ elem v vs) (vars t)--instance Vars MTy where- vars (TyVar v) = [v]- vars (TyLit _) = []- vars (TyList t) = vars t- vars (TyFn t1 t2) = vars t1 ++ vars t2- vars TyUnit = []- vars TyVoid = []- vars (TyProd t1 t2) = vars t1 ++ vars t2- vars (TySum t1 t2) = vars t1 ++ vars t2- vars (TyTuple []) = []- vars (TyTuple (a:b)) = vars a ++ vars (TyTuple b)- vars (TyVariant []) = []- vars (TyVariant (a:b)) = vars a ++ vars (TyVariant b)- vars (TyCon _ x) = vars $ TyVariant x --cheat--replaceTCon :: MTy -> MTy -> MTy -> MTy-replaceTCon u s (TyVar x) = TyVar x-replaceTCon u s (TyLit l) = TyLit l-replaceTCon u s (TyList t)  = TyList $ replaceTCon u s t-replaceTCon u s (TyFn t1 t2)  = TyFn (replaceTCon u s t1) (replaceTCon u s t2)-replaceTCon u s TyUnit  = TyUnit-replaceTCon u s TyVoid  = TyVoid-replaceTCon u s (TyProd t1 t2)  = TyProd (replaceTCon u s t1) (replaceTCon u s t2)-replaceTCon u s (TySum t1 t2)  = TySum (replaceTCon u s t1) (replaceTCon u s t2)-replaceTCon u s (TyTuple [])  = TyTuple []-replaceTCon u s (TyTuple (a:b)) = TyTuple $ (replaceTCon u s a):(map (replaceTCon u s) b)-replaceTCon u s (TyVariant [])  = TyVariant []-replaceTCon u s (TyVariant (a:b)) = TyVariant $ (replaceTCon u s a):(map (replaceTCon u s) b)-replaceTCon u s (TyCon t' ts)  | TyCon t' ts == u = s-                               | otherwise = TyCon t' $ map (replaceTCon u s) ts--primTy :: ADTs -> Prim -> Either String TypSch-primTy _ (Lit l) = Right $ Forall [] $ TyLit $ literalType l-primTy _ (TypedPrim (TypedPrimitive _ forall)) = Right forall-primTy [] (Con n) = throwError $ n ++ " not found "-primTy ((a,t,[]):tl) (Con n) = primTy tl $ Con n-primTy ((a,t,(c,ts):cs):tl) (Con n) | c == n = return $ Forall t (ts' ts $ TyCon a $ map TyVar t)-                                    | otherwise = primTy ((a,t,cs):tl) $ Con n- where ts' [] x = x-       ts' (p:q) x = TyFn p $ ts' q x-primTy [] (Fold n) = throwError $ n ++ " not found "-primTy ((a,t,cs):tl) (Fold n) | a == n = return $ Forall ("r":t) $ elimTy-                              | otherwise = primTy tl $ Fold n- where elimTy = TyFn (TyCon a $ map TyVar t) $ replaceTCon (TyCon a $ map TyVar t) (TyVar "r") (ts' cs)-       ts' [] = TyVar "r"-       ts' ((_,ts):q)  = TyFn (ts'' ts) $ ts' q-       ts'' [] = TyCon a $ map TyVar t-       ts'' (a:b) = TyFn a $ ts'' b-primTy _ Fst = return $  Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "x")-primTy _ Snd = return $  Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "y")-primTy _ Nil = return $  Forall ["t"] $ TyList (TyVar "t")-primTy _ Cons = return $ Forall ["t"] $ TyFn (TyVar "t") (TyFn (TyList (TyVar "t")) (TyList (TyVar "t")))-primTy _ TT = return $ Forall [] TyUnit-primTy _ FF = return $ Forall ["t"] $ TyFn TyVoid (TyVar "t")-primTy _ Inl = return $ Forall ["x", "y"] $ (TyVar "x") `TyFn` (TyProd (TyVar "x") (TyVar "y"))-primTy _ Inr = return $ Forall ["x", "y"] $ (TyVar "y") `TyFn` (TyProd (TyVar "x") (TyVar "y"))-primTy _ Pair = return $ Forall ["xx", "yy"] $ (TyFn (TyVar "xx") (TyFn (TyVar "yy") (TyProd (TyVar "xx") (TyVar "yy"))))-primTy _ If0 = return $ Forall [] $ natType `TyFn` (natType `TyFn` (natType `TyFn` natType))-primTy _ FoldList = return $ Forall ["a", "b"] $ p `TyFn` ((TyVar "b") `TyFn` ((TyList $ TyVar "a") `TyFn` (TyVar "b")))- where p = TyVar "b" `TyFn` (TyVar "a" `TyFn` TyVar "b")-primTy _ Case = return $ Forall ["x", "y", "z"] $ (TySum (TyVar "x") (TyVar "y")) `TyFn` (l `TyFn` (r `TyFn` (TyVar "z")))- where l = (TyVar "x") `TyFn` (TyVar "z")-       r = (TyVar "y") `TyFn` (TyVar "z")----------------------------------- Substitution--type Subst = [(Var, MTy)]--idSubst :: Subst-idSubst = []--o :: Subst -> Subst -> Subst-o f g = addExtra ++ map h g- where h (v, g') = (v, subst f g')-       addExtra = filter (\(v,f')-> case lookup v g of-                                      Just y  -> False-                                      Nothing -> True) f--class Substable a where-  subst :: Subst -> a -> a--instance Substable MTy where- subst f (TyLit lt) = TyLit lt- subst f (TyVariant ts) = TyVariant $ map (subst f) ts- subst f (TyTuple ts) = TyTuple $ map (subst f) ts- subst f TyUnit = TyUnit- subst f TyVoid = TyVoid- subst f (TyList t) = TyList $ subst f t- subst f (TyFn t1 t2) = TyFn (subst f t1) (subst f t2)- subst f (TyProd t1 t2) = TyProd  (subst f t1) (subst f t2)- subst f (TySum t1 t2) = TySum  (subst f t1) (subst f t2)- subst f (TyVar v) = case lookup v f of-                      Nothing -> TyVar v-                      Just y -> y- subst f (TyCon v ts) = TyCon v $ map (subst f) ts--instance Substable FTy where- subst f (FTyLit lt) = FTyLit lt- subst f (FTyVariant ts) = FTyVariant $ map (subst f) ts- subst f (FTyTuple ts) = FTyTuple $ map (subst f) ts- subst f FTyUnit = FTyUnit- subst f FTyVoid = FTyVoid- subst f (FTyList t) = FTyList $ subst f t- subst f (FTyFn t1 t2) = FTyFn (subst f t1) (subst f t2)- subst f (FTyProd t1 t2) = FTyProd  (subst f t1) (subst f t2)- subst f (FTySum t1 t2) = FTySum  (subst f t1) (subst f t2)- subst f (FTyVar v) = case lookup v f of-                        Nothing -> FTyVar v-                        Just y -> mTyToFTy y- subst f (FForall vs t) = FForall vs $ subst phi' t-  where phi' = filter (\(v,f')-> not (elem v vs)) f- subst f (FTyCon v ts) = FTyCon v $ map (subst f) ts--instance Substable TypSch where- subst f (Forall vs t) = Forall vs $ subst f' t-   where f' = filter (\(v,t')-> not $ elem v vs) f--instance Substable Ctx where- subst phi g = map (\(k,v)->(k, subst phi v)) g--instance Substable FExpr where- subst phi (FInj i js e) = FInj i (map (subst phi) js) $ subst phi e- subst phi (FProj i e) = FProj i $ subst phi e- subst phi (FTuple es) = FTuple $ map (subst phi) es- subst phi (FCase e t es) = FCase (subst phi e) (subst phi t) $ map (subst phi) es- subst phi (FConst p) = FConst p- subst phi (FVar p) = FVar p- subst phi (FApp p q) = FApp (subst phi p) (subst phi q)- subst phi (FAbs p t q) = FAbs p (subst phi t) (subst phi q)- subst phi (FTyApp p q) = FTyApp (subst phi p) (map (subst phi) q)- subst phi (FTyAbs vs p) = FTyAbs vs (subst phi' p)-  where phi' = filter (\(v,f')-> not (elem v vs)) phi- subst phi (FLetrec vs p) = FLetrec (map (\(k,t,v)->(k,subst phi t, subst phi v)) vs) (subst phi p)--subst' :: [(Var,FTy)] -> FTy -> FTy-subst' f (FTyLit lt) = FTyLit lt-subst' f (FTyTuple ts) = FTyTuple $ (map $ subst' f) ts-subst' f (FTyVariant ts) = FTyVariant $ (map $ subst' f) ts-subst' f FTyUnit = FTyUnit-subst' f FTyVoid = FTyVoid-subst' f (FTyList t) = FTyList $ subst' f t-subst' f (FTyFn t1 t2) = FTyFn (subst' f t1) (subst' f t2)-subst' f (FTyProd t1 t2) = FTyProd  (subst' f t1) (subst' f t2)-subst' f (FTySum t1 t2) = FTySum  (subst' f t1) (subst' f t2)-subst' f (FTyVar v) = case lookup v f of-                        Nothing -> FTyVar v-                        Just y -> y-subst' f (FForall vs t) = FForall vs $ subst' f' t- where f' = filter (\(v,f')-> not (elem v vs)) f-subst' f (FTyCon v ts) = FTyCon v $ map (subst' f) ts--instance Show Ctx where-  show [] = ""-  show ((k,v):t) = k ++ ":" ++ show v ++ " " ++ show t----------------------------------------- Type checking for F--open :: [Var] -> [FTy] -> FTy -> Either String FTy-open vs ts e | length vs == length ts = return $ subst' (zip vs ts) e-             | otherwise = throwError "Cannot open"--typeOf :: ADTs -> [Var] -> [(Var,FTy)] -> FExpr -> Either String FTy-typeOf adts tvs g (FCase e r es) = do { ts <- mapM (typeOf adts tvs g) es-                                      ; t <- typeOf adts tvs g e-                                      ; case t of-                                         FTyVariant ts' -> if length ts == length ts'-                                                           then do { mapM f $ zip ts ts'-                                                                   ; return r }-                                                           else throwError $ "bad number of cases "-                                         z -> throwError $ show z ++ " is not a variant"}- where f ((FTyFn a b), exp) | a == exp && b == r = return ()-typeOf adts tvs g (FInj i ts e) = do { t <- typeOf adts tvs g e-                                     ; if i >= length ts-                                       then throwError $ "bad inj index " ++ show i ++ " on " ++ show e-                                       else if ts !! i == t-                                            then return $ FTyVariant ts-                                            else throwError $ "injection type mismatch " ++ show (FInj i ts e) ++ ", " ++ show (ts !! i) ++ " <> " ++ show t }-typeOf adts tvs g (FProj i e) = do { t <- typeOf adts tvs g e-                                   ; case t of-                                      FTyTuple ts -> if i >= length ts-                                                     then throwError $ "bad proj index " ++ show i ++ " on " ++ show e-                                                     else return $ ts !! i-                                      z -> throwError $ show z ++ " is not a tuple type" }-typeOf adts tvs g (FTuple es) = do { ts <- mapM (typeOf adts tvs g) es-                                   ; return $ FTyTuple ts }-typeOf adts tvs g (FVar x) = case lookup x g of-  Nothing -> throwError $ "unbound var: " ++ x-  Just y -> return y-typeOf adts tvs g (FConst p) = do { t <- primTy adts p ; return $ tyToFTy t }-typeOf adts tvs g (FApp a b) = do { t1 <- typeOf adts tvs g a-                                  ; t2 <- typeOf adts tvs g b-                                  ; case t1 of-                                      FTyFn p q -> if p == t2-                                                   then return q-                                                   else throwError $ "In " ++ (show $ FApp a b) ++ " expected " ++ show p ++ " given " ++ show t2-                                      v -> throwError $ "In " ++ show (FApp a b) ++ " not a fn type: " ++ show v }-typeOf adts tvs g (FAbs x t e) = do { t1 <- typeOf adts tvs ((x,t):g) e-                                    ; return $ t `FTyFn` t1 }-typeOf adts tvs g (FTyAbs vs e) = do { t1 <- typeOf adts (vs++tvs) g e-                                     ; return $ FForall vs t1 }-typeOf adts tvs g (FTyApp e ts) = do { t1 <- typeOf adts tvs g e-                                     ; case t1 of-                                        FForall vs t -> open vs ts t-                                        v -> throwError $ "not a forall type: " ++ show v }-typeOf adts tvs g (FLetrec es e) = do { let g' = map (\(k,t,e)->(k,t)) es-                                      ; est <- mapM (\(_,_,v)->typeOf adts tvs (g'++g) v) es-                                      ; if est == (snd $ unzip g')-                                        then typeOf adts tvs g' e-                                        else throwError $ "Disagree: " ++ show est ++ " and " ++ (show $ snd $ unzip g') }----------------------------------- Unification--mgu :: MTy -> MTy -> E Subst-mgu (TyLit lt1) (TyLit lt2) = if lt1 == lt2-  then return []-  else throwError $ "Cannot unify literal types " ++ show lt1 ++ " and " ++ show lt2-mgu (TyVariant ts1) (TyVariant ts2) | length ts1 == length ts2 = mgu' ts1 ts2-                                    | otherwise = throwError $ "cannot unify " ++ show ts1 ++ " with " ++ show ts2-mgu (TyTuple ts1) (TyTuple ts2) | length ts1 == length ts2 = mgu' ts1 ts2-                                | otherwise = throwError $ "cannot unify " ++ show ts1 ++ " with " ++ show ts2-mgu (TyList a) (TyList b) = mgu a b-mgu TyUnit TyUnit = return []-mgu TyVoid TyVoid = return []-mgu (TyCon a as) (TyCon b bs) | a == b && length as == length bs = mgu' as bs-                              | otherwise = throwError $ "cannot unify " ++ show a ++ " with " ++ show b-mgu (TyProd a b) (TyProd a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }-mgu (TySum  a b) (TySum  a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }-mgu (TyFn   a b) (TyFn   a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }-mgu (TyVar a) (TyVar b) | a == b = return []-mgu (TyVar a) b = do { occurs a b; return [(a, b)] }-mgu a (TyVar b) = mgu (TyVar b) a-mgu a b = throwError $ "cannot unify " ++ show a ++ " with " ++ show b--mgu' :: [MTy] -> [MTy] -> E Subst-mgu' [] [] = return idSubst-mgu' (a:as) (b:bs) = do { f <- mgu a b; s <- mgu' (map (subst f) as) (map (subst f) bs); return $ s `o` f }--occurs :: Var -> MTy -> E ()-occurs v (TyLit _) = return ()-occurs v (TyCon _ ts) = mapM_ (occurs v) ts-occurs v (TyTuple ts) = mapM_ (occurs v) ts-occurs v (TyVariant ts) = mapM_ (occurs v) ts-occurs v (TyList l) = occurs v l-occurs v TyUnit = return ()-occurs v TyVoid = return ()-occurs v (TyFn   a b) = do { occurs v a; occurs v b }-occurs v (TyProd a b) = do { occurs v a; occurs v b }-occurs v (TySum  a b) = do { occurs v a; occurs v b }-occurs v (TyVar v') | v == v' = throwError $ "occurs check failed"-                    | otherwise = return ()---------------------------------- Algorithm W--type E = ExceptT String (State ([String],Integer))-type M a = E (Subst, a)--log0 :: Int -> String -> E ()-log0 i x = do { (l, s) <- get; put ((x'++x):l, s); }- where x' = foldl (\p q -> "\t" ++ p) "" [0..i]--fresh :: E MTy-fresh = do { (l,s) <- get; put (l, s + 1); return $ TyVar $ "v" ++ show s }--inst :: TypSch -> E (MTy,[MTy])-inst (Forall vs ty) = do { vs' <- mapM (\_->fresh) vs; return $ (subst (zip vs vs') ty,  vs') }--gen :: Ctx -> MTy -> (TypSch, [Var])-gen g t = (Forall vs t , vs)- where vs = nub $ filter (\v -> not $ elem v (vars g)) (vars t)--fTyApp x [] = x-fTyApp x y = FTyApp x y--fTyAbs [] x = x-fTyAbs x y = FTyAbs x y--replace [] _ = []-replace (_:xs) (0,a) = a:xs-replace (x:xs) (n,a) =-  if n < 0-    then (x:xs)-    else x: replace xs (n-1,a)--checkAgainstF :: ADTs -> Ctx -> MTy -> FExpr -> E ()-checkAgainstF adts g t e = case (typeOf adts [] g' e) of-                              Left err -> throwError  $ "\t" ++  "err: " ++ err-                              Right tt -> if tt == mTyToFTy t-                                          then return ()-                                          else throwError $ show g ++ "|- " ++ show e ++ ": " ++ show tt ++ " != " ++ show t- where g' = map (\(k,v)->(k, tyToFTy v)) g--w :: Int -> ADTs -> Ctx -> Expr -> M (MTy, FExpr)-w l adts g (Case' e es') = do { t <- fresh-                            ; bs' <- mapM (\_->fresh) es'-                            ; let bs = map (\k-> TyFn k t) bs'-                            ; (phi , (ts, es)) <- w' (l+1) g es'-                            ; m1 <- mgu' bs ts-                            ; (phi', (t', e')) <- w  (l+1) adts (subst (m1 `o` phi) g) e-                            ; m2 <- mgu (subst (m1 `o` phi) t') (subst (m1 `o` phi' `o` phi) $ TyVariant bs')-                            ; let ret = FCase (subst (m2 ) e') (mTyToFTy ret_t) (map (subst $ m2 `o` phi' `o` m1) es)-                                  ret_t = subst ret_subst t-                                  ret_subst = m2 `o` phi' `o` m1 `o` phi-                            ; checkAgainstF adts (subst ret_subst g) ret_t ret-                            ; return (ret_subst, (ret_t, ret)) }- where w' l g [] = return (idSubst, ([], []))-       w' l g (e:tl) = do { (u,(u', j)) <- w l adts g e-                        ; (r,(r', h)) <- w' l (subst u g ) tl-                        ; return (r `o` u, ((subst r u'):r', (subst r j):h)) }-w l adts g (Inj i j e) = do {-                     ; (s0, (t0, a)) <- w (l+1) adts g e-                     ; t'' <- mapM (\_->fresh) [1..j]-                     ; let t' = replace t'' (i, t0)-                     ; let ret = FInj i (map (mTyToFTy) t') a-                           ret_t = TyVariant t'-                           ret_subst = s0-                     ; log0 l $ "INJ " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++  show ret_t-                     ; checkAgainstF adts (subst ret_subst g) ret_t ret-                     ; return (ret_subst, (ret_t, ret)) }-w l adts g (Proj i j e) = do {-                     ; (s0, (t0, a)) <- w (l+1) adts g e-                     ; t' <- mapM (\_->fresh) [1..j]-                     ; s2 <-  t0 `mgu` (TyTuple t')-                     ; let ret = FProj i (subst s2 a)-                           ret_t = subst s2 (t' !! i)-                           ret_subst = s2 `o` s0-                     ; log0 l $ "PROJ " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++  show ret_t-                     ; checkAgainstF adts (subst ret_subst g) ret_t ret-                     ; return (ret_subst, (ret_t, ret)) }-w l adts g (Tuple es') = do { (phi, (ts, es)) <- w' (l+1) g es'-                            ; let ret = FTuple es-                                  ret_t = TyTuple ts-                                  ret_subst = phi-                            ; log0 l $ "TUPLE " ++ show (subst ret_subst g) ++ "|- " ++ (show $ ret) ++ " : " ++  show ret_t-                            ; checkAgainstF adts (subst ret_subst g) ret_t ret-                            ; return (ret_subst, (ret_t, ret)) }- where w' l g [] = return (idSubst, ([], []))-       w' l g (e:tl) = do { (u,(u', j)) <- w l adts g e-                        ; (r,(r', h)) <- w' l (subst u g ) tl-                        ; return (r `o` u, ((subst r u'):r', (subst r j):h)) }-w l adts g (Const p) = do { case primTy adts p of-                              Left er -> throwError er-                              Right t -> do { (ret_t, vs) <- inst t-                        ; let ret = fTyApp (FConst p) $ map mTyToFTy vs-                          ; log0 l $ "CONST " ++ show g ++ "|- " ++  show ret ++ " : " ++ show ret_t-                        ; checkAgainstF adts g ret_t ret-                        ; return (idSubst, (ret_t, ret)) } }-w l adts g (Var x) = case lookup x g of-                Nothing -> throwError $ "Unknown var: " ++ (show x)-                Just s -> do { (ret_t, vs) <- inst s-                             ; let ret = fTyApp (FVar x) $ map mTyToFTy vs-                             ; log0 l $ "VAR " ++ show g ++ "|- " ++ show ret ++ " : " ++ show ret_t-                             ; checkAgainstF adts g ret_t ret-                             ; return (idSubst, (ret_t, ret)) }-w l adts g (App e0 e1) = do {-                     ; (s0, (t0, a)) <- w (l+1) adts g e0-                     ; (s1, (t1, b)) <- w (l+1) adts (subst s0 g) e1-                     ; t' <- fresh-                     ; s2 <-  (subst s1 t0) `mgu` (t1 `TyFn` t')-                     ; let ret = FApp (subst (s2 `o` s1) a) (subst s2 b)-                           ret_t = subst s2 t'-                           ret_subst = s2 `o` (s1 `o` s0);-                     ; log0 l $ "APP " ++ show (subst ret_subst g) ++ "|- " ++ show ret ++ " : " ++  show ret_t-                     ; checkAgainstF adts (subst ret_subst g) ret_t ret-                     ; return (ret_subst, (ret_t, ret)) }-w l adts g (Abs x e) = do {-                        ; t  <- fresh-                        ; (ret_subst, (t', a)) <- w (l+1) adts ((x, (Forall [] t)):g) e-                        ; let ret = FAbs x (mTyToFTy $ subst ret_subst t) a-                              ret_t = TyFn (subst ret_subst t) t'-                        ; log0 l $ "ABS " ++ show (subst ret_subst g) ++ "|- \\" ++ x ++ ". " ++ show ret ++ " : " ++ show ret_t-                        ; checkAgainstF adts (subst ret_subst g) ret_t ret-                        ; return (ret_subst, (ret_t, ret)) }-w l adts g (Letrec xe0 e1) = do {-                         ; t0s <- mapM (\(k,v) -> do { f <- fresh; return (k, f) }) xe0-                         ; let g' = map (\(k,v) -> (k, Forall [] v)) t0s ++ g-                         ; (s0, (ts,e0XS)) <- w' (l+1) g' xe0-                         ; s' <- mgu' (map (\(_,v) -> subst s0 v) t0s) ts-                         ; let g'' = subst (s' `o` s0) g'-                               g'''  = map (\(k,t) -> (k, fst $ gen g (subst s' t))) $ zip (fst $ unzip xe0) ts-                         ; (s1, (t',e1X)) <- w (l+1) adts (g''') e1-                         ; let g''X = map (\(k,t) -> (k, gen g (subst (s') t))) $ zip (fst $ unzip xe0) ts-                               e0Xs = map (subst (s1 `o` s')) e0XS-                               mmm = map (\((x,(ww,ww2)),e0X)->(x, (fTyApp (FVar x) $ map FTyVar ww2))) $  zip g''X e0Xs-                               e0X's =  map (\((x,(ww,ww2)),e0X)->(x,ww,ww2, subst'' mmm e0X)) $ zip g''X e0Xs-                               e0X''s = map (\(x,ww,ww2,e) -> (x,ww,ww2,fTyAbs ww2 e)) e0X's-                               bs = map (\(x,ww,ww2,e0X'') -> (x, subst s1 $ tyToFTy ww, subst (s' `o` s1) e0X'')) e0X''s-                               ret = FLetrec bs e1X-                               ret_t = t'-                               ret_subst = s1 `o` s' `o` s0-                        ; log0 l $ "LETREC " ++ show (subst ret_subst g) ++ "|- " ++ show ret ++ " : " ++ show ret_t-                        ; checkAgainstF adts (subst ret_subst g) ret_t ret-                        ; return (ret_subst, (ret_t, ret)) }- where w' l g [] = return (idSubst, ([], []))-       w' l g  ((k,v):tl) = do { (u,(u', j)) <- w l adts g v-                             ; (r,(r', h)) <- w' l (subst u g ) tl-                             ; return (r `o` u, ((subst r u'):r', (subst r j):h)) }---subst'' :: [(Var, FExpr)] -> FExpr -> FExpr-subst'' phi (FTuple es) = FTuple $ map (subst'' phi) es-subst'' phi (FConst c) = FConst c-subst'' phi (FVar v') = case lookup v' phi of-                         Just y -> y-                         Nothing -> FVar v'-subst'' phi (FApp a b) = FApp (subst'' phi a) (subst'' phi b)-subst'' phi (FAbs v' a b) = FAbs v' a $ subst'' phi' b- where phi' = filter (\(k,v) -> not (k == v')) phi-subst'' phi (FTyApp a ts) = FTyApp (subst'' phi a) ts-subst'' phi (FTyAbs vs a) = FTyAbs vs $ subst'' phi a-subst'' phi (FLetrec es e) = FLetrec (map (\(k,t,f)->(k,t,subst'' phi' f)) es) (subst'' phi' e)- where phi' = filter (\(k,v) -> not (elem k ns)) phi-       (ns,ts,es') = unzip3 es--------------------------------------------- Main--theAdts = theAdtsJosh ++ [("List", ["t"], [("Nil", []), ("Cons", [TyVar "t", TyCon "List" [TyVar "t"]])])]--theAdtsJosh = [("LatLon1", [], [("MkLatLon1", [natType, natType])]),-               ("LatLon2", [], [("MkLatLon2", [natType, natType])])]-{--  data LatLon1 = MkLatOn1 Nat Nat where lat1 (MkLatLon1 a) = a and lon1 (MkLatLon1 b) = b and also data LatLon2 = MkLatOn2 Nat Nat where lat2 (MkLatLon2 a ) = a and lon2 (MkLatLon2  b) = --}--testJoshAdt = Letrec [("lat1", lat1)] body- where body = App (App (Const $ Con "MkLatLon1") (nat 0)) (nat 1)-       lat1 = Abs "z" $ App (App (Const $ Fold "LatLon1") (Var "z")) $ Abs "p" $ Abs "q" $ (Var "p")--testJoshAdt' = Letrec [("lat1", lat1)] $ App (Var "lat1") body- where body = App (App (Const $ Con "MkLatLon1") (nat 0)) (nat 1)-       lat1 = Abs "z" $ App (App (Const $ Fold "LatLon1") (Var "z")) $ Abs "p" $ Abs "q" $ (Var "p")--tests = [testJoshAdt, testJoshAdt'] -- testVariant2, testTuple2, testVariant, testTuple, test_j_0, test_j_0' , testJ,  test4, testk, testC, testA, test0, test1, testB, test2, test3a, test5, test6]--testk = Letrec [("f", f), ("g", g)] b- where b = Tuple [(Var "f"), (Var "g")]-       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x")-       g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0)--testJ = letrec' "f" i b- where i = Abs "x" (Var "x")-       b = Var "f"--testAdt = Abs "z" $ App (App (App (Const $ Fold "List") $ Var "z") (Const $ Con "Nil")) (Const $ Con "Cons")--testOne t = do { putStrLn $ "Untyped input: "-               ; putStrLn $ "\t" ++  show t-               ; let out = runState (runExceptT (w 0 theAdts [] t)) ([],0)-               ; case fst out of-                   Left  e -> do { putStrLn $ "\t" ++ "err: " ++ e-                                 ; putStrLn $ "\nLog:"-                                 ; mapM_ (putStrLn) $ reverse $ fst $ snd out }-                   Right (s, (ty, f)) -> do { putStrLn $ "\nType inferred by Hindley-Milner: "-                                            ; putStrLn $ "\t" ++ show ty-                                            ; putStrLn "\nSystem F translation: "-                                            ; putStrLn $ "\t" ++ show f-                                            -- ; putStrLn "\nLog: "-                                            -- ; mapM_ (putStrLn) $ reverse $ fst $ snd out-                                            }-               ; putStrLn ""-               ; putStrLn "------------------------"-               ; putStrLn ""  }--main = mapM testOne tests--letrec' x e f = Letrec [(x,e)] f--testVariant :: Expr-testVariant = Abs "z" $ Case' (Var "z") [f,g]- where f = Abs "x" {-- $ Inj 0 2 --} $ Var "x"-       g = Abs "y" {-- $ Inj 1 2 --} $ Var "y"-      -- t = Variant [f, g]--testVariant2 :: Expr-testVariant2 = Abs "z" $ Case' (Var "z") [f,g]- where f = Abs "x" $ Inj 0 2 $ Var "x"-       g = Abs "y" $ Inj 1 2 $ Var "y"-      -- t = Variant [f, g]--testTuple2 :: Expr-testTuple2 = Abs "z" $ Tuple [(Proj 0 2 $ Var "z"), (Proj 1 2 $ Var "z")]--testTuple :: Expr-testTuple = Letrec [("t", t)] $ Tuple [Proj 1 2 $ Var "t", Proj 0 2 $ Var "t"]- where f = str "alice"-       g = nat 0-       t = Tuple [f, g]---testA :: Expr-testA =  letrec' "f" ( (Abs "x" (Var "x"))) $ App (Var "f")  (nat 0)- where sng0 = App (Var "sng") (nat 0)-       sngAlice = App (Var "sng") (str "alice")-       body = (Var "sng")--test0 :: Expr-test0 =  letrec' "f" (App (Abs "x" (Var "x")) (nat 0)) (Var "f")- where sng0 = App (Var "sng") (nat 0)-       sngAlice = App (Var "sng") (str "alice")---testB :: Expr-testB = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body- where-       body = (Var "sng")--test1 :: Expr-test1 = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body- where sng0 = App (Var "sng") (nat 0)-       sngAlice = App (Var "sng") (str "alice")-       body = App (App (Const Pair) sng0) sngAlice--test2 :: Expr-test2 = letrec' "+" (Abs "x" $ Abs "y" $ recCall) twoPlusOne- where-   recCall = App constSucc $ App (App (Var "+") (App constPred (Var "x"))) (Var "y")-   ifz x y z = App (App (App (Const If0) x) y) z-   twoPlusOne = App (App (Var "+") two) one-   two = App constSucc one-   one = App constSucc (nat 0)--testC :: Expr-testC = letrec' "+" (Abs "x" $ Abs "y" $ recCall) $ twoPlusOne- where-   recCall = App constSucc $ App (App (Var "+") (App constPred (Var "x"))) ( (Var "y"))-   ifz x y z = App (App (App (Const If0) x) y) z-   twoPlusOne = App (App (Var "+") two) one-   two = App constSucc one-   one = App constSucc (nat 0)--test3 :: Expr-test3 = letrec' "f" f x- where x =  (Var "f")-       f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x")--test3a :: Expr-test3a = Letrec [("f", f), ("g", g)] x- where x =  App (App (Const $ Pair) (Var "f")) (Var "g")-       f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x")-       g = Abs "xx" $ Abs "yy" $ App (App (Var "g") (nat 0)) (Var "xx")--test4 :: Expr-test4 = Letrec [("f", f), ("g", g)] b- where b = App (App (Const Pair) (Var "f")) (Var "g")-       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x")-       g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0)--test5 :: Expr-test5 = Letrec [("f", f), ("g", g)] b- where b = App (App (Const Pair) (Var "f")) (Var "g")-       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (nat 0)-       g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0)---test6 :: Expr-test6 = Letrec [("f", f), ("g", g)] b- where b = App (App (Const Pair) (Var "f")) (Var "g")-       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x")-       g = Abs "u" $ Abs "v" $ App (App (Var "f") (nat 0)) (nat 0)---x @@ y = App x y-zero = nat 0--test_j_o_haskell = f-  where-    sng = \x -> [x]-    f = \x y -> (sng x, sng y): []-    g = \x y -> f 0 y---- @joshsh's additional test cases-test_j_0 :: Expr-test_j_0 = Letrec [("singleton", singleton), ("f", f), ("g", g)] $ Var "f"-  where-    singleton = Abs "x" $ Const Cons @@ Var "x" @@ Const Nil-    f = Abs "x" $ Abs "y" $ Const Cons-      @@ (Const Pair-        @@ (Var "singleton" @@ Var "x")-        @@ (Var "singleton" @@ Var "y"))-      @@ (Var "g" @@ Var "x" @@ Var "y")-    g = Abs "x" $ Abs "y" $ Var "f" @@ zero @@ Var "y"--test_j_0' :: Expr-test_j_0' = Letrec [("singleton", singleton)] $- Letrec [("f", f), ("g", g)] $ Var "f"-  where-    singleton = Abs "x" $ Const Cons @@ Var "x" @@ Const Nil-    f = Abs "x" $ Abs "y" $ Const Cons-      @@ (Const Pair-        @@ (Var "singleton" @@ Var "x")-        @@ (Var "singleton" @@ Var "y"))-      @@ (Var "g" @@ Var "x" @@ Var "y")-    g = Abs "x" $ Abs "y" $ Var "f" @@ zero @@ Var "y"----test_j_0 :: Expr---test_j_0 = Let "id" i $ f-  --where-   -- i = Abs "z" $ Var "z"-   -- f = Abs "p0" $-     --  (Const Pair)-       -- @@ (Var "id" @@ Var "p0")-       -- @@ (Var "p0")
− src/main/haskell/Hydra/Inference/AlgorithmWBridge.hs 
@@ -1,274 +0,0 @@--- | Wrapper for @wisnesky's Algorithm W implementation which makes it into an alternative inferencer for Hydra--module Hydra.Inference.AlgorithmWBridge where--import Hydra.Inference.AlgorithmW--import qualified Hydra.Core as Core-import qualified Hydra.Graph as Graph-import qualified Hydra.Dsl.Literals as Literals-import qualified Hydra.Dsl.LiteralTypes as LiteralTypes-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types-import Hydra.Sources.Libraries-import Hydra.Basics-import Hydra.Strip-import Hydra.Tier1-import Hydra.Coders-import Hydra.Inference.Substitution-import Hydra.Rewriting--import qualified Data.List as L-import qualified Data.Map as M-import qualified Control.Monad as CM--import Control.Monad.Except-import Control.Monad.State----- A minimal Hydra graph container for use in these translation functions-data HydraContext = HydraContext (M.Map Core.Name Graph.Primitive)---------------------------------------------- | Find all of the bound variables in the type annotations within a System F term.---   This function considers the types in "typed terms" (term:type), domain types on lambdas (\v:type.term),---   and also type abstractions (/\v.term) to provide bound type variables.-boundTypeVariablesInSystemFTerm :: Core.Term -> [Core.Name]-boundTypeVariablesInSystemFTerm = L.nub . foldOverTerm TraversalOrderPost addTypeVars []-  where-    addTypeVars vars term = typeVarsIn term ++ vars-    typeVarsIn term = case term of-      Core.TermFunction (Core.FunctionLambda (Core.Lambda _ (Just typ) _)) -> boundVariablesInTypeOrdered typ-      Core.TermTypeAbstraction (Core.TypeAbstraction v _) -> [v]-      Core.TermTyped (Core.TypedTerm term typ) -> boundVariablesInTypeOrdered typ-      _ -> []--boundTypeVariablesInTermOrdered :: Core.Term -> [Core.Name]-boundTypeVariablesInTermOrdered = L.nub . foldOverTerm TraversalOrderPre fld []-  where-    fld vars term = case term of-      Core.TermTyped (Core.TypedTerm _ typ) -> variablesInTypeOrdered False typ ++ vars-      _ -> vars---- | Finds all of the universal type variables in a type expression, in the order in which they appear.--- Note: this function assumes that there are no shadowed type variables, as in (forall a. forall a. a)--- TODO: redundant with variablesInTypeOrdered-boundVariablesInTypeOrdered :: Core.Type -> [Core.Name]-boundVariablesInTypeOrdered typ = case typ of-  Core.TypeLambda (Core.LambdaType var body) -> var:(boundVariablesInTypeOrdered body)-  t -> L.concat (boundVariablesInTypeOrdered <$> subtypes t)---- | Replace arbitrary bound type variables like v, a, v_12 with the systematic type variables t0, t1, t2, ...---   following a canonical ordering in the term.---   This function assumes that the bound variables do not also appear free in the type expressions of the term,---   which in Hydra is made less likely by using the unusual naming convention tv_0, tv_1, etc. for temporary variables.-normalizeBoundTypeVariablesInSystemFTerm :: Core.Term -> Core.Term-normalizeBoundTypeVariablesInSystemFTerm term = replaceTypeVariablesInSystemFTerm subst term-  where-    actualVars = boundTypeVariablesInSystemFTerm term-    subst = M.fromList $ L.zip actualVars normalVariables--replaceTypeVariables :: M.Map Core.Name Core.Name -> Core.Type -> Core.Type-replaceTypeVariables subst = rewriteType $ \recurse t -> case recurse t of-    Core.TypeVariable v -> Core.TypeVariable $ replace v-    Core.TypeLambda (Core.LambdaType v body) -> Core.TypeLambda $ Core.LambdaType (replace v) body-    t1 -> t1-  where-    replace v = M.findWithDefault v v subst---- Note: this will replace all occurrences, regardless of boundness or shadowing-replaceTypeVariablesInSystemFTerm :: M.Map Core.Name Core.Name -> Core.Term -> Core.Term-replaceTypeVariablesInSystemFTerm subst = rewriteTerm $ \recurse term ->-  case recurse term of-    Core.TermFunction (Core.FunctionLambda (Core.Lambda v (Just mt) body)) ->-        Core.TermFunction $ Core.FunctionLambda $ Core.Lambda v (Just mt2) body-      where-        mt2 = replaceTypeVariables subst mt-    Core.TermTypeAbstraction (Core.TypeAbstraction v body) -> Core.TermTypeAbstraction $ Core.TypeAbstraction v2 body-      where-        v2 = M.findWithDefault v v subst-    Core.TermTyped (Core.TypedTerm term typ) -> Core.TermTyped $ Core.TypedTerm term (replaceTypeVariables subst typ)-    t -> t---- | Find the variables (both bound and free) in a type expression, following a preorder traversal of the expression.-variablesInTypeOrdered :: Bool -> Core.Type -> [Core.Name]-variablesInTypeOrdered onlyBound = L.nub . vars -- Note: we rely on the fact that 'nub' keeps the first occurrence-  where-    vars t = case t of-      Core.TypeLambda (Core.LambdaType v body) -> v:(vars body)-      Core.TypeVariable v -> if onlyBound then [] else [v]-      _ -> L.concat (vars <$> subtypes t)---------------------------------------------- Note: no support for @wisnesky's Prim constructors other than PrimStr, PrimNat, Cons, and Nil-hydraTermToStlc :: HydraContext -> Core.Term -> Either String Expr-hydraTermToStlc context term = case term of-    Core.TermApplication (Core.Application t1 t2) -> App <$> toStlc t1 <*> toStlc t2-    Core.TermFunction f -> case f of-      Core.FunctionLambda (Core.Lambda (Core.Name v) _ body) -> Abs <$> pure v <*> toStlc body-      Core.FunctionPrimitive name -> do-        prim <- case M.lookup name prims of-          Nothing -> Left $ "no such primitive: " ++ Core.unName name-          Just p -> Right p-        ts <- hydraTypeSchemeToStlc $ Graph.primitiveType prim-        return $ Const $ TypedPrim $ TypedPrimitive name ts-    Core.TermLet (Core.Let bindings env) -> Letrec <$> CM.mapM bindingToStlc bindings <*> toStlc env-      where-        bindingToStlc (Core.LetBinding (Core.Name v) term _) = do-          s <- toStlc term-          return (v, s)-    Core.TermList els -> do-      sels <- CM.mapM toStlc els-      return $ foldr (\el acc -> App (App (Const Cons) el) acc) (Const Nil) sels-    Core.TermLiteral lit -> pure $ Const $ Lit lit-    Core.TermProduct els -> Tuple <$> (CM.mapM toStlc els)-    Core.TermVariable (Core.Name v) -> pure $ Var v-    _ -> Left $ "Unsupported term: " ++ show term-  where-    HydraContext prims = context-    toStlc = hydraTermToStlc context-    pair a b = App (App (Const Pair) a) b--hydraTypeSchemeToStlc :: Core.TypeScheme -> Either String TypSch-hydraTypeSchemeToStlc (Core.TypeScheme vars body) = do-    sbody <- toStlc body-    return $ Forall (Core.unName <$> vars) sbody-  where-    toStlc typ = case stripType typ of-      Core.TypeFunction (Core.FunctionType dom cod) -> TyFn <$> toStlc dom <*> toStlc cod-      Core.TypeList et -> TyList <$> toStlc et-      Core.TypeLiteral lt -> pure $ TyLit lt---      TypeMap MapType |---      TypeOptional Type |-      Core.TypeProduct types -> TyTuple <$> (CM.mapM toStlc types)---      TypeRecord RowType |---      TypeSet Type |---      TypeStream Type |-      Core.TypeSum types -> if L.length types == 0-        then pure TyVoid-        else if L.length types == 1-          then Left $ "unary sums are not yet supported"-          else do-            stypes <- CM.mapM toStlc types-            let rev = L.reverse stypes-            return $ L.foldl (\a e -> TySum e a) (TySum (rev !! 1) (rev !! 0)) $ L.drop 2 rev---      TypeUnion RowType |-      Core.TypeVariable name -> pure $ TyVar $ Core.unName name---      TypeWrap (Nominal Type)-      _ -> Left $ "unsupported type: " ++ show typ----- hydraTypeToTypeScheme :: Core.Type -> Either String TypSch--- hydraTypeToTypeScheme typ = do---     let (boundVars, baseType) = splitBoundVars [] typ---     ty <- toStlc baseType---     return $ Forall (Core.unName <$> boundVars) ty---   where---     splitBoundVars vars typ = case stripType typ of---       Core.TypeLambda (Core.LambdaType v body) -> (v:vars', typ')---         where---           (vars', typ') = splitBoundVars vars body---       _ -> (vars, typ)--systemFExprToHydra :: FExpr -> Either String Core.Term-systemFExprToHydra expr = case expr of-  FConst prim -> case prim of-    Lit lit -> pure $ Core.TermLiteral lit-    TypedPrim (TypedPrimitive name _) -> pure $ Core.TermFunction $ Core.FunctionPrimitive name-    Nil -> pure $ Core.TermList []-    _ -> Left $ "Unsupported primitive: " ++ show prim-    -- Note: other prims are unsupported-  FVar v -> pure $ Core.TermVariable $ Core.Name v-  FApp e1 e2 -> case e1 of-    FApp (FTyApp (FConst Cons) _) hd -> do-        els <- CM.mapM systemFExprToHydra (hd:(gather e2))-        return $ Core.TermList els -- TODO: include inferred type-      where-        gather e = case e of-          FTyApp (FConst Nil) _ -> []-          FApp (FApp (FTyApp (FConst Cons) _) hd) tl -> hd:(gather tl)-    FTyApp (FConst Pair) _ -> do---        els <- CM.mapM systemFExprToHydra (gather expr)-        els <- pure []-        return $ Core.TermProduct els -- TODO: include inferred type-      where-        gather e = case e of-          FApp (FApp (FTyApp (FConst Pair) _) el) arg -> el:(gather arg)-          _ -> [e]-    _ -> Core.TermApplication <$> (Core.Application <$> systemFExprToHydra e1 <*> systemFExprToHydra e2)-  FAbs v dom e -> do-    term <- systemFExprToHydra e-    hdom <- Core.typeSchemeType <$> systemFTypeToHydra dom-    return $ Core.TermFunction $ Core.FunctionLambda (Core.Lambda (Core.Name v) (Just hdom) term)-  FTyAbs params body -> do-    hbody <- systemFExprToHydra body-    return $ L.foldl (\t v -> Core.TermTypeAbstraction $ Core.TypeAbstraction (Core.Name v) t) hbody $ L.reverse params-  FTyApp fun args -> do-    hfun <- systemFExprToHydra fun-    hargs <- CM.mapM (\t -> Core.typeSchemeType <$> systemFTypeToHydra t) args-    return $ L.foldl (\t a -> Core.TermTypeApplication $ Core.TypedTerm t a) hfun $ L.reverse hargs-  FLetrec bindings env -> Core.TermLet <$>-      (Core.Let <$> CM.mapM bindingToHydra bindings <*> systemFExprToHydra env)-    where-      bindingToHydra (v, ty, term) = do-        hterm <- systemFExprToHydra term-        hts <- systemFTypeToHydra ty-        return $ Core.LetBinding (Core.Name v) hterm $ Just hts-  FTuple els -> Core.TermProduct <$> (CM.mapM systemFExprToHydra els)-  FInj i types e -> Core.TermSum <$> (Core.Sum i (L.length types) <$> systemFExprToHydra e)--systemFTypeToHydra :: FTy -> Either String Core.TypeScheme-systemFTypeToHydra ty = case ty of-    FForall vars body -> Core.TypeScheme (Core.Name <$> vars) <$> toHydra body-    _ -> Core.TypeScheme [] <$> toHydra ty-  where-    toHydra ty = case ty of-      FTyVar v -> pure $ Core.TypeVariable $ Core.Name v-      FTyLit lt -> pure $ Core.TypeLiteral lt-      FTyList lt -> Core.TypeList <$> toHydra lt-      FTyFn dom cod -> Core.TypeFunction <$> (Core.FunctionType <$> toHydra dom <*> toHydra cod)-      FTyProd t1 t2 -> Core.TypeProduct <$> CM.mapM toHydra (t1:(componentsTypesOf t2))-        where-          componentsTypesOf t = case t of-            FTyProd t1 t2 -> t1:(componentsTypesOf t2)-            _ -> [t]-      FTySum t1 t2 -> Core.TypeSum <$> CM.mapM toHydra (t1:(componentsTypesOf t2))-        where-          componentsTypesOf t = case t of-            FTySum t1 t2 -> t1:(componentsTypesOf t2)-            _ -> [t]-      FTyUnit -> pure $ Core.TypeProduct []-      FTyVoid -> pure $ Core.TypeSum []-      FTyTuple tys -> Core.TypeProduct <$> (CM.mapM toHydra tys)-      FTyVariant tys -> Core.TypeSum <$> (CM.mapM toHydra tys)--inferWithAlgorithmW :: HydraContext -> Core.Term -> IO Core.Term-inferWithAlgorithmW context term = do-    stlc <- case hydraTermToStlc context (wrap term) of-       Left err -> fail err-       Right t -> return t-    (fexpr, _) <- inferExpr stlc-    case systemFExprToHydra fexpr of-      Left err -> fail err-      Right t -> normalizeBoundTypeVariablesInSystemFTerm <$> unwrap t-  where-    sFieldName = Core.Name "tempVar"-    wrap term = Core.TermLet $ Core.Let ([Core.LetBinding sFieldName term Nothing]) $-      Core.TermLiteral $ Core.LiteralString "tempEnvironment"-    unwrap term = case term of-      Core.TermLet (Core.Let bindings _) -> case bindings of-        [(Core.LetBinding fname t _)] -> if fname == sFieldName-          then pure t-          else fail "expected let binding matching input"-        _ -> fail "expected let bindings"--inferExpr :: Expr -> IO (FExpr, FTy)-inferExpr t = case (fst $ runState (runExceptT (w 0 [] [] t)) ([],0)) of-  Left e -> fail $ "inference error: " ++ e-  Right (_, (ty, f)) -> case (typeOf [] [] [] f) of-    Left err -> fail $ "type error: " ++ err-    Right tt -> if tt == mTyToFTy ty-      then return (f, tt)-      else fail "no match"
− src/main/haskell/Hydra/Inference/AltInference.hs 
@@ -1,518 +0,0 @@-module Hydra.Inference.AltInference where--import Hydra.Basics-import Hydra.Core-import Hydra.Compute-import Hydra.Mantle-import qualified Hydra.Flows as F-import qualified Hydra.Tier1 as Tier1-import qualified Hydra.Lib.Flows as Flows-import qualified Hydra.Dsl.Types as Types--import qualified Data.List as L-import qualified Data.Map as M-------------------------------------------------------------------------------------- Graphs--showType :: Type -> String-showType (TypeFunction (FunctionType dom cod)) = "(" ++ showType dom ++ "→" ++ showType cod ++ ")"-showType (TypeList etyp) = "[" ++ showType etyp ++ "]"-showType (TypeLiteral lit) = show lit-showType (TypeMap (MapType keyTyp valTyp)) = "map<" ++ showType keyTyp ++ "," ++ showType valTyp ++ ">"-showType (TypeProduct types) = "(" ++ (L.intercalate "," (fmap showType types)) ++ ")"-showType (TypeVariable (Name name)) = name--showTypeScheme :: TypeScheme -> String-showTypeScheme (TypeScheme vars body) = "∀[" ++ (L.intercalate "," (fmap (\(Name name) -> name) vars)) ++ "]." ++ showType body--showConstraint :: TypeConstraint -> String-showConstraint (TypeConstraint ltyp rtyp _) = showType ltyp ++ "≡" ++ showType rtyp------------------------------------------------------------------------------------- Unification--type UnificationContext = Maybe String--data SUnificationError-  = SUnificationErrorCannotUnify Type Type UnificationContext-  | SUnificationErrorOccursCheckFailed Name Type UnificationContext-  deriving (Eq, Ord, Show)--sOccursIn :: Name -> Type -> Bool-sOccursIn var typ = case typ of-  TypeFunction (FunctionType domTyp codTyp) -> sOccursIn var domTyp || sOccursIn var codTyp-  TypeList etyp -> sOccursIn var etyp-  TypeLiteral _ -> False-  TypeMap (MapType keyTyp valTyp) -> sOccursIn var keyTyp || sOccursIn var valTyp-  TypeProduct types -> any (sOccursIn var) types-  TypeVariable name -> var == name---- sComposeSubst :: SSubst -> SSubst -> SSubst--- sComposeSubst s1 s2 = ...--{--Robinson's algorithm, following https://www.cs.cornell.edu/courses/cs6110/2017sp/lectures/lec23.pdf-Specifically this is an implementation of the following rules:- * Unify({(x, t)} ∪ E) = {t/x} Unify(E{t/x}) if x ∉ FV(t)- * Unify(∅) = I (the identity substitution x ↦ x)- * Unify({(x, x)} ∪ E) = Unify(E)- * Unify({(f(s1, ..., sn), f(t1, ..., tn))} ∪ E) = Unify({(s1, t1), ..., (sn, tn)} ∪ E)--}-uUnify :: [TypeConstraint] -> Either SUnificationError SSubst--- uUnify = L.foldl helper sEmptySubst---   where---     helper s (TypeConstraint t1 t2 ctx) = case t1 of---       TypeVariable v1 -> case t2 of---         TypeVariable v2 -> if v1 == v2---           then Right s---           else uBind v1 t2---         _ -> unifyVar s v1 t2---       _ -> case t2 of---         TypeVariable v2 -> unifyVar v2 t1---         _ -> unifyOther s t1 t2---     unifyVar s v t = if sOccursIn v t -- TODO: expensive occurs check---       then Left $ SUnificationErrorOccursCheckFailed v t ctx---       else Right $ M.singleton v t---     unifyOther s t1 t2 = ...-uUnify constraints = case constraints of-    [] -> Right sEmptySubst-    ((TypeConstraint t1 t2 ctx):rest) -> case t1 of-        TypeVariable v1 -> case t2 of-          TypeVariable v2 -> if v1 == v2-            then uUnify rest-            else uBind v1 t2-          _ -> uBind v1 t2-        _ -> case t2 of-          TypeVariable v2 -> uBind v2 t1-          _ -> uUnifyOther t1 t2-      where-        -- TODO: this occurs check is expensive; consider delaying it until the time of substitution-        uBind v t = if sOccursIn v t-            then Left $ SUnificationErrorOccursCheckFailed v t ctx-            else case uUnify (L.map (uSubstInConstraint v t) rest) of-              Left err -> Left err-              Right subst -> Right $ SSubst $ M.union (M.singleton v $ sSubstituteTypeVariables subst t) $ sUnSubst subst-        uUnifyOther t1 t2 = case t1 of-            TypeFunction (FunctionType dom1 cod1) -> case t2 of-              TypeFunction (FunctionType dom2 cod2) -> uUnify $ [-                (TypeConstraint dom1 dom2 ctx), (TypeConstraint cod1 cod2 ctx)] ++ rest-              _ -> cannotUnify-            TypeList l1 -> case t2 of-              TypeList l2 -> uUnify $ [(TypeConstraint l1 l2 ctx)] ++ rest-              _ -> cannotUnify-            TypeLiteral lit1 -> case t2 of-              TypeLiteral lit2 -> if lit1 == lit2-                then uUnify rest-                else cannotUnify-              _ -> cannotUnify-            TypeMap (MapType key1 val1) -> case t2 of-              TypeMap (MapType key2 val2) -> uUnify $ [-                (TypeConstraint key1 key2 ctx), (TypeConstraint val1 val2 ctx)] ++ rest-              _ -> cannotUnify-            TypeProduct types1 -> case t2 of-              TypeProduct types2 -> if L.length types1 /= L.length types2-                then cannotUnify-                else uUnify $ L.zipWith (\t1 t2 -> TypeConstraint t1 t2 ctx) types1 types2 ++ rest-              _ -> cannotUnify-          where-            cannotUnify = Left $ SUnificationErrorCannotUnify t1 t2 ctx---- TODO: substituting one variable at a time is inefficient-uSubst :: Name -> Type -> Type -> Type-uSubst v t typ = case typ of-  TypeFunction (FunctionType dom cod) -> TypeFunction $ FunctionType (uSubst v t dom) (uSubst v t cod)-  TypeList etyp -> TypeList $ uSubst v t etyp-  TypeLiteral _ -> typ-  TypeMap (MapType key val) -> TypeMap $ MapType (uSubst v t key) (uSubst v t val)-  TypeProduct types -> TypeProduct $ fmap (uSubst v t) types-  TypeVariable name -> if name == v then t else typ--uSubstInConstraint :: Name -> Type -> TypeConstraint -> TypeConstraint-uSubstInConstraint v t (TypeConstraint t1 t2 ctx) = TypeConstraint (uSubst v t t1) (uSubst v t t2) ctx------------------------------------------------------------------------------------- Substitution--data SSubst = SSubst { sUnSubst :: M.Map Name Type }--instance Show SSubst where-  show (SSubst subst) = "{" ++ L.intercalate ", " (fmap (\((Name k), v) -> k ++ ": " ++ showType v) $ M.toList subst) ++ "}"--sEmptySubst = SSubst M.empty--sSubstituteTypeVariables :: SSubst -> Type -> Type-sSubstituteTypeVariables subst typ = case typ of-  TypeFunction (FunctionType dom cod) -> TypeFunction $-    FunctionType (sSubstituteTypeVariables subst dom) (sSubstituteTypeVariables subst cod)-  TypeList etyp -> TypeList $ sSubstituteTypeVariables subst etyp-  TypeLiteral _ -> typ-  TypeMap (MapType key val) -> TypeMap $-    MapType (sSubstituteTypeVariables subst key) (sSubstituteTypeVariables subst val)-  TypeProduct types -> TypeProduct $ fmap (sSubstituteTypeVariables subst) types-  TypeVariable name -> case M.lookup name (sUnSubst subst) of-    Just styp -> styp-    Nothing -> typ---- TODO: remove unused bound type variables-sSubstituteTypeVariablesInScheme :: SSubst -> TypeScheme -> TypeScheme-sSubstituteTypeVariablesInScheme subst (TypeScheme vars typ) = TypeScheme vars $ sSubstituteTypeVariables subst typ-------------------------------------------------------------------------------------- Inference--data SInferenceContext-  = SInferenceContext {-    sInferenceContextLexicon :: M.Map Name TypeScheme,-    sInferenceContextVariableCount :: Int,-    sInferenceContextTypingEnvironment :: M.Map Name TypeScheme}-  deriving (Eq, Ord, Show)--data SInferenceResult-  = SInferenceResult {-    sInferenceResultScheme :: TypeScheme,-    sInferenceResultConstraints :: [TypeConstraint]}-  deriving (Eq, Ord)-instance Show SInferenceResult where-  show (SInferenceResult scheme constraints) = "{type= " ++ showTypeScheme scheme ++ ", constraints= " ++ show constraints ++ "}"--sInferType :: Term -> Flow SInferenceContext TypeScheme-sInferType term = Flows.bind (sInferTypeInternal term) unifyAndSubst-  where-    unifyAndSubst :: SInferenceResult -> Flow SInferenceContext TypeScheme-    unifyAndSubst result = Flows.bind (F.fromEither $ uUnify $ sInferenceResultConstraints result) doSubst-      where-        doSubst :: SSubst -> Flow SInferenceContext TypeScheme-        doSubst subst = sInstantiateAndNormalize $ sSubstituteTypeVariablesInScheme subst $ sInferenceResultScheme result--sInferTypeInternal :: Term -> Flow SInferenceContext SInferenceResult-sInferTypeInternal term = case term of--    TermApplication (Application lterm rterm) -> Flows.bind sNewVar withVar1-      where-        withVar1 dom = Flows.bind sNewVar withVar2-          where-            withVar2 cod = Flows.bind (sInferTypeInternal lterm) withLeft-              where-                withLeft lresult = Flows.bind (sInferTypeInternal rterm) withRight-                  where-                    withRight rresult = Flows.pure $ SInferenceResult (TypeScheme tvars $ TypeVariable cod) $ [-                        TypeConstraint (Types.function (TypeVariable dom) (TypeVariable cod)) ltyp ctx,-                        TypeConstraint (TypeVariable dom) rtyp ctx]-                        ++ sInferenceResultConstraints lresult ++ sInferenceResultConstraints rresult-                      where-                        ctx = Just "application"-                        ltyp = typeSchemeType $ sInferenceResultScheme lresult-                        rtyp = typeSchemeType $ sInferenceResultScheme rresult-                        tvars = typeSchemeVariables (sInferenceResultScheme lresult) ++ typeSchemeVariables (sInferenceResultScheme rresult)--    TermFunction (FunctionLambda (Lambda var _ body)) -> Flows.bind sNewVar withVar-     where-        withVar tvar = sWithTypeBinding var (Types.mono $ TypeVariable tvar) $ Flows.map withBodyType (sInferTypeInternal body)-          where-            -- TODO: prove that tvar will never appear in vars-            withBodyType (SInferenceResult (TypeScheme vars t) constraints)-              = SInferenceResult (TypeScheme (tvar:vars) $ Types.function (TypeVariable tvar) t) constraints--    -- TODO: propagate rawValueVars and envVars into the final result, possibly after substitution-    -- TODO: recursive and mutually recursive let-    TermLet (Let bindings env) -> if L.length bindings > 2-        then sInferTypeInternal $ TermLet (Let [L.head bindings] $ TermLet $ Let (L.tail bindings) env)-        else forSingleBinding $ L.head bindings-      where-        forSingleBinding (LetBinding key value _) = Flows.bind sNewVar withVar-          where-            -- Create a temporary type variable for the binding-            withVar var = sWithTypeBinding key (Types.mono $ TypeVariable var) $-                Flows.bind (sInferTypeInternal value) withValueType-              where-                -- Unify and substitute over the value constraints-                -- TODO: save the substitution and pass it along, instead of the original set of constraints-                withValueType (SInferenceResult rawValueScheme valueConstraints) = Flows.bind (F.fromEither $ uUnify kvConstraints) afterUnification-                  where-                    rawValueVars = typeSchemeVariables rawValueScheme-                    kvConstraints = keyConstraint:valueConstraints-                    keyConstraint = TypeConstraint (TypeVariable var) (typeSchemeType rawValueScheme) $ Just "let binding"-                    -- Now update the type binding to use the inferred type-                    afterUnification subst = sWithTypeBinding key valueScheme-                        $ Flows.map withEnvType (sInferTypeInternal env)-                      where-                        valueScheme = sSubstituteTypeVariablesInScheme subst rawValueScheme-                        withEnvType (SInferenceResult envScheme envConstraints) = SInferenceResult envScheme constraints-                          where-                            constraints = kvConstraints ++ envConstraints-                            envVars = typeSchemeVariables envScheme--    TermList els -> Flows.bind sNewVar withVar-      where-        withVar tvar = if L.null els-            then Flows.pure $ yield (TypeScheme [tvar] $ Types.list $ TypeVariable tvar) []-            else Flows.map fromResults (Flows.sequence (sInferTypeInternal <$> els))-          where-            fromResults results = yield (TypeScheme vars $ Types.list $ TypeVariable tvar) constraints-              where-                uctx = Just "list element"-                constraints = cinner ++ couter-                cinner = L.concat (sInferenceResultConstraints <$> results)-                couter = fmap (\t -> TypeConstraint (TypeVariable tvar) t uctx) types-                types = typeSchemeType . sInferenceResultScheme <$> results-                vars = L.concat (typeSchemeVariables . sInferenceResultScheme <$> results)--    TermLiteral lit -> Flows.pure $ yieldWithoutConstraints $ Types.mono $ TypeLiteral $ literalType lit--    TermMap m -> Flows.bind sNewVar withKeyVar-      where-        withKeyVar kvar = Flows.bind sNewVar withValueVar-          where-            withValueVar vvar = if M.null m-               then Flows.pure $ yield (TypeScheme [kvar, vvar] $ Types.map (TypeVariable kvar) (TypeVariable vvar)) []-               else Flows.map withResults (Flows.sequence $ fmap fromPair $ M.toList m)-              where-                fromPair (k, v) = Flows.bind (sInferTypeInternal k) withKeyType-                  where-                    withKeyType (SInferenceResult (TypeScheme kvars kt) kconstraints) = Flows.map withValueType (sInferTypeInternal v)-                      where-                        withValueType (SInferenceResult (TypeScheme vvars vt) vconstraints)-                          = (kvars ++ vvars,-                             [TypeConstraint (TypeVariable kvar) kt $ Just "map key",-                              TypeConstraint (TypeVariable vvar) vt $ Just "map value"]-                              ++ kconstraints ++ vconstraints)-                withResults pairs = yield (TypeScheme (L.concat (fst <$> pairs)) $ Types.map (TypeVariable kvar) (TypeVariable vvar)) $-                  L.concat (snd <$> pairs)--    TermFunction (FunctionPrimitive name) -> Flow $ \ctx t -> case M.lookup name (sInferenceContextLexicon ctx) of-      Just scheme -> unFlow (Flows.map withoutConstraints $ sInstantiate scheme) ctx t-      Nothing -> unFlow (Flows.fail $ "No such primitive: " ++ unName name) ctx t--    TermProduct els -> if L.null els-      then Flows.pure $ yield (Types.mono $ Types.product []) []-      else Flows.map fromResults (Flows.sequence (sInferTypeInternal <$> els))-      where-        fromResults results = yield (TypeScheme tvars $ TypeProduct tbodies) constraints-          where-            tvars = L.concat $ typeSchemeVariables . sInferenceResultScheme <$> results-            tbodies = typeSchemeType . sInferenceResultScheme <$> results-            constraints = L.concat $ sInferenceResultConstraints <$> results--    TermVariable var -> Flow $ \ctx t -> case M.lookup var (sInferenceContextTypingEnvironment ctx) of-      Just scheme -> unFlow (Flows.map withoutConstraints $ sInstantiate scheme) ctx t-      Nothing -> unFlow (Flows.fail $ "Variable not bound to type: " ++ unName var) ctx t--  where-    unsupported = Flows.fail "Not yet supported"-    yield = SInferenceResult-    yieldWithoutConstraints scheme = yield scheme []-    withoutConstraints scheme = SInferenceResult scheme []--sInstantiate :: TypeScheme -> Flow SInferenceContext TypeScheme-sInstantiate scheme = Flows.map doSubst (sNewVars $ L.length oldVars)-    where-      doSubst newVars = TypeScheme newVars $ sSubstituteTypeVariables subst $ typeSchemeType scheme-        where-          subst = SSubst $ M.fromList $ L.zip oldVars (TypeVariable <$> newVars)-      oldVars = L.intersect (L.nub $ typeSchemeVariables scheme) (sFreeTypeVariables $ typeSchemeType scheme)--sInstantiateAndNormalize :: TypeScheme -> Flow SInferenceContext TypeScheme-sInstantiateAndNormalize scheme = Flows.map sNormalizeTypeVariables (sInstantiate scheme)--sFreeTypeVariables :: Type -> [Name]-sFreeTypeVariables typ = case typ of-  TypeFunction (FunctionType dom cod) -> L.nub $ sFreeTypeVariables dom ++ sFreeTypeVariables cod-  TypeList t -> sFreeTypeVariables t-  TypeLiteral _ -> []-  TypeMap (MapType k v) -> L.nub $ sFreeTypeVariables k ++ sFreeTypeVariables v-  TypeProduct types -> L.nub $ L.concat $ sFreeTypeVariables <$> types-  TypeVariable name -> [name]--sNormalizeTypeVariables :: TypeScheme -> TypeScheme-sNormalizeTypeVariables scheme = TypeScheme newVars $ sSubstituteTypeVariables subst $ typeSchemeType scheme-  where-    normalVariables = (\n -> Name $ "t" ++ show n) <$> [0..]-    oldVars = typeSchemeVariables scheme-    newVars = L.take (L.length oldVars) normalVariables-    subst =SSubst $ M.fromList $ L.zip oldVars (TypeVariable <$> newVars)--sNewVar :: Flow SInferenceContext Name-sNewVar = Flows.map L.head (sNewVars 1)--sNewVars :: Int -> Flow SInferenceContext [Name]-sNewVars n = Flow helper-  where-    helper ctx t = FlowState value ctx' t-      where-        value = Just ((\n -> Name $ "t" ++ show n) <$> (L.take n [(sInferenceContextVariableCount ctx)..]))-        ctx' = ctx {sInferenceContextVariableCount = n + sInferenceContextVariableCount ctx}--sVarScheme :: Name -> TypeScheme-sVarScheme v = TypeScheme [v] $ TypeVariable v---- | Temporarily add a (term variable, type scheme) to the typing environment-sWithTypeBinding :: Name -> TypeScheme -> Flow SInferenceContext a -> Flow SInferenceContext a-sWithTypeBinding name scheme f = Flow helper-  where-    helper ctx0 t0 = FlowState e ctx3 t1-      where-        env = sInferenceContextTypingEnvironment ctx0-        ctx1 = ctx0 {sInferenceContextTypingEnvironment = M.insert name scheme env}-        FlowState e ctx2 t1 = unFlow f ctx1 t0-        ctx3 = ctx2 {sInferenceContextTypingEnvironment = env}-------------------------------------------------------------------------------------- Testing--_app l r = TermApplication $ Application l r-_int = TermLiteral . LiteralInteger . IntegerValueInt32-_lambda v b = TermFunction $ FunctionLambda $ Lambda (Name v) Nothing b-_list = TermList-_map = TermMap-_pair l r = TermProduct [l, r]-_str = TermLiteral . LiteralString-_var = TermVariable . Name--(@@) :: Term -> Term -> Term-f @@ x = TermApplication $ Application f x--infixr 0 >:-(>:) :: String -> Term -> (Name, Term)-n >: t = (Name n, t)--int32 = TermLiteral . LiteralInteger . IntegerValueInt32-lambda v b = TermFunction $ FunctionLambda $ Lambda (Name v) Nothing b-list = TermList-map = TermMap-pair l r = TermProduct [l, r]-string = TermLiteral . LiteralString-var = TermVariable . Name-with env bindings = L.foldl (\e (k, v) -> TermLet $ Let [LetBinding k v Nothing] e) env bindings-----infixr 0 ===-(===) :: Type -> Type -> TypeConstraint-t1 === t2 = TypeConstraint t1 t2 $ Just "some context"---_add = TermFunction $ FunctionPrimitive $ Name "add"-primPred = TermFunction $ FunctionPrimitive $ Name "primPred"-primSucc = TermFunction $ FunctionPrimitive $ Name "primSucc"--_unify t1 t2 = uUnify [TypeConstraint t1 t2 $ Just "ctx"]--sTestLexicon = M.fromList [-  (Name "add", Types.mono $ Types.function Types.int32 Types.int32),-  (Name "primPred", Types.mono $ Types.function Types.int32 Types.int32),-  (Name "primSucc", Types.mono $ Types.function Types.int32 Types.int32)]--sInitialContext = SInferenceContext sTestLexicon 0 M.empty--_infer term = flowStateValue $ unFlow (sInferType term) sInitialContext Tier1.emptyTrace--_inferRaw term = flowStateValue $ unFlow (sInferTypeInternal term) sInitialContext Tier1.emptyTrace--_instantiate scheme = flowStateValue $ unFlow (sInstantiate scheme) sInitialContext Tier1.emptyTrace--_con t1 t2 = TypeConstraint t1 t2 $ Just "ctx"----{---------------------------------------------- Unification--_unify (Types.var "a") (Types.var "b")-_unify (Types.var "a") (Types.list $ Types.var "b")--_unify (Types.var "a") Types.int32--_unify (Types.list Types.string) (Types.list $ Types.var "a")--_unify (Types.map (Types.var "a") Types.int32) (Types.map Types.string (Types.var "b"))--sUnifyAll [Types.var "t1" === Types.var "t0", Types.var "t1" === Types.int32]---- Failure cases--_unify Types.string Types.int32--_unify (Types.var "a") (Types.list $ Types.var "a")--ctx = Just "ctx"-uUnify [(TypeConstraint (Types.var "t1") (Types.var "t0") ctx), (TypeConstraint (Types.var "t1") Types.int32 ctx)]---------------------------------------------- Inference--_infer $ _str "hello"--_infer _add--_infer $ _list [_add]--_infer $ _lambda "x" $ _int 42--_infer $ _list [_int 42]-----_inferRaw (_list [_int 42])----:module-import Hydra.NewInference---- System F cases-_inferRaw (lambda "x" $ var "x")                                                           -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.var "t0"))-_inferRaw (int32 32 `with` ["foo">: lambda "x" $ var "x"])                                 -- (Types.mono Types.int32)-_inferRaw ((var "f" @@ int32 0) `with` ["f">: lambda "x" $ var "x"])                       -- (Types.mono Types.int32)-_inferRaw (var "f" `with` ["f">: (lambda "x" $ var "x") @@ int32 0])                       -- (Types.mono Types.int32)-_inferRaw (lambda "x" $ list [var "x"])                                                    -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))-_inferRaw (var "sng" `with` ["sng">: lambda "x" $ list [var "x"]])                         -- (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))-_inferRaw ((var "+" @@ (primSucc @@ (primSucc @@ int32 0)) @@ (primSucc @@ int32 0)) `with` ["+">: lambda "x" $ lambda "y" (primSucc @@ (var "+" @@ (primPred @@ var "x") @@ var "y"))]) -- (Types.mono Types.int32)-_inferRaw (var "f" `with` ["f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")]) -- (Types.poly ["t0"] $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))----_inferRaw (var "f" `with` ["f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")]) -- (Types.poly ["t0"] $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))----:set +m--constraints = [-  _con (Types.function (Types.var "t5") (Types.var "t6")) (Types.var "t0"),-  _con (Types.var "t5") Types.int32,-  _con (Types.function (Types.var "t3") (Types.var "t4")) (Types.var "t6"),-  _con (Types.var "t3") (Types.var "t1"),-  _con (Types.var "t0") (Types.function (Types.var "t1") (Types.function (Types.var "t2") (Types.var "t4")))]--uUnify constraints-----_inferRaw (_lambda "x" $ _list [_var "x", _int 42])--_inferRaw (_lambda "y" (_a (_lambda "x" $ _list [_var "x"]) (_var "y")))-----_inferRaw (var "sng" `with` ["sng">: lambda "x" $ list [var "x"]])---------------------------------------------- Instantiation--sInstantiate (Types.poly ["t0", "t1"] $ Types.function (Types.var "t1") (Types.var "t1")) sInitialContext-----}
− src/main/haskell/Hydra/Inference/Inference.hs 
@@ -1,140 +0,0 @@--- | Entry point for Hydra type inference, which is a variation on on Hindley-Milner--module Hydra.Inference.Inference (-  inferTermType,-  inferGraphTypes,-  inferredTypeOf,-  inferTypeScheme,-  inferTypeAndConstraints,-  withInferenceContext,-) where--import Hydra.Compute-import Hydra.Core-import Hydra.CoreEncoding-import Hydra.Graph-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Annotations-import Hydra.Rewriting-import Hydra.Inference.Substitution-import Hydra.Unification-import Hydra.Inference.Rules-import Hydra.Tier1-import Hydra.Tier2-import Hydra.Tools.Sorting-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---annotateElements :: Graph -> [Element] -> Flow Graph [Element]-annotateElements g sortedEls = withInferenceContext $ do-    iels' <- annotate sortedEls ([])-    let iels = fst <$> iels'-    let constraints = snd <$> iels'--    -- Note: inference occurs over the entire graph at once,-    --       but unification and substitution occur within elements in isolation-    subst <- withSchemaContext $ CM.mapM solveConstraints constraints-    return $ L.zipWith rewriteElement subst iels-  where-    -- Note: the following defaults to user-provided type annotations where provided.-    --       In the future, we should trust unification to perform this defaulting, and not override the inferred type.-    rewriteElement subst el = el { elementData = setTermType (Just typ) term1 }-      where-        term0 = elementData el-        term1 = rewriteDataType (substituteInType subst) term0-        typ = Y.fromMaybe (termType term1) $ getTermType term0--    annotate :: [Element] -> [(Element, [TypeConstraint])] -> Flow Graph [(Element, [TypeConstraint])]-    annotate original annotated = case original of-      [] -> pure $ L.reverse annotated-      (el:r) -> do-        (Inferred iel t c1) <- inferElementType el-        withBinding (elementName el) (monotype t) $ annotate r ((iel, c1):annotated)--inferTermType :: Term -> Flow Graph Term-inferTermType term0 = do-  (term1, _) <- inferTypeAndConstraints term0-  return term1--inferElementType :: Element -> Flow Graph (Inferred Element)-inferElementType el = withTrace ("infer type of " ++ unName (elementName el)) $ do-  (Inferred iterm t c) <- infer $ elementData el-  return (Inferred (el {elementData = iterm}) t c)--inferGraphTypes :: Flow Graph Graph-inferGraphTypes = getState >>= annotateGraph-  where-    annotateGraph g = withTrace ("infer graph types") $ do-        sorted <- sortGraphElements g-        els <- sortGraphElements g >>= annotateElements g-        return g {graphElements = M.fromList (toPair <$> els)}-      where-        toPair el = (elementName el, el)---- TODO: deprecated-inferredTypeOf :: Term -> Flow Graph Type-inferredTypeOf term = typeSchemeType <$> inferTypeScheme term---- TODO: deprecated--- | Solve for the top-level type of an expression in a given environment-inferTypeAndConstraints :: Term -> Flow Graph (Term, TypeScheme)-inferTypeAndConstraints term = withTrace ("infer type") $ withInferenceContext $ do-    (Inferred iterm _ constraints) <- infer term-    subst <- withSchemaContext $ solveConstraints constraints-    let term2 = rewriteDataType (substituteInType subst) iterm---    let typ = Y.fromMaybe (termType term2) $ getTermType term---    return (setTermType (Just typ) term2, closeOver $ termType term2)-    return (term2, closeOver $ termType term2)-  where-    -- | Canonicalize and return the polymorphic top-level type.-    closeOver = normalizeScheme . generalize M.empty . reduceType---- TODO: deprecated-inferTypeScheme :: Term -> Flow Graph TypeScheme-inferTypeScheme term = snd <$> inferTypeAndConstraints term--rewriteDataType :: (Type -> Type) -> Term -> Term-rewriteDataType f = rewriteTerm ff-  where-    ff recurse term = case recurse term of-      TermTyped (TypedTerm term1 type1) -> TermTyped $ TypedTerm term1 (f type1)-      t -> t--sortGraphElements :: Graph -> Flow Graph [Element]-sortGraphElements g = do-    let annotated = S.fromList $ Y.catMaybes (ifAnnotated <$> M.elems els)-    adjList <- CM.mapM (toAdj annotated) $ M.elems els-    case topologicalSort adjList of-      Left comps -> fail $ "cyclical dependency not resolved through annotations: " ++ L.intercalate ", " (unName <$> L.head comps)-      Right names -> return $ Y.catMaybes ((\n -> M.lookup n els) <$> names)-  where-    els = graphElements g-    ifAnnotated el = case (getTermType $ elementData el) of-      Nothing -> Nothing-      Just _ -> Just $ elementName el-    toAdj annotated el = do-        let deps = L.filter isNotAnnotated $ L.filter isElName $ S.toList $ freeVariablesInTerm $ elementData el--        return (elementName el, deps)-      where-        -- Ignore free variables which are not valid element references-        isElName name = M.member name els-        -- No need for an inference dependency on an element which is already annotated with a type-        isNotAnnotated name = not $ S.member name annotated--withInferenceContext flow = do-    g <- getState-    let env = initialEnv g-    withState (g {graphTypes = env}) flow-  where-    initialEnv g = M.fromList $ Y.catMaybes (toPair <$> (M.elems $ graphElements g))-      where-        toPair el = (\t -> (elementName el, monotype t)) <$> (getTermType $ elementData el)
− src/main/haskell/Hydra/Inference/Rules.hs 
@@ -1,346 +0,0 @@--- | Inference rules--module Hydra.Inference.Rules where--import Hydra.Basics-import Hydra.Strip-import Hydra.Compute-import Hydra.Core-import Hydra.Schemas-import Hydra.CoreEncoding-import Hydra.Graph-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Rewriting-import Hydra.Inference.Substitution-import Hydra.Unification-import Hydra.Tools.Debug-import Hydra.Annotations-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---data Inferred a = Inferred {-  -- The original term, possibly annotated with the inferred type-  inferredObject :: a,-  -- The inferred type-  inferredType :: Type,-  -- Any constraints introduced by the inference process-  inferredConstraints :: [TypeConstraint]-} deriving Show--key_vcount = Name "vcount"--constraint :: Type -> Type -> TypeConstraint-constraint t1 t2 = TypeConstraint t1 t2 Nothing--fieldType :: Field -> FieldType-fieldType (Field fname term) = FieldType fname $ termType term--findMatchingField :: Name -> [FieldType] -> Flow Graph FieldType-findMatchingField fname sfields = case L.filter (\f -> fieldTypeName f == fname) sfields of-  []    -> fail $ "no such field: " ++ unName fname-  (h:_) -> return h--freshName :: Flow Graph Name-freshName = normalVariable <$> nextCount key_vcount--freshVariableType :: Flow Graph Type-freshVariableType = TypeVariable <$> freshName--generalize :: M.Map Name TypeScheme -> Type -> TypeScheme-generalize env t  = TypeScheme vars t-  where-    vars = S.toList $ S.difference-      (freeVariablesInType t)-      (L.foldr (S.union . freeVariablesInScheme) S.empty $ M.elems env)--infer :: Term -> Flow Graph (Inferred Term)-infer term = withTrace ("infer for " ++ show (termVariant term)) $ case term of-    TermAnnotated (AnnotatedTerm term1 ann) -> do-      (Inferred term2 typ constraints) <- infer term1-      return (Inferred (TermAnnotated $ AnnotatedTerm term2 ann) typ constraints)--    TermApplication (Application fun arg) -> do-      (Inferred ifun ityp funconst) <- infer fun-      (Inferred iarg atyp argconst) <- infer arg-      cod <- freshVariableType-      let constraints = funconst ++ argconst ++ [constraint ityp $ Types.function atyp cod]-      yield (TermApplication $ Application ifun iarg) cod constraints--    TermFunction f -> case f of--      FunctionElimination e -> case e of--        EliminationList fun -> do-          a <- freshVariableType-          b <- freshVariableType-          let expected = Types.functionN [b, a, b]-          (Inferred i t c) <- infer fun-          let elim = Types.functionN [b, Types.list a, b]-          yieldElimination (EliminationList i) elim (c ++ [constraint expected t])--        EliminationOptional (OptionalCases n j) -> do-          dom <- freshVariableType-          cod <- freshVariableType-          (Inferred ni nt nconst) <- infer n-          (Inferred ji jt jconst) <- infer j-          let t = Types.function (Types.optional dom) cod-          let constraints = nconst ++ jconst-                              ++ [constraint cod nt, constraint (Types.function dom cod) jt]-          yieldElimination (EliminationOptional $ OptionalCases ni ji) t constraints--        EliminationProduct (TupleProjection arity idx) -> do-          types <- CM.replicateM arity freshVariableType-          let cod = types !! idx-          let t = Types.function (Types.product types) cod-          yieldElimination (EliminationProduct $ TupleProjection arity idx) t []--        EliminationRecord (Projection name fname) -> do-          rt <- requireRecordType name-          sfield <- findMatchingField fname (rowTypeFields rt)-          yieldElimination (EliminationRecord $ Projection name fname)-            (Types.function (TypeRecord rt) $ fieldTypeType sfield) []--        EliminationUnion (CaseStatement tname def cases) -> do-            -- Default value-            (idef, dfltConstraints) <- case def of-              Nothing -> pure (Nothing, [])-              Just d -> do-                (Inferred i _ c) <- infer d-                return (Just i, c)--            -- Cases-            icases' <- CM.mapM inferFieldType cases-            let icases = inferredObject <$> icases'-            let casesconst = inferredConstraints <$> icases'-            let icasesMap = fieldMap icases-            rt <- requireUnionType tname-            let sfields = fieldTypeMap  $ rowTypeFields rt-            checkCasesAgainstSchema tname icasesMap sfields-            let pairMap = productOfMaps icasesMap sfields--            cod <- freshVariableType-            let outerConstraints = (\(d, s) -> constraint (termType d) $ Types.function s cod) <$> M.elems pairMap-            let innerConstraints = dfltConstraints ++ L.concat casesconst--            yieldElimination (EliminationUnion (CaseStatement tname idef icases))-              (Types.function (TypeUnion rt) cod)-              (innerConstraints ++ outerConstraints)-          where-            checkCasesAgainstSchema tname icases sfields = if M.null diff-                then pure ()-                else fail $ "case(s) in case statement which do not exist in type " ++ unName tname ++ ": "-                  ++ L.intercalate ", " (unName <$> M.keys diff)-              where-                diff = M.difference icases sfields--        EliminationWrap name -> do-          typ <- requireWrappedType name-          yieldElimination (EliminationWrap name) (Types.function (TypeWrap $ WrappedType name typ) typ) []--      FunctionLambda (Lambda v _ body) -> do-        tv <- freshVariableType-        (Inferred i t iconst) <- withBinding v (monotype tv) $ infer body-        yieldFunction (FunctionLambda $ Lambda v (Just tv) i) (Types.function tv t) iconst--      FunctionPrimitive name -> do-          ts <- (typeOfPrimitive name) >>= instantiate-          -- TODO: propagate the entire type scheme, not only the body-          yieldFunction (FunctionPrimitive name) (typeSchemeType ts) []--    TermLet lt -> inferLet lt--    TermList els -> do-        v <- freshVariableType-        if L.null els-          then yield (TermList []) (Types.list v) []-          else do-            iels' <- CM.mapM infer els-            let iels = inferredObject <$> iels'-            let elsconst = inferredConstraints <$> iels'-            let co = (\e -> constraint v $ termType e) <$> iels-            let ci = L.concat elsconst-            yield (TermList iels) (Types.list v) (co ++ ci)--    TermLiteral l -> yield (TermLiteral l) (Types.literal $ literalType l) []--    TermMap m -> do-        kv <- freshVariableType-        vv <- freshVariableType-        if M.null m-          then yield (TermMap M.empty) (Types.map kv vv) []-          else do-            triples <- CM.mapM toTriple $ M.toList m-            let pairs = (\(k, v, _) -> (k, v)) <$> triples-            let co = L.concat ((\(k, v, c) -> c ++ [constraint kv $ termType k, constraint vv $ termType v]) <$> triples)-            yield (TermMap $ M.fromList pairs) (Types.map kv vv) co-      where-        toTriple (k, v) = do-          (Inferred ik _ kc) <- infer k-          (Inferred iv _ vc) <- infer v-          return (ik, iv, kc ++ vc)--    TermOptional m -> do-      v <- freshVariableType-      case m of-        Nothing -> yield (TermOptional Nothing) (Types.optional v) []-        Just e -> do-          (Inferred i t ci) <- infer e-          yield (TermOptional $ Just i) (Types.optional v) ((constraint v t):ci)--    TermProduct tuple -> do-      is' <- CM.mapM infer tuple-      let is = inferredObject <$> is'-      let co = L.concat (inferredConstraints <$> is')-      yield (TermProduct is) (TypeProduct $ fmap termType is) co--    TermRecord (Record n fields) -> do-        rt <- requireRecordType n-        ifields' <- CM.mapM inferFieldType fields-        let ifields = inferredObject <$> ifields'-        let ci = L.concat (inferredConstraints <$> ifields')-        let irt = TypeRecord $ RowType n (fieldType <$> ifields)-        yield (TermRecord $ Record n ifields) irt ((constraint irt $ TypeRecord rt):ci)--    TermSet els -> do-      v <- freshVariableType-      if S.null els-        then yield (TermSet S.empty) (Types.set v) []-        else do-          iels' <- CM.mapM infer $ S.toList els-          let iels = inferredObject <$> iels'-          let co = (\e -> (constraint v $ termType e)) <$> iels-          let ci = L.concat (inferredConstraints <$> iels')-          yield (TermSet $ S.fromList iels) (Types.set v) (co ++ ci)--    TermSum (Sum i s trm) -> do-        (Inferred it t co) <- infer trm-        types <- CM.sequence (varOrTerm t <$> [0..(s-1)])-        yield (TermSum $ Sum i s it) (TypeSum types) co-      where-        varOrTerm t j = if i == j-          then pure t-          else freshVariableType--    TermTyped (TypedTerm term1 typ) -> do-      (Inferred i t c) <- infer term1-      return $ Inferred (setTermType (Just typ) i) typ $ c ++ [constraint typ t]--    TermUnion (Injection n field) -> do-        rt <- requireUnionType n-        sfield <- findMatchingField (fieldName field) (rowTypeFields rt)-        (Inferred ifield t ci) <- inferFieldType field-        let co = constraint t $ fieldTypeType sfield--        yield (TermUnion $ Injection n ifield) (TypeUnion rt) (co:ci)--    TermVariable v -> do-      ts <- requireName v-      -- TODO: propagate the entire type scheme, not only the body-      yield (TermVariable v) (typeSchemeType ts) []--    TermWrap (WrappedTerm name term1) -> do-      typ <- requireWrappedType name-      (Inferred i t ci) <- infer term1-      yield (TermWrap $ WrappedTerm name i) (TypeWrap $ WrappedType name typ) (ci ++ [constraint typ t])--inferFieldType :: Field -> Flow Graph (Inferred Field)-inferFieldType (Field fname term) = do-  (Inferred i t c) <- infer term-  return (Inferred (Field fname i) t c)--inferLet :: Let -> Flow Graph (Inferred Term)-inferLet (Let bindings env) = withTrace ("let(" ++ L.intercalate "," (unName . letBindingName <$> bindings) ++ ")") $ do-    state0 <- getState-    let e = preExtendEnv bindings $ graphTypes state0-    let state1 = state0 {graphTypes = e}-    withState state1 $ do-      -- TODO: perform a topological sort on the bindings; this process should be unified with that of elements in a graph--      -- Infer types of bindings in the pre-extended environment-      ivalues' <- CM.mapM infer (letBindingTerm <$> bindings)-      let ivalues = inferredObject <$> ivalues'-      let ibindings = L.zipWith (\(LetBinding k v t) i -> LetBinding k i t) bindings ivalues-      let bc = L.concat (inferredConstraints <$> ivalues')--      let tbindings = M.fromList $ fmap (\(LetBinding k i t) -> (k, termTypeScheme i)) ibindings-      (Inferred ienv t cenv) <- withBindings tbindings $ infer env--      yield (TermLet $ Let ibindings ienv) t (bc ++ cenv)-  where-    -- Add any manual type annotations for the bindings to the environment, enabling type inference over recursive definitions-    preExtendEnv bindings e = foldl addPair e bindings-      where-        addPair e (LetBinding name term _) = case typeOfTerm term of-          Nothing -> e-          Just typ -> M.insert name (monotype typ) e--instantiate :: TypeScheme -> Flow Graph TypeScheme-instantiate (TypeScheme vars t) = do-    vars1 <- mapM (const freshName) vars-    return $ TypeScheme vars1 $ substituteInType (M.fromList $ L.zip vars (TypeVariable <$> vars1)) t--monotype :: Type -> TypeScheme-monotype typ = TypeScheme [] typ--productOfMaps :: Ord k => M.Map k l -> M.Map k r -> M.Map k (l, r)-productOfMaps ml mr = M.fromList $ Y.catMaybes (toPair <$> M.toList mr)-  where-    toPair (k, vr) = (\vl -> (k, (vl, vr))) <$> M.lookup k ml--reduceType :: Type -> Type-reduceType t = t -- betaReduceType cx t--requireName :: Name -> Flow Graph TypeScheme-requireName v = do-  env <- graphTypes <$> getState-  case M.lookup v env of-    Nothing -> fail $ "variable not bound in environment: " ++ unName v ++ ". Environment: "-      ++ L.intercalate ", " (unName <$> M.keys env)-    Just s -> instantiate s--termType :: Term -> Type-termType term = case stripTerm term of-  (TermTyped (TypedTerm _ typ)) -> typ---- TODO: limited and temporary-termTypeScheme :: Term -> TypeScheme-termTypeScheme = monotype . termType--typeOfPrimitive :: Name -> Flow Graph TypeScheme-typeOfPrimitive name = primitiveType <$> requirePrimitive name--typeOfTerm :: Term -> Maybe Type-typeOfTerm term = case term of-  TermAnnotated (AnnotatedTerm term1 _) -> typeOfTerm term1-  TermTyped (TypedTerm term1 typ) -> Just typ-  _ -> Nothing--withBinding :: Name -> TypeScheme -> Flow Graph x -> Flow Graph x-withBinding n ts = withEnvironment (M.insert n ts)--withBindings :: M.Map Name TypeScheme -> Flow Graph x -> Flow Graph x-withBindings bindings = withEnvironment (\e -> M.union bindings e)--withEnvironment :: (M.Map Name TypeScheme -> M.Map Name TypeScheme) -> Flow Graph x -> Flow Graph x-withEnvironment m flow = do-  g <- getState-  withState (g {graphTypes = m (graphTypes g)}) flow--yield :: Term -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term)-yield term typ constraints = do-  return (Inferred (TermTyped $ TypedTerm term typ) typ constraints)--yieldFunction :: Function -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term)-yieldFunction fun = yield (TermFunction fun)--yieldElimination :: Elimination -> Type -> [TypeConstraint] -> Flow Graph (Inferred Term)-yieldElimination e = yield (TermFunction $ FunctionElimination e)
− src/main/haskell/Hydra/Inference/Substitution.hs 
@@ -1,80 +0,0 @@--- | Variable substitution and normalization of type expressions-module Hydra.Inference.Substitution where--import Hydra.Core-import Hydra.Mantle-import Hydra.Rewriting-import Hydra.Tier1-import Hydra.Dsl.Types as Types--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---type Subst = M.Map Name (Type)--composeSubst :: Subst -> Subst -> Subst-composeSubst s1 s2 = M.union s1 $ M.map (substituteInType s1) s2--normalVariables :: [Name]-normalVariables = normalVariable <$> [0..]---- | Type variable naming convention follows Haskell: t0, t1, etc.-normalVariable :: Int -> Name-normalVariable i = Name $ "t" ++ show i--normalizeScheme :: TypeScheme -> TypeScheme-normalizeScheme ts@(TypeScheme _ body) = TypeScheme (fmap snd ord) (normalizeType body)-  where-    ord = L.zip (S.toList $ freeVariablesInType body) normalVariables--    normalizeFieldType (FieldType fname typ) = FieldType fname $ normalizeType typ--    normalizeType typ = case typ of-      TypeApplication (ApplicationType lhs rhs) -> TypeApplication (ApplicationType (normalizeType lhs) (normalizeType rhs))-      TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated (AnnotatedType (normalizeType t) ann)-      TypeFunction (FunctionType dom cod) -> function (normalizeType dom) (normalizeType cod)-      TypeList t -> list $ normalizeType t-      TypeLiteral _ -> typ-      TypeMap (MapType kt vt) -> Types.map (normalizeType kt) (normalizeType vt)-      TypeOptional t -> optional $ normalizeType t-      TypeProduct types -> TypeProduct (normalizeType <$> types)-      TypeRecord (RowType n fields) -> TypeRecord $ RowType n (normalizeFieldType <$> fields)-      TypeSet t -> set $ normalizeType t-      TypeSum types -> TypeSum (normalizeType <$> types)-      TypeUnion (RowType n fields) -> TypeUnion $ RowType n (normalizeFieldType <$> fields)-      TypeLambda (LambdaType (Name v) t) -> TypeLambda (LambdaType (Name v) $ normalizeType t)-      TypeVariable v -> case Prelude.lookup v ord of-        Just (Name v1) -> var v1-        Nothing -> error $ "type variable " ++ show v ++ " not in signature of type scheme: " ++ show ts-      TypeWrap _ -> typ--substituteInScheme :: M.Map Name (Type) -> TypeScheme -> TypeScheme-substituteInScheme s (TypeScheme as t) = TypeScheme as $ substituteInType s' t-  where-    s' = L.foldr M.delete s as--substituteInType :: M.Map Name (Type) -> Type -> Type-substituteInType s typ = case typ of-    TypeApplication (ApplicationType lhs rhs) -> TypeApplication (ApplicationType (subst lhs) (subst rhs))-    TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated (AnnotatedType (subst t) ann)-    TypeFunction (FunctionType dom cod) -> function (subst dom) (subst cod)-    TypeList t -> list $ subst t-    TypeLiteral _ -> typ-    TypeMap (MapType kt vt) -> Types.map (subst kt) (subst vt)-    TypeOptional t -> optional $ subst t-    TypeProduct types -> TypeProduct (subst <$> types)-    TypeRecord (RowType n fields) -> TypeRecord $ RowType n (substField <$> fields)-    TypeSet t -> set $ subst t-    TypeSum types -> TypeSum (subst <$> types)-    TypeUnion (RowType n fields) -> TypeUnion $ RowType n (substField <$> fields)-    TypeLambda (LambdaType var@(Name v) body) -> if Y.isNothing (M.lookup var s)-      then TypeLambda (LambdaType (Name v) (subst body))-      else typ-    TypeVariable a -> M.findWithDefault typ a s-    TypeWrap _ -> typ -- because we do not allow names to be bound to types with free variables-  where-    subst = substituteInType s-    substField (FieldType fname t) = FieldType fname $ subst t
src/main/haskell/Hydra/Kernel.hs view
@@ -1,80 +1,94 @@ -- | A proxy for the Hydra kernel, i.e. the code which must be present in every Hydra implementation, and can be imported as a unit.+{-+Note: the following modules are part of the kernel, but they are not default imports because of name collisions:+- Hydra.Ast+- Hydra.Decode.Core+- Hydra.Describe.Core+- Hydra.Encode.Core+- Hydra.Extract.Core+- Hydra.Grammar+- Hydra.Grammars+- Hydra.Topology+-} --- Note: Hydra.Grammar is part of the kernel, but is not a default import because the names of its types clash with those of other types. module Hydra.Kernel (-  module Hydra.AdapterUtils,-  module Hydra.Adapters,-  module Hydra.Basics,+  module Hydra.Accessors,+  module Hydra.Adapt.Literals,+  module Hydra.Adapt.Modules,+  module Hydra.Adapt.Simple,+  module Hydra.Adapt.Terms,+  module Hydra.Adapt.Utils,+  module Hydra.Annotations,+  module Hydra.Arity,   module Hydra.Coders,   module Hydra.Compute,   module Hydra.Constants,   module Hydra.Constraints,   module Hydra.Core,-  module Hydra.CoreDecoding,-  module Hydra.CoreEncoding,-  module Hydra.CoreLanguage,-  module Hydra.Extras,+  module Hydra.Languages,+  module Hydra.Monads,+  module Hydra.Formatting,   module Hydra.Graph,-  module Hydra.Inference.Inference,-  module Hydra.Annotations,+  module Hydra.Inference,   module Hydra.Lexical,-  module Hydra.LiteralAdapters,+  module Hydra.Literals,   module Hydra.Mantle,-  module Hydra.Messages,   module Hydra.Module,   module Hydra.Phantoms,-  module Hydra.Printing,+  module Hydra.Names,   module Hydra.Query,   module Hydra.Reduction,+  module Hydra.Relational,   module Hydra.Rewriting,   module Hydra.Schemas,-  module Hydra.Strip,-  module Hydra.TermAdapters,-  module Hydra.Tier1,-  module Hydra.Tier2,-  module Hydra.Tier3,-  module Hydra.Tools.Debug,-  module Hydra.Tools.Formatting,-  module Hydra.Tools.Sorting,+  module Hydra.Serialization,+  module Hydra.Settings,+  module Hydra.Sorting,+  module Hydra.Substitution,+  module Hydra.Tabular,+  module Hydra.Templates,+  module Hydra.Typing,+  module Hydra.Unification,+  module Hydra.Variants,   module Hydra.Workflow,---  module Hydra.Ast,---  module Hydra.Tools.GrammarToModule, ) where -import Hydra.AdapterUtils-import Hydra.Adapters-import Hydra.Basics+import Hydra.Accessors+import Hydra.Adapt.Literals+import Hydra.Adapt.Modules+import Hydra.Adapt.Simple+import Hydra.Adapt.Terms hiding (optionalToList)+import Hydra.Adapt.Utils+import Hydra.Annotations+import Hydra.Arity import Hydra.Coders import Hydra.Compute import Hydra.Constants import Hydra.Constraints import Hydra.Core-import Hydra.CoreDecoding-import Hydra.CoreEncoding-import Hydra.CoreLanguage-import Hydra.Extras+import Hydra.Languages+import Hydra.Monads hiding (bind, exec, fail, pure)+import Hydra.Formatting import Hydra.Graph-import Hydra.Inference.Inference-import Hydra.Annotations+import Hydra.Inference import Hydra.Lexical-import Hydra.LiteralAdapters-import Hydra.Mantle-import Hydra.Messages+import Hydra.Literals+import Hydra.Mantle hiding (Either) import Hydra.Module import Hydra.Phantoms-import Hydra.Printing+import Hydra.Names import Hydra.Query import Hydra.Reduction+import Hydra.Relational import Hydra.Rewriting import Hydra.Schemas-import Hydra.Strip-import Hydra.TermAdapters-import Hydra.Tier1-import Hydra.Tier2-import Hydra.Tier3-import Hydra.Tools.Debug-import Hydra.Tools.Formatting-import Hydra.Tools.Sorting+import Hydra.Serialization+import Hydra.Settings+import Hydra.Sorting+import Hydra.Substitution+import Hydra.Tabular+import Hydra.Templates+import Hydra.Typing+import Hydra.Unification+import Hydra.Variants import Hydra.Workflow---import Hydra.Ast---import Hydra.Tools.GrammarToModule
− src/main/haskell/Hydra/Lexical.hs 
@@ -1,82 +0,0 @@--- | Functions for retrieving elements and primitive functions from a graph context--module Hydra.Lexical where--import Hydra.Basics-import Hydra.Strip-import Hydra.Core-import Hydra.Extras-import Hydra.Graph-import Hydra.Compute-import Hydra.Tier1-import Hydra.Tier2-import Hydra.Module--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y-import Control.Monad---dereferenceElement :: Name -> Flow Graph (Maybe Element)-dereferenceElement name = do-  g <- getState-  return $ M.lookup name (graphElements g)--fieldsOf :: Type -> [FieldType]-fieldsOf t = case stripType t of-  TypeLambda (LambdaType _ body) -> fieldsOf body-  TypeRecord rt -> rowTypeFields rt-  TypeUnion rt -> rowTypeFields rt-  _ -> []--requireElement :: Name -> Flow Graph Element-requireElement name = do-    mel <- dereferenceElement name-    case mel of-      Just el -> return el-      Nothing -> getState >>= err-  where-    err g = fail $ "no such element: " ++ unName name-        ++ ". Available elements: {" ++ L.intercalate ", " (ellipsis (unName . elementName <$> M.elems (graphElements g))) ++ "}"-      where-        showAll = False-        ellipsis = id---        ellipsis strings = if L.length strings > 3 && not showAll---          then L.take 3 strings ++ ["..."]---          else strings--requirePrimitive :: Name -> Flow Graph Primitive-requirePrimitive fn = do-    cx <- getState-    Y.maybe err pure $ lookupPrimitive cx fn-  where-    err = fail $ "no such primitive function: " ++ unName fn---- TODO: distinguish between lambda-bound and let-bound variables-resolveTerm :: Name -> Flow Graph (Maybe Term)-resolveTerm name = do-    g <- getState-    Y.maybe (pure Nothing) recurse $ M.lookup name $ graphElements g-  where-    recurse el = case stripTerm (elementData el) of-      TermVariable name' -> resolveTerm name'-      _ -> pure $ Just $ elementData el---- Note: assuming for now that primitive functions are the same in the schema graph-schemaContext :: Graph -> Graph-schemaContext g = Y.fromMaybe g (graphSchema g)--toCompactName :: M.Map Namespace String -> Name -> String-toCompactName namespaces name = case mns of-    Nothing -> unName name-    Just ns -> case M.lookup ns namespaces of-      Just pre -> pre ++ ":" ++ local-      Nothing -> local-  where-    (QualifiedName mns local) = qualifyNameLazy name--withSchemaContext :: Flow Graph x -> Flow Graph x-withSchemaContext f = do-  cx <- getState-  withState (schemaContext cx) f
+ src/main/haskell/Hydra/Lib/Chars.hs view
@@ -0,0 +1,24 @@+-- | Haskell implementations of hydra.lib.chars primitives++module Hydra.Lib.Chars where++import qualified Data.Char as C+++isAlphaNum :: Int -> Bool+isAlphaNum = C.isAlphaNum . C.chr++isLower :: Int -> Bool+isLower = C.isLower . C.chr++isSpace :: Int -> Bool+isSpace = C.isSpace . C.chr++isUpper :: Int -> Bool+isUpper = C.isUpper . C.chr++toLower :: Int -> Int+toLower = C.ord . C.toLower . C.chr++toUpper :: Int -> Int+toUpper = C.ord . C.toUpper . C.chr
src/main/haskell/Hydra/Lib/Equality.hs view
@@ -1,77 +1,38 @@--- | Haskell implementations of hydra/lib/equality primitives. These simply make use of derived Eq.+-- | Haskell implementations of hydra.lib.equality primitives. These simply make use of derived Eq.  module Hydra.Lib.Equality where -import Hydra.Core+import Hydra.Mantle  import Data.Int  +compare :: Ord a => a -> a -> Comparison+compare x y+  | x < y     = ComparisonLessThan+  | x > y     = ComparisonGreaterThan+  | otherwise = ComparisonEqualTo+ equal :: Eq a => a -> a -> Bool equal = (==) -equalBinary :: String -> String -> Bool-equalBinary = (==)--equalBoolean :: Bool -> Bool -> Bool-equalBoolean = (==)--equalBigfloat :: Double -> Double -> Bool-equalBigfloat = (==)--equalFloat32 :: Float -> Float -> Bool-equalFloat32 = (==)--equalFloat64 :: Double -> Double -> Bool-equalFloat64 = (==)--equalBigint :: Integer -> Integer -> Bool-equalBigint = (==)--equalInt8 :: Int8 -> Int8 -> Bool-equalInt8 = (==)--equalInt16 :: Int16 -> Int16 -> Bool-equalInt16 = (==)--equalInt32 :: Int -> Int -> Bool-equalInt32 = (==)--equalInt64 :: Int64 -> Int64 -> Bool-equalInt64 = (==)--equalUint8 :: Int16 -> Int16 -> Bool-equalUint8 = (==)--equalUint16 :: Int -> Int -> Bool-equalUint16 = (==)--equalUint32 :: Int64 -> Int64 -> Bool-equalUint32 = (==)--equalUint64 :: Integer -> Integer -> Bool-equalUint64 = (==)--equalString :: String -> String -> Bool-equalString = (==)--equalTerm :: Term -> Term -> Bool-equalTerm = (==)+gt :: Ord a => a -> a -> Bool+gt = (>) -equalType :: Type -> Type -> Bool-equalType = (==)+gte :: Ord a => a -> a -> Bool+gte = (>=) -gtInt32 :: Int -> Int -> Bool-gtInt32 = (>)+identity :: a -> a+identity = id -gteInt32 :: Int -> Int -> Bool-gteInt32 = (>=)+lt :: Ord a => a -> a -> Bool+lt = (<) -identity :: x -> x-identity = id+lte :: Ord a => a -> a -> Bool+lte = (<=) -ltInt32 :: Int -> Int -> Bool-ltInt32 = (<)+max :: Ord a => a -> a -> a+max = Prelude.max -lteInt32 :: Int -> Int -> Bool-lteInt32 = (<=)+min :: Ord a => a -> a -> a+min = Prelude.min
src/main/haskell/Hydra/Lib/Flows.hs view
@@ -1,11 +1,13 @@--- | Haskell implementations of hydra/lib/flows primitives+-- | Haskell implementations of hydra.lib.flows primitives. These are simply wrappers around hydra.flows functions.  module Hydra.Lib.Flows where  import Hydra.Compute-import qualified Hydra.Tier1 as Tier1+import qualified Hydra.Monads as Monads  import qualified Control.Monad as CM+import qualified Data.Map as M+import qualified Data.Set as S   -- Haskell-specific helpers@@ -13,20 +15,12 @@ instance Functor (Flow s) where   fmap = CM.liftM instance Applicative (Flow s) where-  pure = return+  pure = Monads.pure   (<*>) = CM.ap instance Monad (Flow s) where-  return x = Flow $ \s t -> FlowState (Just x) s t-  p >>= k = Flow q'-    where-      q' s0 t0 = FlowState y s2 t2-        where-          FlowState x s1 t1 = unFlow p s0 t0-          FlowState y s2 t2 = case x of-            Just x' -> unFlow (k x') s1 t1-            Nothing -> FlowState Nothing s1 t1+  (>>=) = Monads.bind instance MonadFail (Flow s) where-  fail msg = Flow $ \s t -> FlowState Nothing s (Tier1.pushError msg t)+  fail = Monads.fail  -- Primitive functions @@ -34,19 +28,31 @@ apply = (<*>)  bind :: Flow s x -> (x -> Flow s y) -> Flow s y-bind = (>>=)+bind = Monads.bind  fail :: String -> Flow s x-fail = CM.fail+fail = Monads.fail  map :: (x -> y) -> Flow s x -> Flow s y-map = fmap+map = Monads.map +mapElems :: Ord k => (v1 -> Flow s v2) -> M.Map k v1 -> Flow s (M.Map k v2)+mapElems f m = M.fromList <$> (CM.mapM (\(k, v) -> (,) <$> Monads.pure k <*> f v) $ M.toList m)++mapKeys :: Ord k2 => (k1 -> Flow s k2) -> M.Map k1 v -> Flow s (M.Map k2 v)+mapKeys f m = M.fromList <$> (CM.mapM (\(k, v) -> (,) <$> f k <*> Monads.pure v) $ M.toList m)+ mapList :: (x -> Flow s y) -> [x] -> Flow s [y] mapList = CM.mapM +mapOptional :: (x -> Flow s y) -> Maybe x -> Flow s (Maybe y)+mapOptional = traverse++mapSet :: Ord y => (x -> Flow s y) -> S.Set x -> Flow s (S.Set y)+mapSet f xs = S.fromList <$> (CM.mapM f $ S.toList xs)+ pure :: x -> Flow s x-pure = return+pure = Monads.pure  sequence :: [Flow s x] -> Flow s [x] sequence = CM.sequence
− src/main/haskell/Hydra/Lib/Io.hs 
@@ -1,80 +0,0 @@--- | Tier-1 library which provides Haskell implementations of hydra/lib/io primitives.--module Hydra.Lib.Io (-  showTerm,-  showType,-) where--import Hydra.Core-import Hydra.Compute-import Hydra.Graph-import Hydra.Ext.Json.Coder-import Hydra.Dsl.Annotations-import Hydra.Ext.Json.Serde-import Hydra.CoreEncoding-import Hydra.Rewriting-import Hydra.Annotations-import Hydra.Tier1-import qualified Hydra.Json as Json-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Data.Map as M-import qualified Data.Maybe as Y---noGraph :: Graph-noGraph = Graph {-  graphElements = M.empty,-  graphEnvironment = M.empty,-  graphTypes = M.empty,-  graphBody = Terms.list [],-  graphPrimitives = M.empty,-  graphSchema = Nothing}---showTerm :: Term -> String-showTerm term = fromFlow "fail" noGraph (jsonValueToString <$> untypedTermToJson term)----     coder <- termStringCoder---     coderEncode coder encoded---   where---     --encoded = coreEncodeTerm $ rewriteTermMeta (const $ Kv M.empty) term---     encoded = rewriteTermMeta (const $ Kv M.empty) term--termStringCoder :: Flow Graph (Coder Graph Graph Term String)-termStringCoder = do-    termJsonCoder <- jsonCoder $ TypeVariable _Term-    return $ Coder (mout termJsonCoder) (min termJsonCoder)-  where-    mout termJsonCoder term = jsonValueToString <$> coderEncode termJsonCoder term-    min termJsonCoder s = case stringToJsonValue s of-      Left msg -> fail $ "failed to parse JSON value: " ++ msg-      Right v -> coderDecode termJsonCoder v----showType :: Type -> String---showType typ = fromFlow "fail" noGraph $ do---    coder <- typeStringCoder---    coderEncode coder encoded---  where---    encoded = coreEncodeType $ rewriteTypeMeta (const $ Kv M.empty) typ---- TODO: for now, we are bypassing the complexity of TermAdapters because of issues yet to be resolved-showType :: Type -> String-showType = showTerm . coreEncodeType---showType typ = case flowStateValue result of---    Nothing -> "failed to encode type:\n" ++ show (traceMessages $ flowStateTrace result)---    Just s -> s---  where---    result = unFlow (jsonValueToString <$> untypedTermToJson encoded) noGraph emptyTrace---    encoded = stripTermRecursive $ coreEncodeType typ--typeStringCoder :: Flow Graph (Coder Graph Graph Term String)-typeStringCoder = do-    typeJsonCoder <- jsonCoder $ TypeVariable _Type-    return $ Coder (mout typeJsonCoder) (min typeJsonCoder)-  where-    mout typeJsonCoder term = jsonValueToString <$> coderEncode typeJsonCoder term-    min typeJsonCoder s = case stringToJsonValue s of-      Left msg -> fail $ "failed to parse as JSON value: " ++ msg-      Right v -> coderDecode typeJsonCoder v
src/main/haskell/Hydra/Lib/Lists.hs view
@@ -1,4 +1,4 @@--- | Haskell implementations of hydra/lib/lists primitives+-- | Haskell implementations of hydra.lib.lists primitives  module Hydra.Lib.Lists where @@ -28,15 +28,30 @@ cons :: a -> [a] -> [a] cons = (:) +drop :: Int -> [a] -> [a]+drop = L.drop++dropWhile :: (a -> Bool) -> [a] -> [a]+dropWhile = L.dropWhile++elem :: Eq a => a -> [a] -> Bool+elem = L.elem+ filter :: (a -> Bool) -> [a] -> [a] filter = L.filter  foldl :: (b -> a -> b) -> b -> [a] -> b foldl = L.foldl +group :: Eq a => [a] -> [[a]]+group = L.group+ head :: [a] -> a head = L.head +init :: [a] -> [a]+init = L.init+ intercalate :: [a] -> [[a]] -> [a] intercalate = L.intercalate @@ -61,6 +76,9 @@ pure :: a -> [a] pure e = [e] +replicate :: Int -> a -> [a]+replicate = L.replicate+ reverse :: [a] -> [a] reverse = L.reverse @@ -68,5 +86,29 @@ safeHead [] = Nothing safeHead (x:_) = Just x +singleton :: a -> [a]+singleton e = [e]++sort :: Ord a => [a] -> [a]+sort = L.sort++sortOn :: Ord b => (a -> b) -> [a] -> [a]+sortOn = L.sortOn++span :: (a -> Bool) -> [a] -> ([a], [a])+span = L.span+ tail :: [a] -> [a] tail = L.tail++take :: Int -> [a] -> [a]+take = L.take++transpose :: [[a]] -> [[a]]+transpose = L.transpose++zip :: [a] -> [b] -> [(a, b)]+zip = L.zip++zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]+zipWith = L.zipWith
src/main/haskell/Hydra/Lib/Literals.hs view
@@ -1,8 +1,9 @@--- | Haskell implementations of hydra/lib/literals primitives+-- | Haskell implementations of hydra.lib.literals primitives  module Hydra.Lib.Literals where  import Data.Int+import Text.Read (readMaybe)   bigfloatToBigint :: Double -> Integer@@ -41,6 +42,9 @@ bigintToUint64 :: Integer -> Integer bigintToUint64 = id +binaryToString :: String -> String+binaryToString s = s+ float32ToBigfloat :: Float -> Double float32ToBigfloat = realToFrac @@ -59,11 +63,75 @@ int64ToBigint :: Int64 -> Integer int64ToBigint = fromIntegral +readBigfloat :: String -> Maybe Double+readBigfloat s = readMaybe s :: Maybe Double++readBoolean :: String -> Maybe Bool+readBoolean s = if s == "true" then Just True+  else if s == "false" then Just False+  else Nothing++readFloat32 :: String -> Maybe Float+readFloat32 s = readMaybe s :: Maybe Float++readFloat64 :: String -> Maybe Double+readFloat64 s = readMaybe s :: Maybe Double++readInt32 :: String -> Maybe Int+readInt32 s = readMaybe s :: Maybe Int++readInt64 :: String -> Maybe Int64+readInt64 s = readMaybe s :: Maybe Int64++readString :: String -> Maybe String+readString s = readMaybe s :: Maybe String++showBigfloat :: Double -> String+showBigfloat = show++showBigint :: Integer -> String+showBigint = show++showBoolean :: Bool -> String+showBoolean b = case b of+  True -> "true"+  False -> "false"++showFloat32 :: Float -> String+showFloat32 = show++showFloat64 :: Double -> String+showFloat64 = show++showInt8 :: Int8 -> String+showInt8 = show++showInt16 :: Int16 -> String+showInt16 = show+ showInt32 :: Int -> String showInt32 = show +showInt64 :: Int64 -> String+showInt64 = show++showUint8 :: Int16 -> String+showUint8 = show++showUint16 :: Int -> String+showUint16 = show++showUint32 :: Int64 -> String+showUint32 = show++showUint64 :: Integer -> String+showUint64 = show+ showString :: String -> String showString = show++stringToBinary :: String -> String+stringToBinary s = s  uint8ToBigint :: Int16 -> Integer uint8ToBigint = fromIntegral
src/main/haskell/Hydra/Lib/Logic.hs view
@@ -1,4 +1,4 @@--- | Haskell implementations of hydra/lib/logic (logic and control flow) primitives+-- | Haskell implementations of hydra.lib.logic (logic and control flow) primitives  module Hydra.Lib.Logic where @@ -10,8 +10,8 @@ and :: Bool -> Bool -> Bool and x y = x && y -ifElse :: a -> a -> Bool -> a-ifElse x y b = if b then x else y+ifElse :: Bool -> a -> a -> a+ifElse b x y = if b then x else y  not :: Bool -> Bool not = Prelude.not
src/main/haskell/Hydra/Lib/Maps.hs view
@@ -1,22 +1,37 @@--- | Haskell implementations of hydra/lib/maps primitives+-- | Haskell implementations of hydra.lib.maps primitives  module Hydra.Lib.Maps where  import qualified Data.Map as M  +alter :: Ord k => (Maybe v -> Maybe v) -> k -> M.Map k v -> M.Map k v+alter = M.alter++bimap :: (Ord k1, Ord k2) => (k1 -> k2) -> (v1 -> v2) -> M.Map k1 v1 -> M.Map k2 v2+bimap f g = M.fromList . fmap (\(k, v) -> (f k, g v)) . M.toList++elems :: M.Map k v -> [v]+elems = M.elems+ empty :: M.Map k v empty = M.empty +filter :: Ord k => (v -> Bool) -> M.Map k v -> M.Map k v+filter = M.filter++filterWithKey :: Ord k => (k -> v -> Bool) -> M.Map k v -> M.Map k v+filterWithKey = M.filterWithKey++findWithDefault :: Ord k => v -> k -> M.Map k v -> v+findWithDefault = M.findWithDefault+ fromList :: Ord k => [(k, v)] -> M.Map k v fromList = M.fromList  insert :: Ord k => k -> v -> M.Map k v -> M.Map k v insert = M.insert -isEmpty :: M.Map k v -> Bool-isEmpty = M.null- keys :: M.Map k v -> [k] keys = M.keys @@ -29,6 +44,12 @@ mapKeys :: (Ord k1, Ord k2) => (k1 -> k2) -> M.Map k1 v -> M.Map k2 v mapKeys = M.mapKeys +member :: Ord k => k -> M.Map k v -> Bool+member = M.member++null :: M.Map k v -> Bool+null = M.null+ remove :: Ord k => k -> M.Map k v -> M.Map k v remove = M.delete @@ -41,5 +62,5 @@ toList :: M.Map k v -> [(k, v)] toList = M.toList -values :: M.Map k v -> [v]-values = M.elems+union :: Ord k => M.Map k v -> M.Map k v -> M.Map k v+union = M.union
src/main/haskell/Hydra/Lib/Math.hs view
@@ -1,25 +1,28 @@--- | Haskell implementations of hydra/lib/math primitives+-- | Haskell implementations of hydra.lib.math primitives  module Hydra.Lib.Math where  -neg :: Int -> Int+neg :: Num a => a -> a neg = negate -add :: Int -> Int -> Int+add :: Num a => a -> a -> a add x y = x + y -sub :: Int -> Int -> Int-sub x y = x - y--mul :: Int -> Int -> Int-mul x y = x * y--div :: Int -> Int -> Int+div :: Integral a => a -> a -> a div = Prelude.div -mod :: Int -> Int -> Int+mod :: Integral a => a -> a -> a mod = Prelude.mod -rem :: Int -> Int -> Int+mul :: Num a => a -> a -> a+mul x y = x * y++range :: Enum a => a -> a -> [a]+range start end = [start .. end]++rem :: Integral a => a -> a -> a rem = Prelude.rem++sub :: Num a => a -> a -> a+sub x y = x - y
src/main/haskell/Hydra/Lib/Optionals.hs view
@@ -1,4 +1,4 @@--- | Haskell implementations of hydra/lib/optionals primitives+-- | Haskell implementations of hydra.lib.optionals primitives  module Hydra.Lib.Optionals where @@ -11,12 +11,18 @@ bind :: Y.Maybe a -> (a -> Y.Maybe b) -> Y.Maybe b bind = (>>=) +cases :: Y.Maybe a -> b -> (a -> b) -> b+cases m n j = Y.maybe n j m+ cat :: [Y.Maybe a] -> [a] cat = Y.catMaybes  compose :: (a -> Y.Maybe b) -> (b -> Y.Maybe c) -> (a -> Y.Maybe c) compose f g = \x -> f x >>= g +fromJust :: Y.Maybe a -> a+fromJust = Y.fromJust+ fromMaybe :: a -> Y.Maybe a -> a fromMaybe = Y.fromMaybe @@ -28,6 +34,9 @@  map :: (a -> b) -> Y.Maybe a -> Y.Maybe b map = fmap++mapMaybe :: (a -> Y.Maybe b) -> [a] -> [b]+mapMaybe = Y.mapMaybe  maybe :: b -> (a -> b) -> Y.Maybe a -> b maybe = Y.maybe
src/main/haskell/Hydra/Lib/Sets.hs view
@@ -1,12 +1,12 @@--- | Haskell implementations of hydra/lib/sets primitives+-- | Haskell implementations of hydra.lib.sets primitives  module Hydra.Lib.Sets where  import qualified Data.Set as S  -contains :: Ord x => x -> S.Set x -> Bool-contains = S.member+delete :: Ord x => x -> S.Set x -> S.Set x+delete = S.delete  difference :: Ord x => S.Set x -> S.Set x -> S.Set x difference = S.difference@@ -23,16 +23,16 @@ intersection :: Ord x => S.Set x -> S.Set x -> S.Set x intersection = S.intersection -isEmpty :: S.Set x -> Bool-isEmpty = S.null- -- Note: the presence of a 'map' function does not imply that sets are a functor in Hydra map :: Ord y => (x -> y) -> S.Set x -> S.Set y map f = S.fromList . fmap f . S.toList -remove :: Ord x => x -> S.Set x -> S.Set x -remove = S.delete+member :: Ord x => x -> S.Set x -> Bool+member = S.member +null :: S.Set x -> Bool+null = S.null+ singleton :: x -> S.Set x singleton = S.singleton @@ -44,3 +44,6 @@  union :: Ord x => S.Set x -> S.Set x -> S.Set x union = S.union++unions :: Ord x => [S.Set x] -> S.Set x+unions = S.unions
src/main/haskell/Hydra/Lib/Strings.hs view
@@ -1,4 +1,4 @@--- | Haskell implementations of hydra/lib/strings primitives+-- | Haskell implementations of hydra.lib.strings primitives  module Hydra.Lib.Strings where @@ -13,18 +13,24 @@ cat2 :: String -> String -> String cat2 s1 s2 = s1 ++ s2 +charAt :: Int -> String -> Int+charAt i s = C.ord (s !! i)+ fromList :: [Int] -> String fromList = fmap C.chr  intercalate :: String -> [String] -> String intercalate = L.intercalate -isEmpty :: String -> Bool-isEmpty = L.null- length :: String -> Int length = L.length +lines :: String -> [String]+lines = L.lines++null :: String -> Bool+null = L.null+ splitOn :: String -> String -> [String] splitOn = LS.splitOn @@ -36,3 +42,6 @@  toUpper :: String -> String toUpper = fmap C.toUpper++unlines :: [String] -> String+unlines = L.unlines
− src/main/haskell/Hydra/LiteralAdapters.hs 
@@ -1,189 +0,0 @@--- | Adapter framework for literal types and terms--module Hydra.LiteralAdapters (-  literalAdapter,-  floatAdapter,-  integerAdapter,-) where--import Hydra.Printing-import Hydra.AdapterUtils-import Hydra.Basics-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.Graph-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Tier1-import Hydra.Tier2--import qualified Data.List as L-import qualified Data.Set as S---literalAdapter :: LiteralType -> Flow (AdapterContext) (SymmetricAdapter s LiteralType Literal)-literalAdapter lt = do-    cx <- getState-    chooseAdapter (alts cx) (supported cx) describeLiteralType lt-  where-    supported cx = literalTypeIsSupported (constraints cx)-    constraints cx = languageConstraints $ adapterContextLanguage cx--    alts cx t = case t of-        LiteralTypeBinary -> pure $ fallbackAdapter t-        LiteralTypeBoolean -> pure $ if noIntegerVars-            then fallbackAdapter t-            else do-              adapter <- integerAdapter IntegerTypeUint8-              let step' = adapterCoder adapter-              let step = Coder encode decode-                    where-                      encode (LiteralBoolean bv) = LiteralInteger <$> coderEncode step' (toInt bv)-                        where-                          toInt bv = IntegerValueUint8 $ if bv then 1 else 0-                      decode (LiteralInteger iv) = LiteralBoolean <$> do-                        (IntegerValueUint8 v) <- coderDecode step' iv-                        return $ v == 1-              return $ Adapter False t (LiteralTypeInteger $ adapterTarget adapter) step-        LiteralTypeFloat ft -> pure $ if noFloatVars-          then fallbackAdapter t-          else do-            adapter <- floatAdapter ft-            let step = bidirectional-                  $ \dir l -> case l of-                    LiteralFloat fv -> LiteralFloat <$> encodeDecode dir (adapterCoder adapter) fv-                    _ -> unexpected "floating-point literal" (show l)-            return $ Adapter (adapterIsLossy adapter) t (LiteralTypeFloat $ adapterTarget adapter) step-        LiteralTypeInteger it -> pure $ if noIntegerVars-          then fallbackAdapter t-          else do-            adapter <- integerAdapter it-            let step = bidirectional-                  $ \dir (LiteralInteger iv) -> LiteralInteger-                    <$> encodeDecode dir (adapterCoder adapter) iv-            return $ Adapter (adapterIsLossy adapter) t (LiteralTypeInteger $ adapterTarget adapter) step-        LiteralTypeString -> pure $ fail "no substitute for the literal string type"-      where-        noFloatVars = not (S.member LiteralVariantFloat $ languageConstraintsLiteralVariants $ constraints cx)-          || S.null (languageConstraintsFloatTypes $ constraints cx)-        noIntegerVars = not (S.member LiteralVariantInteger $ languageConstraintsLiteralVariants $ constraints cx)-          || S.null (languageConstraintsIntegerTypes $ constraints cx)-        noStrings = not $ supported cx LiteralTypeString--        fallbackAdapter t = if noStrings-            then fail "cannot serialize unsupported type; strings are unsupported"-            else warn msg $ pure $ Adapter False t LiteralTypeString step-          where-            msg = disclaimer False (describeLiteralType t) (describeLiteralType LiteralTypeString)-            step = Coder encode decode-              where-                -- TODO: this format is tied to Haskell-                encode av = pure $ LiteralString $ case av of-                  LiteralBinary s -> s-                  LiteralBoolean b -> if b then "true" else "false"-                  _ -> show av-                decode (LiteralString s) = pure $ case t of-                  LiteralTypeBinary -> LiteralBinary s-                  LiteralTypeBoolean -> LiteralBoolean $ s == "true"-                  _ -> read s--comparePrecision :: Precision -> Precision -> Ordering-comparePrecision p1 p2 = if p1 == p2 then EQ else case (p1, p2) of-  (PrecisionArbitrary, _) -> GT-  (_, PrecisionArbitrary) -> LT-  (PrecisionBits b1, PrecisionBits b2) -> compare b1 b2--disclaimer :: Bool -> String -> String -> String-disclaimer lossy source target = "replace " ++ source ++ " with " ++ target-  ++ if lossy then " (lossy)" else ""--floatAdapter :: FloatType -> Flow (AdapterContext) (SymmetricAdapter s FloatType FloatValue)-floatAdapter ft = do-    cx <- getState-    let supported = floatTypeIsSupported $ languageConstraints $ adapterContextLanguage cx-    chooseAdapter alts supported describeFloatType ft-  where-    alts t = makeAdapter t <$> case t of-        FloatTypeBigfloat -> [FloatTypeFloat64, FloatTypeFloat32]-        FloatTypeFloat32 -> [FloatTypeFloat64, FloatTypeBigfloat]-        FloatTypeFloat64 -> [FloatTypeBigfloat, FloatTypeFloat32]-      where-        makeAdapter source target = warn msg $ pure $ Adapter lossy source target step-          where-            lossy = comparePrecision (floatTypePrecision source) (floatTypePrecision target) == GT-            step = Coder (pure . convertFloatValue target) (pure . convertFloatValue source)-            msg = disclaimer lossy (describeFloatType source) (describeFloatType target)--integerAdapter :: IntegerType -> Flow (AdapterContext) (SymmetricAdapter s IntegerType IntegerValue)-integerAdapter it = do-    cx <- getState-    let supported = integerTypeIsSupported $ languageConstraints $ adapterContextLanguage cx-    chooseAdapter alts supported describeIntegerType it-  where-    alts t = makeAdapter t <$> case t of-        IntegerTypeBigint -> L.reverse unsignedPref-        IntegerTypeInt8 -> signed 1-        IntegerTypeInt16 -> signed 2-        IntegerTypeInt32 -> signed 3-        IntegerTypeInt64 -> signed 4-        IntegerTypeUint8 -> unsigned 1-        IntegerTypeUint16 -> unsigned 2-        IntegerTypeUint32 -> unsigned 3-        IntegerTypeUint64 -> unsigned 4-      where-        signed i = L.drop (i*2) signedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) signedNonPref-        unsigned i = L.drop (i*2) unsignedPref ++ [IntegerTypeBigint] ++ L.drop (8-(i*2)+1) unsignedNonPref-        signedPref = interleave signedOrdered unsignedOrdered-        unsignedPref = interleave unsignedOrdered signedOrdered-        signedNonPref = L.reverse unsignedPref-        unsignedNonPref = L.reverse signedPref--        interleave xs ys = L.concat (L.transpose [xs, ys])--        signedOrdered = L.filter-          (\v -> integerTypeIsSigned v && integerTypePrecision v /= PrecisionArbitrary) integerTypes-        unsignedOrdered = L.filter-          (\v -> not (integerTypeIsSigned v) && integerTypePrecision v /= PrecisionArbitrary) integerTypes--        makeAdapter source target = warn msg $ pure $ Adapter lossy source target step-          where-            lossy = comparePrecision (integerTypePrecision source) (integerTypePrecision target) /= LT-            step = Coder (pure . convertIntegerValue target) (pure . convertIntegerValue source)-            msg = disclaimer lossy (describeIntegerType source) (describeIntegerType target)--convertFloatValue :: FloatType -> FloatValue -> FloatValue-convertFloatValue target = encoder . decoder-  where-    decoder fv = case fv of-      FloatValueBigfloat d -> d-      FloatValueFloat32 f -> realToFrac f-      FloatValueFloat64 d -> d-    encoder d = case target of-      FloatTypeBigfloat -> FloatValueBigfloat d-      FloatTypeFloat32 -> FloatValueFloat32 $ realToFrac d-      FloatTypeFloat64 -> FloatValueFloat64 d--convertIntegerValue :: IntegerType -> IntegerValue -> IntegerValue-convertIntegerValue target = encoder . decoder-  where-    decoder iv = case iv of-      IntegerValueBigint v -> v-      IntegerValueInt8 v -> fromIntegral v-      IntegerValueInt16 v -> fromIntegral v-      IntegerValueInt32 v -> fromIntegral v-      IntegerValueInt64 v -> fromIntegral v-      IntegerValueUint8 v -> fromIntegral v-      IntegerValueUint16 v -> fromIntegral v-      IntegerValueUint32 v -> fromIntegral v-      IntegerValueUint64 v -> fromIntegral v-    encoder d = case target of-      IntegerTypeBigint -> IntegerValueBigint d-      IntegerTypeInt8 -> IntegerValueInt8 $ fromIntegral d-      IntegerTypeInt16 -> IntegerValueInt16 $ fromIntegral d-      IntegerTypeInt32 -> IntegerValueInt32 $ fromIntegral d-      IntegerTypeInt64 -> IntegerValueInt64 $ fromIntegral d-      IntegerTypeUint8 -> IntegerValueUint8 $ fromIntegral d-      IntegerTypeUint16 -> IntegerValueUint16 $ fromIntegral d-      IntegerTypeUint32 -> IntegerValueUint32 $ fromIntegral d-      IntegerTypeUint64 -> IntegerValueUint64 $ fromIntegral d
src/main/haskell/Hydra/Minimal.hs view
@@ -20,5 +20,5 @@ ) where  import Hydra.Core-import Hydra.Basics+import Hydra.Variants import Hydra.Dsl.Literals
− src/main/haskell/Hydra/Reduction.hs 
@@ -1,214 +0,0 @@--- | Functions for reducing terms and types, i.e. performing computations--module Hydra.Reduction where--import Hydra.Basics-import Hydra.Strip-import Hydra.Compute-import Hydra.Core-import Hydra.Schemas-import Hydra.Extras-import Hydra.Graph-import Hydra.Annotations-import Hydra.Lexical-import Hydra.Rewriting-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---alphaConvert :: Name -> Term -> Term -> Term-alphaConvert vold tnew = rewriteTerm rewrite-  where-    rewrite recurse term = case term of-      TermFunction (FunctionLambda (Lambda v _ _)) -> if v == vold-        then term-        else recurse term-      TermVariable v -> if v == vold then tnew else TermVariable v-      _ -> recurse term---- For demo purposes. This should be generalized to enable additional side effects of interest.-countPrimitiveInvocations :: Bool-countPrimitiveInvocations = True---- A term evaluation function which is alternatively lazy or eager-reduceTerm :: Bool -> M.Map Name Term -> Term -> Flow Graph Term-reduceTerm eager env = rewriteTermM mapping-  where-    reduce eager = reduceTerm eager M.empty--    mapping recurse mid = do-      inner <- if doRecurse eager mid then recurse mid else pure mid-      applyIfNullary eager inner []--    doRecurse eager term = eager && case term of-      TermFunction (FunctionLambda _) -> False-      _ -> True--    -- Reduce an argument only if evaluation is lazy (i.e. the argument may not already have been reduced)-    reduceArg eager arg = if eager then pure arg else reduce False arg--    applyToArguments fun args = case args of-      [] -> fun-      (h:r) -> applyToArguments (Terms.apply fun h) r--    replaceFreeName toReplace replacement = rewriteTerm mapping-      where-        mapping recurse inner = case inner of-          TermFunction (FunctionLambda (Lambda param _ _)) -> if param == toReplace then inner else recurse inner-          TermVariable name -> if name == toReplace then replacement else inner-          _ -> recurse inner--    applyIfNullary eager original args = case stripTerm original of-      TermApplication (Application fun arg) -> applyIfNullary eager fun (arg:args)-      TermFunction fun -> case fun of-        FunctionElimination elm -> case args of-          [] -> pure original-          -- Reduce the argument prior to application, regardless of laziness-          (arg:remainingArgs) -> do-            reducedArg <- reduceArg eager $ stripTerm arg-            reducedResult <- applyElimination elm reducedArg >>= reduce eager-            applyIfNullary eager reducedResult remainingArgs-        FunctionLambda (Lambda param _ body) -> case args of-          [] -> pure original-          (arg:remainingArgs) -> do-            reducedArg <- reduce eager $ stripTerm arg-            reducedResult <- reduce eager $ replaceFreeName param reducedArg body-            applyIfNullary eager reducedResult remainingArgs-        FunctionPrimitive name -> do-          prim <- requirePrimitive name-          let arity = primitiveArity prim-          if arity > L.length args-            -- Not enough arguments available; back out-            then return $ applyToArguments original args-            else do-              let argList = L.take arity args-              let remainingArgs = L.drop arity args-              reducedArgs <- CM.mapM (reduceArg eager) argList-              reducedResult <- primitiveImplementation prim reducedArgs >>= reduce eager-              applyIfNullary eager reducedResult remainingArgs-      TermVariable _ -> pure $ applyToArguments original args -- TODO: dereference variables-      _ -> pure $ applyToArguments original args--    applyElimination elm reducedArg = case elm of-      EliminationList _ -> fail "list eliminations are unsupported"-      EliminationOptional _ -> fail "optional eliminations are unsupported"-      EliminationRecord proj -> do-        fields <- Expect.recordWithName (projectionTypeName proj) $ stripTerm reducedArg-        let matchingFields = L.filter (\f -> fieldName f == projectionField proj) fields-        if L.null matchingFields-          then fail $ "no such field: " ++ unName (projectionField proj) ++ " in " ++ unName (projectionTypeName proj) ++ " record"-          else pure $ fieldTerm $ L.head matchingFields-      EliminationUnion (CaseStatement name def fields) -> do-        field <- Expect.injectionWithName name reducedArg-        let matchingFields = L.filter (\f -> fieldName f == fieldName field) fields-        if L.null matchingFields-          then case def of-            Just d -> pure d-            Nothing -> fail $ "no such field " ++ unName (fieldName field) ++ " in " ++ unName name ++ " case statement"-          else pure $ Terms.apply (fieldTerm $ L.head matchingFields) (fieldTerm field)-      EliminationWrap name -> Expect.wrap name reducedArg---- Note: this is eager beta reduction, in that we always descend into subtypes,---       and always reduce the right-hand side of an application prior to substitution-betaReduceType :: Type -> Flow Graph (Type)-betaReduceType typ = do-    g <- getState :: Flow Graph Graph-    rewriteTypeM mapExpr typ-  where-    mapExpr recurse t = do-        r <- recurse t-        case r of-          TypeApplication a -> reduceApp a-          t' -> pure t'-      where-        reduceApp (ApplicationType lhs rhs) = case lhs of-          TypeAnnotated (AnnotatedType t' ann) -> do-            a <- reduceApp $ ApplicationType t' rhs-            return $ TypeAnnotated $ AnnotatedType a ann-          TypeLambda (LambdaType v body) -> betaReduceType $ replaceFreeName v rhs body-          -- nominal types are transparent-          TypeVariable name -> do-            t' <- requireType name-            betaReduceType $ TypeApplication $ ApplicationType t' rhs---- | Apply the special rules:---     ((\x.e1) e2) == e1, where x does not appear free in e1---   and---     ((\x.e1) e2) = e1[x/e2]---  These are both limited forms of beta reduction which help to "clean up" a term without fully evaluating it.-contractTerm :: Term -> Term-contractTerm = rewriteTerm rewrite-  where-    rewrite recurse term = case rec of-        TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of-          TermFunction (FunctionLambda (Lambda v _ body)) -> if isFreeIn v body-            then body-            else alphaConvert v rhs body-          _ -> rec-        _ -> rec-      where-        rec = recurse term---- Note: unused / untested-etaReduceTerm :: Term -> Term-etaReduceTerm term = case term of-    TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated (AnnotatedTerm (etaReduceTerm term1) ann)-    TermFunction (FunctionLambda l) -> reduceLambda l-    _ -> noChange-  where-    reduceLambda (Lambda v d body) = case etaReduceTerm body of-      TermAnnotated (AnnotatedTerm body1 ann) -> reduceLambda (Lambda v d body1)-      TermApplication a -> reduceApplication a-        where-          reduceApplication (Application lhs rhs) = case etaReduceTerm rhs of-            TermAnnotated (AnnotatedTerm rhs1 ann) -> reduceApplication (Application lhs rhs1)-            TermVariable v1 -> if v == v1 && isFreeIn v lhs-              then etaReduceTerm lhs-              else noChange-            _ -> noChange-      _ -> noChange-    noChange = term---- | Whether a term is closed, i.e. represents a complete program-termIsClosed :: Term -> Bool-termIsClosed = S.null . freeVariablesInTerm---- | Whether a term has been fully reduced to a "value"-termIsValue :: Graph -> Term -> Bool-termIsValue g term = case stripTerm term of-    TermApplication _ -> False-    TermLiteral _ -> True-    TermFunction f -> functionIsValue f-    TermList els -> forList els-    TermMap map -> L.foldl-      (\b (k, v) -> b && termIsValue g k && termIsValue g v)-      True $ M.toList map-    TermOptional m -> case m of-      Nothing -> True-      Just term -> termIsValue g term-    TermRecord (Record _ fields) -> checkFields fields-    TermSet els -> forList $ S.toList els-    TermUnion (Injection _ field) -> checkField field-    TermVariable _ -> False-  where-    forList els = L.foldl (\b t -> b && termIsValue g t) True els-    checkField = termIsValue g . fieldTerm-    checkFields = L.foldl (\b f -> b && checkField f) True--    functionIsValue f = case f of-      FunctionElimination e -> case e of-        EliminationWrap _ -> True-        EliminationOptional (OptionalCases nothing just) -> termIsValue g nothing-          && termIsValue g just-        EliminationRecord _ -> True-        EliminationUnion (CaseStatement _ def cases) -> checkFields cases && (Y.maybe True (termIsValue g) def)-      FunctionLambda (Lambda _ _ body) -> termIsValue g body-      FunctionPrimitive _ -> True
− src/main/haskell/Hydra/Rewriting.hs 
@@ -1,425 +0,0 @@--- | Functions for type and term rewriting--module Hydra.Rewriting where--import Hydra.Basics-import Hydra.Strip-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.CoreEncoding-import Hydra.Extras-import Hydra.Graph-import Hydra.Module-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Tools.Sorting-import Hydra.Tier1-import Hydra.Tier2-import Hydra.Tools.Debug--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y----- beneathTermAnnotations :: (Term -> Term) -> Term -> Term--- beneathTermAnnotations f term = case term of---   TermAnnotated (AnnotatedTerm term1 ann) ->---     TermAnnotated (AnnotatedTerm (beneathTermAnnotations f term1) ann)---   TermTyped (TypedTerm term1 typ) ->---     TermTyped $ TypedTerm (beneathTermAnnotations f term1) typ---   _ -> f term------ beneathTermAnnotationsM :: (Term -> Flow s Term) -> Term -> Flow s Term--- beneathTermAnnotationsM f term = case term of---   TermAnnotated (AnnotatedTerm term1 ann) ->---     TermAnnotated <$> (AnnotatedTerm <$> beneathTermAnnotationsM f term1 <*> pure ann)---   TermTyped (TypedTerm term1 typ) ->---     TermTyped <$> (TypedTerm <$> beneathTermAnnotationsM f term1 <*> pure typ)---   _ -> f term---- | Apply a transformation to the first type beneath a chain of annotations-beneathTypeAnnotations :: (Type -> Type) -> Type -> Type-beneathTypeAnnotations f t = case t of-  TypeAnnotated (AnnotatedType t1 ann) -> TypeAnnotated (AnnotatedType (beneathTypeAnnotations f t1) ann)-  _ -> f t--elementsWithDependencies :: [Element] -> Flow Graph [Element]-elementsWithDependencies original = CM.mapM requireElement allDepNames-  where-    depNames = S.toList . termDependencyNames True False False . elementData-    allDepNames = L.nub $ (elementName <$> original) ++ (L.concat $ depNames <$> original)---- | Recursively transform arbitrary terms like 'add 42' into terms like '\x.add 42 x',---   whose arity (in the absence of application terms) is equal to the depth of nested lambdas.---   This is useful for targets like Java with weaker support for currying.-expandTypedLambdas :: Term -> Term-expandTypedLambdas = rewriteTerm rewrite-  where-    rewrite recurse term = case getFunType term of-        Nothing -> recurse term-        Just (doms, cod) -> expand doms cod term-      where-        toNaryFunType typ = case stripType typ of-          TypeFunction (FunctionType dom0 cod0) -> (dom0 : doms, cod1)-            where-              (doms, cod1) = toNaryFunType cod0-          d -> ([], d)-        getFunType term = toNaryFunType <$> getTermType term--        expand doms cod term = case term of-          TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm (expand doms cod term1) ann-          TermApplication (Application lhs rhs) -> case getTermType rhs of-            Nothing -> recurse term-            Just typ -> TermApplication $ Application (expand (typ:doms) cod lhs) $ expandTypedLambdas rhs-          TermFunction f -> case f of-            FunctionLambda (Lambda var d body) -> TermFunction $ FunctionLambda $ Lambda var d $-              expand (L.tail doms) cod body-            _ -> pad 1 doms cod term-          TermLet (Let bindings env) -> TermLet $ Let (expandBinding <$> bindings) $ expand doms cod env-            where-              expandBinding (LetBinding name term1 typ) = LetBinding name (expandTypedLambdas term1) typ-          TermTyped (TypedTerm term1 typ) -> TermTyped $ TypedTerm (expand doms cod term1) typ-          _ -> recurse term--        pad i doms cod term = if L.null doms-            then term-            else TermFunction $ FunctionLambda $ Lambda var (Just dom) $-              pad (i+1) (L.tail doms) cod $-              -- TODO: omit this type annotation if practical; a type annotation on application terms-              --       shouldn't really be necessary.-              typed (toFunctionType (L.tail doms) cod) $-              TermApplication $ Application (typed (toFunctionType doms cod) term) $ TermVariable var-          where-            dom = L.head doms-            typed typ term = TermTyped $ TypedTerm term typ-            toFunctionType doms cod = L.foldl (\c d -> TypeFunction $ FunctionType d c) cod doms-            var = Name $ "v" ++ show i--flattenLetTerms :: Term -> Term-flattenLetTerms = rewriteTerm flatten-  where-    flatten recurse term = case recurse term of-      TermLet (Let bindings body) -> TermLet $ Let newBindings body-        where-          newBindings = L.concat (forResult . rewriteBinding <$> bindings)-            where-              forResult (h, rest) = (h:rest)-          rewriteBinding (LetBinding k0 v0 t) = case v0 of-            TermAnnotated (AnnotatedTerm v1 ann) -> ((LetBinding k0 (TermAnnotated $ AnnotatedTerm v2 ann) t), deps)-              where-                ((LetBinding _ v2 _), deps) = rewriteBinding (LetBinding k0 v1 t)-            TermLet (Let bindings1 body1) -> ((LetBinding k0 newBody t), newBinding <$> bindings1)-              where-                newBody = replaceVars body1-                newBinding (LetBinding kn vn t) = LetBinding (qualify kn) (replaceVars vn) t-                qualify n = Name $ prefix ++ unName n-                replaceVars = substituteVariables subst-                subst = M.fromList (toSubstPair <$> bindings1)-                  where-                    toSubstPair (LetBinding n _ _) = (n, qualify n)-                prefix = unName k0 ++ "_"-            v1 -> ((LetBinding k0 v1 t), [])-      term0 -> term0--freeVariablesInScheme :: TypeScheme -> S.Set Name-freeVariablesInScheme (TypeScheme vars t) = S.difference (freeVariablesInType t) (S.fromList vars)---- | Inline all type variables in a type using the provided schema.---   Note: this function is only appropriate for nonrecursive type definitions.-inlineType :: M.Map Name Type -> Type -> Flow s Type-inlineType schema = rewriteTypeM f-  where-    f recurse typ = do-      tr <- recurse typ-      case tr of-        TypeVariable v -> case M.lookup v schema of-          Just t -> inlineType schema t-          Nothing -> fail $ "No such type in schema: " ++ unName v-        t -> return t--isFreeIn :: Name -> Term -> Bool-isFreeIn v term = not $ S.member v $ freeVariablesInTerm term---- | Recursively remove term annotations, including within subterms-removeTermAnnotations :: Term -> Term-removeTermAnnotations = rewriteTerm remove-  where-    remove recurse term = case recurse term of-      TermAnnotated (AnnotatedTerm term1 _) -> term1-      TermTyped (TypedTerm term1 _) -> term1-      t -> t---- | Recursively remove type annotations, including within subtypes-removeTypeAnnotations :: Type -> Type-removeTypeAnnotations = rewriteType remove-  where-    remove recurse typ = case recurse typ of-      TypeAnnotated (AnnotatedType typ' _) -> typ'-      t -> t--replaceFreeName :: Name -> Type -> Type -> Type-replaceFreeName v rep = rewriteType mapExpr-  where-    mapExpr recurse t = case t of-      TypeLambda (LambdaType v' body) -> if v == v'-        then t-        else TypeLambda $ LambdaType v' $ recurse body-      TypeVariable v' -> if v == v' then rep else t-      _ -> recurse t--rewrite :: ((x -> y) -> x -> y) -> ((x -> y) -> x -> y) -> x -> y-rewrite fsub f = recurse-  where-    recurse = f (fsub recurse)--rewriteTerm :: ((Term -> Term) -> Term -> Term) -> Term -> Term-rewriteTerm f = rewrite fsub f-  where-    fsub recurse term = case term of-        TermAnnotated (AnnotatedTerm ex ann) -> TermAnnotated $ AnnotatedTerm (recurse ex) ann-        TermApplication (Application lhs rhs) -> TermApplication $ Application (recurse lhs) (recurse rhs)-        TermFunction fun -> TermFunction $ case fun of-          FunctionElimination e -> FunctionElimination $ case e of-            EliminationList fld -> EliminationList $ recurse fld-            EliminationOptional (OptionalCases nothing just) -> EliminationOptional-              (OptionalCases (recurse nothing) (recurse just))-            EliminationProduct tp -> EliminationProduct tp-            EliminationRecord p -> EliminationRecord p-            EliminationUnion (CaseStatement n def cases) -> EliminationUnion $ CaseStatement n (recurse <$> def) (forField <$> cases)-            EliminationWrap name -> EliminationWrap name-          FunctionLambda (Lambda v d body) -> FunctionLambda $ Lambda v d $ recurse body-          FunctionPrimitive name -> FunctionPrimitive name-        TermLet (Let bindings env) -> TermLet $ Let (mapBinding <$> bindings) (recurse env)-          where-            mapBinding (LetBinding k v t) = LetBinding k (recurse v) t-        TermList els -> TermList $ recurse <$> els-        TermLiteral v -> TermLiteral v-        TermMap m -> TermMap $ M.fromList $ (\(k, v) -> (recurse k, recurse v)) <$> M.toList m-        TermWrap (WrappedTerm name t) -> TermWrap (WrappedTerm name $ recurse t)-        TermOptional m -> TermOptional $ recurse <$> m-        TermProduct tuple -> TermProduct (recurse <$> tuple)-        TermRecord (Record n fields) -> TermRecord $ Record n $ forField <$> fields-        TermSet s -> TermSet $ S.fromList $ recurse <$> S.toList s-        TermSum (Sum i s trm) -> TermSum $ Sum i s $ recurse trm-        TermTypeAbstraction (TypeAbstraction v t) -> TermTypeAbstraction $ TypeAbstraction v $ recurse t-        TermTypeApplication (TypedTerm term1 type2) -> TermTypeApplication $ TypedTerm (recurse term1) type2-        TermTyped (TypedTerm term1 type2) -> TermTyped $ TypedTerm (recurse term1) type2-        TermUnion (Injection n field) -> TermUnion $ Injection n $ forField field-        TermVariable v -> TermVariable v-      where-        forField f = f {fieldTerm = recurse (fieldTerm f)}--rewriteTermM ::-  ((Term -> Flow s Term) -> Term -> (Flow s Term)) -> Term -> Flow s Term-rewriteTermM f = rewrite fsub f-  where-    fsub recurse term = case term of-        TermAnnotated (AnnotatedTerm ex ma) -> TermAnnotated <$> (AnnotatedTerm <$> recurse ex <*> pure ma)-        TermApplication (Application lhs rhs) -> TermApplication <$> (Application <$> recurse lhs <*> recurse rhs)-        TermFunction fun -> TermFunction <$> case fun of-          FunctionElimination e -> FunctionElimination <$> case e of-            EliminationList fld -> EliminationList <$> recurse fld-            EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$>-              (OptionalCases <$> recurse nothing <*> recurse just)-            EliminationProduct tp -> pure $ EliminationProduct tp-            EliminationRecord p -> pure $ EliminationRecord p-            EliminationUnion (CaseStatement n def cases) -> do-              rdef <- case def of-                Nothing -> pure Nothing-                Just t -> Just <$> recurse t-              EliminationUnion <$> (CaseStatement n rdef <$> (CM.mapM forField cases))-            EliminationWrap name -> pure $ EliminationWrap name-          FunctionLambda (Lambda v d body) -> FunctionLambda <$> (Lambda v d <$> recurse body)-          FunctionPrimitive name -> pure $ FunctionPrimitive name-        TermLet (Let bindings env) -> TermLet <$> (Let <$> (CM.mapM mapBinding bindings) <*> recurse env)-          where-            mapBinding (LetBinding k v t) = do-              v' <- recurse v-              return $ LetBinding k v' t-        TermList els -> TermList <$> (CM.mapM recurse els)-        TermLiteral v -> pure $ TermLiteral v-        TermMap m -> TermMap <$> (M.fromList <$> CM.mapM forPair (M.toList m))-          where-            forPair (k, v) = do-              km <- recurse k-              vm <- recurse v-              return (km, vm)-        TermOptional m -> TermOptional <$> (CM.mapM recurse m)-        TermProduct tuple -> TermProduct <$> (CM.mapM recurse tuple)-        TermRecord (Record n fields) -> TermRecord <$> (Record n <$> (CM.mapM forField fields))-        TermSet s -> TermSet <$> (S.fromList <$> (CM.mapM recurse $ S.toList s))-        TermSum (Sum i s trm) -> TermSum <$> (Sum i s <$> recurse trm)-        TermTyped (TypedTerm term1 type2) -> TermTyped <$> (TypedTerm <$> recurse term1 <*> pure type2)-        TermUnion (Injection n field) -> TermUnion <$> (Injection n <$> forField field)-        TermVariable v -> pure $ TermVariable v-        TermWrap (WrappedTerm name t) -> TermWrap <$> (WrappedTerm name <$> recurse t)-      where-        forField f = do-          t <- recurse (fieldTerm f)-          return f {fieldTerm = t}--rewriteTermMeta :: (M.Map Name Term -> M.Map Name Term) -> Term -> Term-rewriteTermMeta mapping = rewriteTerm rewrite-  where-    rewrite recurse term = case recurse term of-      TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated $ AnnotatedTerm term1 $ mapping ann-      t -> t--rewriteTermMetaM :: (M.Map Name Term -> Flow s (M.Map Name Term)) -> Term -> Flow s Term-rewriteTermMetaM mapping = rewriteTermM rewrite-  where-    rewrite recurse term = do-      r <- recurse term-      case r of-        TermAnnotated (AnnotatedTerm term1 ann) -> TermAnnotated <$> (AnnotatedTerm <$> pure term1 <*> mapping ann)-        t -> pure t--rewriteType :: ((Type -> Type) -> Type -> Type) -> Type -> Type-rewriteType f = rewrite fsub f-  where-    fsub recurse typ = case typ of-        TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated $ AnnotatedType (recurse t) ann-        TypeApplication (ApplicationType lhs rhs) -> TypeApplication $ ApplicationType (recurse lhs) (recurse rhs)-        TypeFunction (FunctionType dom cod) -> TypeFunction (FunctionType (recurse dom) (recurse cod))-        TypeLambda (LambdaType v b) -> TypeLambda (LambdaType v $ recurse b)-        TypeList t -> TypeList $ recurse t-        TypeLiteral lt -> TypeLiteral lt-        TypeMap (MapType kt vt) -> TypeMap (MapType (recurse kt) (recurse vt))-        TypeOptional t -> TypeOptional $ recurse t-        TypeProduct types -> TypeProduct (recurse <$> types)-        TypeRecord (RowType name fields) -> TypeRecord $ RowType name (forField <$> fields)-        TypeSet t -> TypeSet $ recurse t-        TypeSum types -> TypeSum (recurse <$> types)-        TypeUnion (RowType name fields) -> TypeUnion $ RowType name (forField <$> fields)-        TypeVariable v -> TypeVariable v-        TypeWrap (WrappedType name t) -> TypeWrap $ WrappedType name $ recurse t-      where-        forField f = f {fieldTypeType = recurse (fieldTypeType f)}--rewriteTypeM ::-  ((Type -> Flow s Type) -> Type -> (Flow s Type)) ->-  Type ->-  Flow s Type-rewriteTypeM f = rewrite fsub f-  where-    fsub recurse typ = case typ of-        TypeAnnotated (AnnotatedType t ann) -> TypeAnnotated <$> (AnnotatedType <$> recurse t <*> pure ann)-        TypeApplication (ApplicationType lhs rhs) -> TypeApplication <$> (ApplicationType <$> recurse lhs <*> recurse rhs)-        TypeFunction (FunctionType dom cod) -> TypeFunction <$> (FunctionType <$> recurse dom <*> recurse cod)-        TypeLambda (LambdaType v b) -> TypeLambda <$> (LambdaType <$> pure v <*> recurse b)-        TypeList t -> TypeList <$> recurse t-        TypeLiteral lt -> pure $ TypeLiteral lt-        TypeMap (MapType kt vt) -> TypeMap <$> (MapType <$> recurse kt <*> recurse vt)-        TypeOptional t -> TypeOptional <$> recurse t-        TypeProduct types -> TypeProduct <$> CM.mapM recurse types-        TypeRecord (RowType name fields) ->-          TypeRecord <$> (RowType <$> pure name <*> CM.mapM forField fields)-        TypeSet t -> TypeSet <$> recurse t-        TypeSum types -> TypeSum <$> CM.mapM recurse types-        TypeUnion (RowType name fields) ->-          TypeUnion <$> (RowType <$> pure name <*> CM.mapM forField fields)-        TypeVariable v -> pure $ TypeVariable v-        TypeWrap (WrappedType name t) -> TypeWrap <$> (WrappedType <$> pure name <*> recurse t)-      where-        forField f = do-          t <- recurse $ fieldTypeType f-          return f {fieldTypeType = t}--rewriteTypeMeta :: (M.Map Name Term -> M.Map Name Term) -> Type -> Type-rewriteTypeMeta mapping = rewriteType rewrite-  where-    rewrite recurse typ = case recurse typ of-      TypeAnnotated (AnnotatedType typ1 ann) -> TypeAnnotated $ AnnotatedType typ1 $ mapping ann-      t -> t--simplifyTerm :: Term -> Term-simplifyTerm = rewriteTerm simplify-  where-    simplify recurse term = recurse $ case fullyStripTerm term of-      TermApplication (Application lhs rhs) -> case fullyStripTerm lhs of-        TermFunction (FunctionLambda (Lambda var d body)) ->-          if S.member var (freeVariablesInTerm body)-            then case fullyStripTerm rhs of-              TermVariable v -> simplifyTerm $ substituteVariable var v body-              _ -> term-            else simplifyTerm body-        _ -> term-      _ -> term--stripTermRecursive :: Term -> Term-stripTermRecursive = rewriteTerm strip-  where-    strip recurse term = case recurse term of-      TermAnnotated (AnnotatedTerm t _) -> t-      TermTyped (TypedTerm t _) -> t-      t -> t--substituteVariable :: Name -> Name -> Term -> Term-substituteVariable from to = rewriteTerm replace-  where-    replace recurse term = case term of-      TermVariable x -> (TermVariable $ if x == from then to else x)-      TermFunction (FunctionLambda (Lambda var _ _)) -> if var == from-        then term-        else recurse term-      _ -> recurse term--substituteVariables :: M.Map Name Name -> Term -> Term-substituteVariables subst = rewriteTerm replace-  where-    replace recurse term = case term of-      TermVariable n -> TermVariable $ Y.fromMaybe n $ M.lookup n subst-      TermFunction (FunctionLambda (Lambda v _ _ )) -> case M.lookup v subst of-        Nothing -> recurse term-        Just _ -> term-      _ -> recurse term---- Note: does not distinguish between bound and free variables; use freeVariablesInTerm for that-termDependencyNames :: Bool -> Bool -> Bool -> Term -> S.Set Name-termDependencyNames withVars withPrims withNoms = foldOverTerm TraversalOrderPre addNames S.empty-  where-    addNames names term = case term of-        TermFunction f -> case f of-          FunctionPrimitive name -> prim name-          FunctionElimination e -> case e of-            EliminationRecord (Projection name _) -> nominal name-            EliminationUnion (CaseStatement name _ _) -> nominal name-            EliminationWrap name -> nominal name-            _ -> names-          _ -> names-        TermRecord (Record name _) -> nominal name-        TermUnion (Injection name _) -> nominal name-        TermVariable name -> var name-        TermWrap (WrappedTerm name _) -> nominal name-        _ -> names-      where-        nominal name = if withNoms then S.insert name names else names-        prim name = if withPrims then S.insert name names else names-        var name = if withVars then S.insert name names else names---- Topological sort of connected components, in terms of dependencies between varable/term binding pairs-topologicalSortBindings :: M.Map Name Term -> [[(Name, Term)]]-topologicalSortBindings bindingMap = fmap (fmap toPair) (topologicalSortComponents (depsOf <$> bindings))-  where-    bindings = M.toList bindingMap-    keys = S.fromList (fst <$> bindings)-    depsOf (name, term) = (name, if hasTypeAnnotation term-      then []-      else S.toList (S.intersection keys $ freeVariablesInTerm term))-    toPair name = (name, Y.fromMaybe (TermLiteral $ LiteralString "Impossible!") $ M.lookup name bindingMap)-    hasTypeAnnotation term = case term of-      TermAnnotated (AnnotatedTerm term1 _) -> hasTypeAnnotation term1-      TermTyped _ -> True-      _ -> False--topologicalSortElements :: [Element] -> Either [[Name]] [Name]-topologicalSortElements els = topologicalSort $ adjlist <$> els-  where-    adjlist e = (elementName e, S.toList $ termDependencyNames False True True $ elementData e)--typeDependencyNames :: Type -> S.Set Name-typeDependencyNames = freeVariablesInType
− src/main/haskell/Hydra/Schemas.hs 
@@ -1,158 +0,0 @@--- | Various functions for dereferencing and decoding schema types--module Hydra.Schemas (-  elementAsTypedTerm,-  fieldTypes,-  isSerializable,-  moduleDependencyNamespaces,-  requireRecordType,-  requireType,-  requireUnionType,-  requireWrappedType,-  resolveType,-  typeDependencies,-  typeDependencyNames,-  ) where--import Hydra.Basics-import Hydra.Strip-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.CoreDecoding-import Hydra.Graph-import Hydra.Mantle-import Hydra.Module-import Hydra.Lexical-import Hydra.Rewriting-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Terms as Terms--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---dereferenceType :: Name -> Flow Graph (Maybe Type)-dereferenceType name = do-  mel <- dereferenceElement name-  case mel of-    Nothing -> return Nothing-    Just el -> Just <$> coreDecodeType (elementData el)--elementAsTypedTerm :: Element -> Flow Graph TypedTerm-elementAsTypedTerm el = do-  typ <- requireTermType $ elementData el-  return $ TypedTerm (elementData el) typ--fieldTypes :: Type -> Flow Graph (M.Map Name Type)-fieldTypes t = case stripType t of-    TypeLambda (LambdaType _ body) -> fieldTypes body-    TypeRecord rt -> pure $ toMap $ rowTypeFields rt-    TypeUnion rt -> pure $ toMap $ rowTypeFields rt-    TypeVariable name -> do-      withTrace ("field types of " ++ unName name) $ do-        el <- requireElement name-        coreDecodeType (elementData el) >>= fieldTypes-    _ -> unexpected "record or union type" $ show t-  where-    toMap fields = M.fromList (toPair <$> fields)-    toPair (FieldType fname ftype) = (fname, ftype)--isSerializable :: Element -> Flow Graph Bool-isSerializable el = do-    deps <- typeDependencies (elementName el)-    let allVariants = S.fromList $ L.concat (variants <$> M.elems deps)-    return $ not $ S.member TypeVariantFunction allVariants-  where-    variants typ = typeVariant <$> foldOverType TraversalOrderPre (\m t -> t:m) [] typ---- | Find dependency namespaces in various dimensions of a term: va-moduleDependencyNamespaces :: Bool -> Bool -> Bool -> Bool -> Module -> Flow Graph (S.Set Namespace)-moduleDependencyNamespaces withVars withPrims withNoms withSchema mod = do-    allNames <- S.unions <$> (CM.mapM elNames $ moduleElements mod)-    let namespaces = S.fromList $ Y.catMaybes (namespaceOfEager <$> S.toList allNames)-    return $ S.delete (moduleNamespace mod) namespaces-  where-    elNames el = do-      let term = elementData el-      let dataNames = termDependencyNames withVars withPrims withNoms term--      schemaNames <- if withSchema-        then typeDependencyNames <$> requireTermType term-        else pure S.empty--      typeNames <- if isEncodedType (fullyStripTerm term)-        then typeDependencyNames <$> coreDecodeType term-        else pure S.empty--      return $ S.unions [dataNames, schemaNames, typeNames]--requireRecordType :: Name -> Flow Graph RowType-requireRecordType = requireRowType "record type" $ \t -> case t of-  TypeRecord rt -> Just rt-  _ -> Nothing--requireRowType :: String -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType-requireRowType label getter name = do-  t <- requireType name-  case getter (rawType t) of-    Just rt -> return rt-    Nothing -> fail $ show name ++ " does not resolve to a " ++ label ++ " type: " ++ show t-  where-    rawType t = case t of-      TypeAnnotated (AnnotatedType t' _) -> rawType t'-      TypeLambda (LambdaType _ body) -> rawType body -- Note: throwing away quantification here-      _ -> t--requireType :: Name -> Flow Graph Type-requireType name = withTrace ("require type " ++ unName name) $-  (withSchemaContext $ requireElement name) >>= (coreDecodeType . elementData)--requireUnionType :: Name -> Flow Graph RowType-requireUnionType = requireRowType "union" $ \t -> case t of-  TypeUnion rt -> Just rt-  _ -> Nothing--requireWrappedType :: Name -> Flow Graph Type-requireWrappedType name = do-  typ <- requireType name-  case stripType typ of-    TypeWrap (WrappedType name t) -> return t-    _ -> return typ -- TODO: stop allowing this "slop" once typedefs are clearly separated from newtypes---     _ -> fail $ "expected wrapped type for " ++ unName name ++ " but got " ++ show typ--resolveType :: Type -> Flow Graph (Maybe Type)-resolveType typ = case stripType typ of-    TypeVariable name -> withSchemaContext $ do-      mterm <- resolveTerm name-      case mterm of-        Nothing -> pure Nothing-        Just t -> Just <$> coreDecodeType t-    _ -> pure $ Just typ--typeDependencies :: Name -> Flow Graph (M.Map Name Type)-typeDependencies name = deps (S.fromList [name]) M.empty-  where-    deps seeds names = if S.null seeds-        then return names-        else do-          pairs <- CM.mapM toPair $ S.toList seeds-          let newNames = M.union names (M.fromList pairs)-          let refs = L.foldl S.union S.empty (typeDependencyNames <$> (snd <$> pairs))-          let visited = S.fromList $ M.keys names-          let newSeeds = S.difference refs visited-          deps newSeeds newNames-      where-        toPair name = do-          typ <- requireType name-          return (name, typ)--    requireType name = do-      withTrace ("type dependencies of " ++ unName name) $ do-        el <- requireElement name-        coreDecodeType (elementData el)
+ src/main/haskell/Hydra/Settings.hs view
@@ -0,0 +1,5 @@+-- | The one non-generated Hydra kernel module. It contains constants which are set individually in each Hydra implementation.++module Hydra.Settings where++hydraDebug = True :: Bool
+ src/main/haskell/Hydra/Sources/All.hs view
@@ -0,0 +1,52 @@+module Hydra.Sources.All(+  module Hydra.Sources.All,+  module Hydra.Sources.Kernel.Terms.All,+  module Hydra.Sources.Kernel.Types.All,+) where++import Hydra.Kernel+import Hydra.Sources.Kernel.Terms.All+import Hydra.Sources.Kernel.Types.All++import Hydra.Sources.Haskell.Ast+import Hydra.Sources.Haskell.Coder+import Hydra.Sources.Haskell.Language+import Hydra.Sources.Haskell.Operators+import Hydra.Sources.Haskell.Serde+import Hydra.Sources.Haskell.Utils+import qualified Hydra.Sources.Json.Coder as JsonCoder+import qualified Hydra.Sources.Json.Decoding as JsonDecoding+import qualified Hydra.Sources.Json.Extract as JsonExtract+import qualified Hydra.Sources.Json.Language as JsonLanguage+import Hydra.Sources.Test.TestGraph+import Hydra.Sources.Test.TestSuite+import Hydra.Sources.Yaml.Model+++mainModules :: [Module]+mainModules = kernelModules ++ jsonModules ++ otherModules++jsonModules :: [Module]+jsonModules = [+  JsonCoder.module_,+  JsonDecoding.module_,+  JsonExtract.module_,+  JsonLanguage.module_]++otherModules :: [Module]+otherModules = [+  haskellAstModule,+  haskellCoderModule,+  haskellLanguageModule,+  haskellOperatorsModule,+  haskellSerdeModule,+  haskellUtilsModule,+  yamlModelModule]++testModules :: [Module]+testModules = [+  testGraphModule,+  testSuiteModule]++kernelModules :: [Module]+kernelModules = kernelTypesModules ++ kernelTermsModules
− src/main/haskell/Hydra/Sources/Core.hs 
@@ -1,413 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Core(-  hydraCore,-  hydraCoreModule,-  module Hydra.Kernel,-) where--import Hydra.Kernel-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---hydraCore :: Graph-hydraCore = elementsToGraph bootstrapGraph Nothing (moduleElements hydraCoreModule)--hydraCoreModule :: Module-hydraCoreModule = Module ns elements [] [] $-    Just "Hydra's core data model, defining types, terms, and their dependencies"-  where-    ns = Namespace "hydra/core"-    core = typeref ns-    def = datatype ns-    doc s = setTypeDescription (Just s)--    elements = [--      def "AnnotatedTerm" $-        doc "A term together with an annotation" $-        record [-          "subject">: core "Term",-          "annotation">: Types.map (core "Name") $ core "Term"],--      def "AnnotatedType" $-        doc "A type together with an annotation" $-        record [-          "subject">: core "Type",-          "annotation">: Types.map (core "Name") $ core "Term"],--      def "Application" $-        doc "A term which applies a function to an argument" $-        record [-          "function">:-            doc "The left-hand side of the application" $-            core "Term",-          "argument">:-            doc "The right-hand side of the application" $-            core "Term"],--      def "ApplicationType" $-        doc "The type-level analog of an application term" $-        record [-          "function">:-            doc "The left-hand side of the application" $-            core "Type",-          "argument">:-            doc "The right-hand side of the application" $-            core "Type"],--      def "CaseStatement" $-        doc "A union elimination; a case statement" $-        record [-          "typeName">: core "Name",-          "default">: optional (core "Term"),-          "cases">: list $ core "Field"],--      def "Elimination" $-        doc "A corresponding elimination for an introduction term" $-        union [-          "list">:-            doc "Eliminates a list using a fold function; this function has the signature b -> [a] -> b" $-            core "Term",-          "optional">:-            doc "Eliminates an optional term by matching over the two possible cases" $-            core "OptionalCases",-          "product">:-            doc "Eliminates a tuple by projecting the component at a given 0-indexed offset" $-            core "TupleProjection",-          "record">:-            doc "Eliminates a record by projecting a given field" $-            core "Projection",-          "union">:-            doc "Eliminates a union term by matching over the fields of the union. This is a case statement." $-            core "CaseStatement",-          "wrap">:-            doc "Unwrap a wrapped term" $-            core "Name"],--      def "Field" $-        doc "A name/term pair" $-        record [-          "name">: core "Name",-          "term">: core "Term"],--      def "FieldType" $-        doc "A name/type pair" $-        record [-          "name">: core "Name",-          "type">: core "Type"],--      def "FloatType" $-        doc "A floating-point type" $-        enum [-          "bigfloat",-          "float32",-          "float64"],--      def "FloatValue" $-        doc "A floating-point literal value" $-        union [-          "bigfloat">:-            doc "An arbitrary-precision floating-point value" bigfloat,-          "float32">:-            doc "A 32-bit floating-point value" float32,-          "float64">:-            doc "A 64-bit floating-point value" float64],--      def "Function" $-        doc "A function" $-        union [-          "elimination">:-            doc "An elimination for any of a few term variants" $-            core "Elimination",-          "lambda">:-            doc "A function abstraction (lambda)" $-            core "Lambda",-          "primitive">:-            doc "A reference to a built-in (primitive) function" $-            core "Name"],--      def "FunctionType" $-        doc "A function type, also known as an arrow type" $-        record [-          "domain">: core "Type",-          "codomain">: core "Type"],--      def "Injection" $-        doc "An instance of a union type; i.e. a string-indexed generalization of inl() or inr()" $-        record [-          "typeName">: core "Name",-          "field">: core "Field"],--      def "IntegerType" $-        doc "An integer type" $-        enum [-          "bigint",-          "int8",-          "int16",-          "int32",-          "int64",-          "uint8",-          "uint16",-          "uint32",-          "uint64"],--      def "IntegerValue" $-        doc "An integer literal value" $-        union [-          "bigint">:-            doc "An arbitrary-precision integer value" bigint,-          "int8">:-            doc "An 8-bit signed integer value" int8,-          "int16">:-            doc "A 16-bit signed integer value (short value)" int16,-          "int32">:-            doc "A 32-bit signed integer value (int value)" int32,-          "int64">:-            doc "A 64-bit signed integer value (long value)" int64,-          "uint8">:-            doc "An 8-bit unsigned integer value (byte)" uint8,-          "uint16">:-            doc "A 16-bit unsigned integer value" uint16,-          "uint32">:-            doc "A 32-bit unsigned integer value (unsigned int)" uint32,-          "uint64">:-            doc "A 64-bit unsigned integer value (unsigned long)" uint64],--      def "Lambda" $-        doc "A function abstraction (lambda)" $-        record [-          "parameter">:-            doc "The parameter of the lambda" $-            core "Name",-          "domain">:-            doc "An optional domain type for the lambda" $-            optional $ core "Type",-          "body">:-            doc "The body of the lambda" $-            core "Term"],--      def "LambdaType" $-        doc "A type abstraction; the type-level analog of a lambda term" $-        record [-          "parameter">:-            doc "The variable which is bound by the lambda" $-            core "Name",-          "body">:-            doc "The body of the lambda" $-            core "Type"],--      def "Let" $-        doc "A set of (possibly recursive) 'let' bindings together with an environment in which they are bound" $-        record [-          "bindings">: list $ core "LetBinding",-          "environment">: core "Term"],--      def "LetBinding" $-        doc "A field with an optional type scheme, used to bind variables to terms in a 'let' expression" $-        record [-          "name">: core "Name",-          "term">: core "Term",-          "type">: optional $ core "TypeScheme"],--      def "Literal" $-        doc "A term constant; an instance of a literal type" $-        union [-          "binary">:-            doc "A binary literal" binary,-          "boolean">:-            doc "A boolean literal" boolean,-          "float">:-            doc "A floating-point literal" $ core "FloatValue",-          "integer">:-            doc "An integer literal" $-            core "IntegerValue",-          "string">:-            doc "A string literal" string],--      def "LiteralType" $-        doc "Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants" $-        union [-          "binary">: unit,-          "boolean">: unit,-          "float">: core "FloatType",-          "integer">: core "IntegerType",-          "string">: unit],--      def "MapType" $-        doc "A map type" $-        record [-          "keys">: core "Type",-          "values">: core "Type"],--      def "Name" $-        doc "A unique identifier in some context; a string-valued key"-        $ wrap string,--      def "WrappedTerm" $-        doc "A term wrapped in a type name" $-        record [-          "typeName">: core "Name",-          "object">: core "Term"],--      def "WrappedType" $-        doc "A type wrapped in a type name" $-        record [-          "typeName">: core "Name",-          "object">: core "Type"],--      def "OptionalCases" $-        doc "A case statement for matching optional terms" $-        record [-          "nothing">:-            doc "A term provided if the optional value is nothing" $-            core "Term",-          "just">:-            doc "A function which is applied if the optional value is non-nothing" $-            core "Term"],--      def "Projection" $-        doc "A record elimination; a projection" $-        record [-          "typeName">:-            doc "The name of the record type" $-            core "Name",-          "field">:-            doc "The name of the projected field" $-            core "Name"],--      def "Record" $-        doc "A record, or labeled tuple; a map of field names to terms" $-        record [-          "typeName">: core "Name",-          "fields">: list $ core "Field"],--      def "RowType" $-        doc "A labeled record or union type" $-        record [-          "typeName">:-            doc "The name of the row type, which must correspond to the name of a Type element" $-            core "Name",-          "fields">:-            doc "The fields of this row type, excluding any inherited fields" $-            list $ core "FieldType"],--      def "Sum" $-        doc "The unlabeled equivalent of an Injection term" $-        record [-          "index">: int32,-          "size">: int32,-          "term">: core "Term"],--      def "Term" $-        doc "A data term" $-        union [-          "annotated">:-            doc "A term annotated with metadata" $-            core "AnnotatedTerm",-          "application">:-            doc "A function application" $-            core "Application",-          "function">:-            doc "A function term" $-            core "Function",-          "let">:-            core "Let",-          "list">:-            doc "A list" $-            list $ core "Term",-          -- TODO: list elimination-          "literal">:-            doc "A literal value" $-            core "Literal",-          "map">:-            doc "A map of keys to values" $-            Types.map (core "Term") (core "Term"),-          "optional">:-            doc "An optional value" $-            optional $ core "Term",-          "product">:-            doc "A tuple" $-            list (core "Term"),-          "record">:-            doc "A record term" $-            core "Record",-          "set">:-            doc "A set of values" $-            set $ core "Term",-          "sum">:-            doc "A variant tuple" $-            core "Sum",-          "typeAbstraction">:-            doc "A System F type abstraction term" $-            core "TypeAbstraction",-          "typeApplication">:-            doc "A System F type application term" $-            core "TypedTerm",-          "typed">:-            doc "A term annotated with its type" $-            core "TypedTerm",-          "union">:-            doc "An injection; an instance of a union type" $-            core "Injection",-          "variable">:-            doc "A variable reference" $-            core "Name",-          "wrap">:-            core "WrappedTerm"],--      def "TupleProjection" $-        doc "A tuple elimination; a projection from an integer-indexed product" $-        record [-          "arity">:-            doc "The arity of the tuple"-            int32,-          "index">:-            doc "The 0-indexed offset from the beginning of the tuple"-            int32],--      def "Type" $-        doc "A data type" $-        union [-          "annotated">: core "AnnotatedType",-          "application">: core "ApplicationType",-          "function">: core "FunctionType",-          "lambda">: core "LambdaType",-          "list">: core "Type",-          "literal">: core "LiteralType",-          "map">: core "MapType",-          "optional">: core "Type",-          "product">: list (core "Type"),-          "record">: core "RowType",-          "set">: core "Type",-          "sum">: list (core "Type"),-          "union">: core "RowType",-          "variable">: core "Name",-          "wrap">: core "WrappedType"],--      def "TypeAbstraction" $-        doc "A System F type abstraction term" $-        record [-          "parameter">:-            doc "The type variable introduced by the abstraction" $-            core "Name",-          "body">:-            doc "The body of the abstraction" $-            core "Term"],--      def "TypeScheme" $-        doc "A type expression together with free type variables occurring in the expression" $-        record [-          "variables">: list $ core "Name",-          "type">: core "Type"],--      def "TypedTerm" $-        doc "A term together with its type" $-        record [-          "term">: core "Term",-          "type">: core "Type"],--      def "Unit" $-        doc "An empty record as a canonical unit value" $-        record []]
+ src/main/haskell/Hydra/Sources/Haskell/Ast.hs view
@@ -0,0 +1,453 @@+module Hydra.Sources.Haskell.Ast where++import Hydra.Kernel+import qualified Hydra.Sources.Kernel.Types.All as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.All as Tier2+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types++import qualified Hydra.Sources.Kernel.Types.Accessors   as Accessors+import qualified Hydra.Sources.Kernel.Types.Ast         as Ast+import qualified Hydra.Sources.Kernel.Types.Coders      as Coders+import qualified Hydra.Sources.Kernel.Types.Compute     as Compute+import qualified Hydra.Sources.Kernel.Types.Constraints as Constraints+import qualified Hydra.Sources.Kernel.Types.Core        as Core+import qualified Hydra.Sources.Kernel.Types.Grammar     as Grammar+import qualified Hydra.Sources.Kernel.Types.Graph       as Graph+import qualified Hydra.Sources.Kernel.Types.Json        as Json+import qualified Hydra.Sources.Kernel.Types.Mantle      as Mantle+import qualified Hydra.Sources.Kernel.Types.Module      as Module+import qualified Hydra.Sources.Kernel.Types.Phantoms    as Phantoms+import qualified Hydra.Sources.Kernel.Types.Relational  as Relational+import qualified Hydra.Sources.Kernel.Types.Query       as Query+import qualified Hydra.Sources.Kernel.Types.Tabular     as Tabular+import qualified Hydra.Sources.Kernel.Types.Testing     as Testing+import qualified Hydra.Sources.Kernel.Types.Topology    as Topology+import qualified Hydra.Sources.Kernel.Types.Typing      as Typing+import qualified Hydra.Sources.Kernel.Types.Workflow    as Workflow++haskellAstModule :: Module+haskellAstModule = Module ns elements [Core.module_] [Core.module_] $+    Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST"+  where+    ns = Namespace "hydra.ext.haskell.ast"+    def = datatype ns+    ast = typeref ns++    elements = [++      def "Alternative" $ -- UAlt+        doc "A pattern-matching alternative" $+        record [+          "pattern">: ast "Pattern",+          "rhs">: ast "CaseRhs",+          "binds">: optional $ ast "LocalBindings"],++      def "Assertion" $ -- UAssertion (UClassAssert)+        doc "A type assertion" $+        union [+          "class">: ast "ClassAssertion",+          "tuple">: list $ ast "Assertion"],+        -- omitted for now: implicit and infix assertions++      def "ClassAssertion" $ -- UClassAssert+        record [+          "name">: ast "Name",+          "types">: list $ ast "Type"],++      def "CaseRhs" $ -- UCaseRhs'+        doc "The right-hand side of a pattern-matching alternative" $+        -- omitted for now: guarded+        wrap $ ast "Expression",++      def "Constructor" $ -- UConDecl+        doc "A data constructor" $+        -- omitted for now: ordinary (positional), infix+        union [+          "ordinary">: ast "OrdinaryConstructor",+          "record">: ast "RecordConstructor"],++      def "OrdinaryConstructor" $+        doc "An ordinary (positional) data constructor" $+        record [+          "name">: ast "Name",+          "fields">: list $ ast "Type"],++      def "RecordConstructor" $+        doc "A record-style data constructor" $+        record [+          "name">: ast "Name",+          "fields">: list $ ast "FieldWithComments"],++      def "ConstructorWithComments" $+        doc "A data constructor together with any comments" $+        record [+          "body">: ast "Constructor",+          "comments">: optional string],++      def "DataDeclaration" $ -- UDataDecl+        doc "A data type declaration" $+        record [+          "keyword">: ast "DataOrNewtype",+          "context">: list $ ast "Assertion",+          "head">: ast "DeclarationHead",+          "constructors">: list $ ast "ConstructorWithComments",+          "deriving">: list $ ast "Deriving"],++      def "DataOrNewtype" $+        doc "The 'data' versus 'newtype keyword" $+        enum ["data", "newtype"],++      def "DeclarationWithComments" $+        doc "A data declaration together with any comments" $+        record [+          "body">: ast "Declaration",+          "comments">: optional string],++      def "Declaration" $ -- UDecl+        doc "A data or value declaration" $+        -- omitted for now: typeFamily, typeSignature, closedTypeFamily, gDataDecl, typeInst, dataInst, gDataInst, class, inst,+        --                  patternSynonym, deriv, fixity, default, patTypeSig, foreignImport, foreignExport, pragma,+        --                  role, splice+        union [+          "data">: ast "DataDeclaration",+          "type">: ast "TypeDeclaration",+          "valueBinding">: ast "ValueBinding",+          "typedBinding">: ast "TypedBinding"],++      def "DeclarationHead" $ -- UDeclHead+        doc "The left-hand side of a declaration" $+        -- omitted for now: infix application+        union [+          "application">: ast "ApplicationDeclarationHead",+          "parens">: ast "DeclarationHead",+          "simple">: ast "Name"],++      def "ApplicationDeclarationHead" $+        doc "An application-style declaration head" $+        record [+          "function">: ast "DeclarationHead",+          "operand">: ast "Variable"],++      def "Deriving" $ -- UDeriving+        doc "A 'deriving' statement" $+        -- omitted for now: infix, parenthesized, and application instance heads+        wrap $ list $ ast "Name",++      def "Export" $ -- UExportSpec+        doc "An export statement" $+        union [+          "declaration">: ast "ImportExportSpec",+          "module">: ast "ModuleName"],++      def "Expression" $ -- UExpr+        doc "A data expression" $+        -- omitted for now: multi-if, unboxed tuple, tuple section, unboxed tuple section, parallel array,+        --                  enum, parallel array enum, list comp, parallel array comp, type application,+        --                  (all Template Haskell constructors), pragma, arrow definition, arrow application,+        --                  lambda cases, static, unboxed sum, hole+        union [+          "application">: ast "ApplicationExpression",+          "case">: ast "CaseExpression",+          "constructRecord">: ast "ConstructRecordExpression",+          "do">: list $ ast "Statement", -- omitted for now: do vs. mdo+          "if">: ast "IfExpression",+          "infixApplication">: ast "InfixApplicationExpression",+          "literal">: ast "Literal",+          "lambda">: ast "LambdaExpression",+          "leftSection">: ast "SectionExpression",+          "let">: ast "LetExpression",+          "list">: list $ ast "Expression",+          "parens">: ast "Expression",+          "prefixApplication">: ast "PrefixApplicationExpression",+          "rightSection">: ast "SectionExpression",+          "tuple">: list $ ast "Expression",+          "typeSignature">: ast "TypeSignatureExpression",+          "updateRecord">: ast "UpdateRecordExpression",+          "variable">: ast "Name"],++      def "ApplicationExpression" $+        doc "An application expression" $+        record [+          "function">: ast "Expression",+          "argument">: ast "Expression"],++      def "CaseExpression" $+        doc "A case expression" $+        record [+          "case">: ast "Expression",+          "alternatives">: list $ ast "Alternative"],++      def "ConstructRecordExpression" $+        doc "A record constructor expression" $+        record [+          "name">: ast "Name",+          "fields">: list $ ast "FieldUpdate"],++      def "IfExpression" $+        doc "An 'if' expression" $+        record [+          "condition">: ast "Expression",+          "then">: ast "Expression",+          "else">: ast "Expression"],++      def "InfixApplicationExpression" $+        doc "An infix application expression" $+        record [+          "lhs">: ast "Expression",+          "operator">: ast "Operator",+          "rhs">: ast "Expression"],++      def "LambdaExpression" $+        doc "A lambda expression" $+        record [+          "bindings">: list $ ast "Pattern",+          "inner">: ast "Expression"],++      def "LetExpression" $+        doc "A 'let' expression" $+        record [+          "bindings">: list $ ast "LocalBinding",+          "inner">: ast "Expression"],++      def "PrefixApplicationExpression" $+        doc "A prefix expression" $+        record [+          "operator">: ast "Operator",+          "rhs">: ast "Expression"],++      def "SectionExpression" $+        doc "A section expression" $+        record [+          "operator">: ast "Operator",+          "expression">: ast "Expression"],++      def "TypeSignatureExpression" $+        doc "A type signature expression" $+        record [+          "inner">: ast "Expression",+          "type">: ast "Type"],++      def "UpdateRecordExpression" $+        doc "An update record expression" $+        record [+          "inner">: ast "Expression",+          "fields">: list $ ast "FieldUpdate"],++      def "Field" $ -- UFieldDecl+        doc "A field (name/type pair)" $+        record [+          "name">: ast "Name",+          "type">: ast "Type"],++      def "FieldWithComments" $+        doc "A field together with any comments" $+        record [+          "field">: ast "Field",+          "comments">: optional string],++      def "FieldUpdate" $ -- UFieldUpdate+        doc "A field name and value" $+        -- omitted for now: pun, wildcard+        record [+          "name">: ast "Name",+          "value">: ast "Expression"],++      def "Import" $ -- UImportDecl+        doc "An import statement" $+        -- omitted for now: source, safe, pkg+        record [+          "qualified">: boolean,+          "module">: ast "ModuleName",+          "as">: optional $ ast "ModuleName",+          "spec">: optional $ ast "SpecImport"],++      def "SpecImport" $+        doc "An import specification" $+        union [+          "list">: list $ ast "ImportExportSpec",+          "hiding">: list $ ast "ImportExportSpec"],++      def "ImportModifier" $ -- UImportModifier+        doc "An import modifier ('pattern' or 'type')" $+        enum ["pattern", "type"],++      def "ImportExportSpec" $ -- UIESpec+        doc "An import or export specification" $+        record [+          "modifier">: optional $ ast "ImportModifier",+          "name">: ast "Name",+          "subspec">: optional $ ast "SubspecImportExportSpec"],++      def "SubspecImportExportSpec" $+        union [+          "all">: unit,+          "list">: list $ ast "Name"],++      def "Literal" $ -- ULiteral+        doc "A literal value" $+        -- omitted for now: frac, primChar+        union [+          "char">: uint16,+          "double">: float64,+          "float">: float32,+          "int">: int32,+          "integer">: bigint,+          "string">: string],++      def "LocalBinding" $ -- ULocalBind+        -- omitted for now: fixity, pragma+        union [+          "signature">: ast "TypeSignature",+          "value">: ast "ValueBinding"],++      def "LocalBindings" $ -- ULocalBinds+        wrap $ list $ ast "LocalBinding",++      def "Module" $ -- UModule+        -- omitted for now: pragma+        record [+          "head">: optional $ ast "ModuleHead",+          "imports">: list $ ast "Import",+          "declarations">: list $ ast "DeclarationWithComments"],++      def "ModuleHead" $ -- UModuleHead+        -- omitted for now: pragma+        record [+          "comments">: optional string,+          "name">: ast "ModuleName",+          "exports">: list $ ast "Export"], -- UExportSpecs++      def "ModuleName" $ -- UModuleName+        wrap string,++      def "Name" $ -- UName+        union [+          "implicit">: ast "QualifiedName",+          "normal">: ast "QualifiedName",+          "parens">: ast "QualifiedName"],++      def "NamePart" $ -- UNamePart+        wrap string,++      def "Operator" $ -- UOperator+        union [+          "backtick">: ast "QualifiedName",+          "normal">: ast "QualifiedName"],++      def "Pattern" $ -- UPattern+        -- omitted for now: unboxed tuples, parallel arrays, irrefutable, bang, view, splice, quasiquote, plusk, unboxed sum+        union [+          "application">: ast "ApplicationPattern",+          "as">: ast "AsPattern",+          "list">: list $ ast "Pattern",+          "literal">: ast "Literal",+          "name">: ast "Name",+          "parens">: ast "Pattern",+          "record">: ast "RecordPattern",+          "tuple">: list $ ast "Pattern",+          "typed">: ast "TypedPattern",+          "wildcard">: unit],++      def "ApplicationPattern" $+        record [+          "name">: ast "Name",+          "args">: list $ ast "Pattern"],++      def "AsPattern" $+        record [+          "name">: ast "Name",+          "inner">: ast "Pattern"],++      def "RecordPattern" $+        record [+          "name">: ast "Name",+          "fields">: list $ ast "PatternField"],++      def "TypedPattern" $+        record [+          "inner">: ast "Pattern",+          "type">: ast "Type"],++      def "PatternField" $ -- UPatternField+        -- omitted for now: puns, wildcards+        record [+          "name">: ast "Name",+          "pattern">: ast "Pattern"],++      def "QualifiedName" $ -- UQualifiedName+        record [+          "qualifiers">: list $ ast "NamePart",+          "unqualified">: ast "NamePart"],++      def "RightHandSide" $ -- URhs+        -- omitted for now: guarded rhs+        wrap $ ast "Expression",++      def "Statement" $ -- UStmt+        wrap $ ast "Expression",++      def "Type" $ -- UType+        -- omitted for now: forall, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang,+        --                  lazy, unpack, nounpack, wildcard, named wildcard, sum+        union [+          "application">: ast "ApplicationType",+          "ctx">: ast "ContextType",+          "function">: ast "FunctionType",+          "infix">: ast "InfixType",+          "list">: ast "Type",+          "parens">: ast "Type",+          "tuple">: list $ ast "Type",+          "variable">: ast "Name"],++      def "ApplicationType" $+        record [+          "context">: ast "Type",+          "argument">: ast "Type"],++      def "ContextType" $+        record [+          "ctx">: ast "Assertion", -- UContext+          "type">: ast "Type"],++      def "FunctionType" $+        record [+          "domain">: ast "Type",+          "codomain">: ast "Type"],++      def "InfixType" $+        record [+          "lhs">: ast "Type",+          "operator">: ast "Operator",+          "rhs">: ast "Operator"],++      def "TypeDeclaration" $ -- UTypeDecl+        record [+          "name">: ast "DeclarationHead",+          "type">: ast "Type"],++      def "TypeSignature" $ -- UTypeSignature+        record [+          "name">: ast "Name",+          "type">: ast "Type"],++      def "TypedBinding" $ -- Added for convenience+        record [+          "typeSignature">: ast "TypeSignature",+          "valueBinding">: ast "ValueBinding"],++      def "ValueBinding" $ -- UValueBind+        -- omitted for now: funBind+        union [+          "simple">: ast "SimpleValueBinding"],++      def "SimpleValueBinding" $+        record [+          "pattern">: ast "Pattern",+          "rhs">: ast "RightHandSide",+          "localBindings">: optional $ ast "LocalBindings"],++      def "Variable" $+        -- omitted for now: kind constraints+        wrap $ ast "Name"]
+ src/main/haskell/Hydra/Sources/Haskell/Coder.hs view
@@ -0,0 +1,861 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Haskell.Coder where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++-- Additional imports+import qualified Hydra.Ext.Haskell.Ast as H+import qualified Hydra.Sources.Haskell.Language as HaskellLanguage+import qualified Hydra.Sources.Haskell.Ast as HaskellAst+import qualified Hydra.Sources.Haskell.Serde as HaskellSerde+import qualified Hydra.Sources.Haskell.Utils as HaskellUtils+++type HaskellNamespaces = Namespaces H.ModuleName++haskellCoderDefinition :: String -> TTerm a -> TBinding a+haskellCoderDefinition = definitionInModule haskellCoderModule++haskellCoderModule :: Module+haskellCoderModule = Module ns elements+    [HaskellSerde.haskellSerdeModule, HaskellUtils.haskellUtilsModule,+      AdaptModules.module_, Rewriting.module_, Serialization.module_]+    (HaskellAst.haskellAstModule:KernelTypes.kernelTypesModules) $+    Just "Functions for encoding Hydra modules as Haskell modules"+  where+    ns = Namespace "hydra.ext.haskell.coder"+    elements = [+      el includeTypeDefinitionsDef,+      el useCoreImportDef,+      el keyHaskellVarDef,+      el adaptTypeToHaskellAndEncodeDef,+      el constantForFieldNameDef,+      el constantForTypeNameDef,+      el constructModuleDef,+      el encodeFunctionDef,+      el encodeLiteralDef,+      el encodeTermDef,+      el encodeTypeDef,+      el encodeTypeWithClassAssertionsDef,+      el findOrdVariablesDef,+      el getImplicitTypeClassesDef,+      el moduleToHaskellModuleDef,+      el moduleToHaskellDef,+      el nameDeclsDef,+      el toDataDeclarationDef,+      el toTypeDeclarationsDef,+      el typeDeclDef]++-- TODO: make these settings configurable+includeTypeDefinitionsDef :: TBinding Bool+includeTypeDefinitionsDef = haskellCoderDefinition "includeTypeDefinitions" $+  false+useCoreImportDef :: TBinding Bool+useCoreImportDef = haskellCoderDefinition "useCoreImport" $+  true++keyHaskellVarDef :: TBinding Name+keyHaskellVarDef = haskellCoderDefinition "keyHaskellVar" $+  wrap _Name $ string "haskellVar"++adaptTypeToHaskellAndEncodeDef :: TBinding (HaskellNamespaces -> Type -> Flow Graph H.Type)+adaptTypeToHaskellAndEncodeDef = haskellCoderDefinition "adaptTypeToHaskellAndEncode" $+  lambda "namespaces" $+    ref AdaptModules.adaptTypeToLanguageAndEncodeDef @@ (ref HaskellLanguage.haskellLanguageDef) @@ (ref encodeTypeDef @@ var "namespaces")++constantForFieldNameDef :: TBinding (Name -> Name -> String)+constantForFieldNameDef = haskellCoderDefinition "constantForFieldName" $+  lambda "tname" $ lambda "fname" $+    Strings.cat $ list [+      string "_",+      ref Names.localNameOfDef @@ var "tname",+      string "_",+      Core.unName $ var "fname"]++constantForTypeNameDef :: TBinding (Name -> String)+constantForTypeNameDef = haskellCoderDefinition "constantForTypeName" $+  lambda "tname" $+    Strings.cat2 (string "_") (ref Names.localNameOfDef @@ var "tname")++constructModuleDef :: TBinding (HaskellNamespaces -> Module -> M.Map Type (Coder Graph Graph Term H.Expression) -> [(Binding, TypedTerm)] -> Flow Graph H.Module)+constructModuleDef = haskellCoderDefinition "constructModule" $ lambdas ["namespaces", "mod", "coders", "pairs"] $ lets [+  "h">: lambda "namespace" $+    unwrap _Namespace @@ var "namespace",+  "createDeclarations">: lambda "g" $ lambda "pair" $ lets [+    "el">: first $ var "pair",+    "tt">: second $ var "pair",+    "term">: Core.typedTermTerm $ var "tt",+    "typ">: Core.typedTermType $ var "tt"] $+    Logic.ifElse (ref Annotations.isNativeTypeDef @@ var "el")+      (ref toTypeDeclarationsDef @@ var "namespaces" @@ var "el" @@ var "term")+      (bind "d" (ref toDataDeclarationDef @@ var "coders" @@ var "namespaces" @@ var "pair") $+        Flows.pure $ list [var "d"]),+    "importName">: lambda "name" $+      wrap H._ModuleName $ Strings.intercalate (string ".") (Lists.map (ref Formatting.capitalizeDef) (Strings.splitOn (string ".") (var "name"))),+    "imports">: Lists.concat2 (var "domainImports") (var "standardImports"),+    "domainImports">: lets [+      "toImport">: lambda "pair" $ lets [+        "namespace">: first $ var "pair",+        "alias">: second $ var "pair",+        "name">: var "h" @@ var "namespace"] $+        record H._Import [+          H._Import_qualified>>: true,+          H._Import_module>>: var "importName" @@ var "name",+          H._Import_as>>: just $ var "alias",+          H._Import_spec>>: nothing]] $+      Lists.map (var "toImport") (Maps.toList $ Module.namespacesMapping $ var "namespaces"),+    "standardImports">: lets [+      "toImport">: lambda "triple" $ lets [+        "name">: first $ first $ var "triple",+        "malias">: second $ first $ var "triple",+        "hidden">: second $ var "triple",+        "spec">: Logic.ifElse (Lists.null $ var "hidden")+          nothing+          (just $ inject H._SpecImport H._SpecImport_hiding $ Lists.map (lambda "n" $ record H._ImportExportSpec [+            H._ImportExportSpec_modifier>>: nothing,+            H._ImportExportSpec_name>>: ref HaskellUtils.simpleNameDef @@ var "n",+            H._ImportExportSpec_subspec>>: nothing]) (var "hidden"))] $+        record H._Import [+          H._Import_qualified>>: Optionals.isJust $ var "malias",+          H._Import_module>>: wrap H._ModuleName $ var "name",+          H._Import_as>>: Optionals.map (unaryFunction $ wrap H._ModuleName) (var "malias"),+          H._Import_spec>>: var "spec"]] $+      Lists.map (var "toImport") $ list [+        pair (pair (string "Prelude") nothing) (list $ string <$> [+          "Enum", "Ordering", "fail", "map", "pure", "sum"]),+        pair (pair (string "Data.Int") (just $ string "I")) (list []),+        pair (pair (string "Data.List") (just $ string "L")) (list []),+        pair (pair (string "Data.Map") (just $ string "M")) (list []),+        pair (pair (string "Data.Set") (just $ string "S")) (list [])]] $+    bind "g" (ref Monads.getStateDef) $+    bind "declLists" (Flows.mapList (var "createDeclarations" @@ var "g") (var "pairs")) $ lets [+    "decls">: Lists.concat $ var "declLists",+    "mc">: Module.moduleDescription $ var "mod"] $+    Flows.pure $ record H._Module [+      H._Module_head>>: just $ record H._ModuleHead [+        H._ModuleHead_comments>>: var "mc",+        H._ModuleHead_name>>: var "importName" @@ (var "h" @@ (Module.moduleNamespace $ var "mod")),+        H._ModuleHead_exports>>: list []],+      H._Module_imports>>: var "imports",+      H._Module_declarations>>: var "decls"]++encodeFunctionDef :: TBinding (HaskellNamespaces -> Function -> Flow Graph H.Expression)+encodeFunctionDef = haskellCoderDefinition "encodeFunction" $+  lambda "namespaces" $ lambda "fun" $+    cases _Function (var "fun") Nothing [+      _Function_elimination>>: lambda "e" $+        cases _Elimination (var "e") Nothing [+          _Elimination_wrap>>: lambda "name" $+            Flows.pure $ inject H._Expression H._Expression_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@+              (ref Names.qnameDef @@ (Optionals.fromJust $ ref Names.namespaceOfDef @@ var "name") @@ (ref HaskellUtils.newtypeAccessorNameDef @@ var "name")),+          _Elimination_product>>: lambda "proj" $ lets [+            "arity">: Core.tupleProjectionArity $ var "proj",+            "idx">: Core.tupleProjectionIndex $ var "proj"] $+            Logic.ifElse (Equality.equal (var "arity") (int32 2))+              (Flows.pure $ ref HaskellUtils.hsvarDef @@ Logic.ifElse (Equality.equal (var "idx") (int32 0)) (string "fst") (string "snd"))+              (Flows.fail $ string "Eliminations for tuples of arity > 2 are not supported yet in the Haskell coder"),+          _Elimination_record>>: lambda "proj" $ lets [+            "dn">: Core.projectionTypeName $ var "proj",+            "fname">: Core.projectionField $ var "proj"] $+            Flows.pure $ inject H._Expression H._Expression_variable $ ref HaskellUtils.recordFieldReferenceDef @@ var "namespaces" @@ var "dn" @@ var "fname",+          _Elimination_union>>: lambda "stmt" $ lets [+            "dn">: Core.caseStatementTypeName $ var "stmt",+            "def">: Core.caseStatementDefault $ var "stmt",+            "fields">: Core.caseStatementCases $ var "stmt",+            "caseExpr">:+              bind "rt" (ref Lexical.withSchemaContextDef @@ (ref Schemas.requireUnionTypeDef @@ var "dn")) $ lets [+              "fieldMap">: Maps.fromList $ Lists.map (var "toFieldMapEntry") (Core.rowTypeFields $ var "rt"),+              "toFieldMapEntry">: lambda "f" $+                pair (Core.fieldTypeName $ var "f") (var "f")] $+              bind "ecases" (Flows.mapList (var "toAlt" @@ var "fieldMap") (var "fields")) $+              bind "dcases" (Optionals.cases (var "def")+                (Flows.pure $ list []) $+                (lambda "d" $+                  bind "cs" (Flows.map (unaryFunction $ wrap H._CaseRhs) $ ref encodeTermDef @@ var "namespaces" @@ var "d") $ lets [+                  "lhs">: inject H._Pattern H._Pattern_name $ ref HaskellUtils.rawNameDef @@ (ref Constants.ignoredVariableDef),+                  "alt">: record H._Alternative [+                    H._Alternative_pattern>>: var "lhs",+                    H._Alternative_rhs>>: var "cs",+                    H._Alternative_binds>>: nothing]] $+                  Flows.pure $ list [var "alt"])) $+              Flows.pure $ inject H._Expression H._Expression_case $ record H._CaseExpression [+                H._CaseExpression_case>>: ref HaskellUtils.hsvarDef @@ string "x",+                H._CaseExpression_alternatives>>: Lists.concat2 (var "ecases") (var "dcases")],+              "toAlt">: lambdas ["fieldMap", "field"] $ lets [+                "fn">: Core.fieldName $ var "field",+                "fun'">: Core.fieldTerm $ var "field"] $+                ref Annotations.withDepthDef @@ ref keyHaskellVarDef @@ (+                  lambda "depth" $ lets [+                    "v0">: Strings.cat2 (string "v") (Literals.showInt32 $ var "depth"),+                    "raw">: TTerms.apply (var "fun'") (Core.termVariable $ Core.name $ var "v0"),+                    "rhsTerm">: ref Rewriting.simplifyTermDef @@ var "raw",+                    "v1">: Logic.ifElse (ref Rewriting.isFreeVariableInTermDef @@ (wrap _Name $ var "v0") @@ var "rhsTerm")+                      (ref Constants.ignoredVariableDef)+                      (var "v0"),+                    "hname">: ref HaskellUtils.unionFieldReferenceDef @@ var "namespaces" @@ var "dn" @@ var "fn"] $+                    bind "args"+                      (Optionals.cases (Maps.lookup (var "fn") (var "fieldMap"))+                        (Flows.fail $ Strings.cat $ list [string "field ", Literals.showString $ (Core.unName $ var "fn"),+                          string " not found in ", Literals.showString $ (Core.unName $ var "dn")])+                        (lambda "fieldType" $ lets [+                          "ft">: Core.fieldTypeType $ var "fieldType",+                          "noArgs">: Flows.pure $ list [],+                          "singleArg">: Flows.pure $ list [inject H._Pattern H._Pattern_name $ ref HaskellUtils.rawNameDef @@ var "v1"]] $+                          cases _Type (ref Rewriting.deannotateTypeDef @@ var "ft")+                            (Just $ var "singleArg") [+                            _Type_unit>>: constant $ var "noArgs"])) $ lets [+                    "lhs">: ref HaskellUtils.applicationPatternDef @@ var "hname" @@ var "args"] $+                    bind "rhs" (Flows.map (unaryFunction $ wrap H._CaseRhs) $ ref encodeTermDef @@ var "namespaces" @@ var "rhsTerm") $+                    Flows.pure $ record H._Alternative [+                      H._Alternative_pattern>>: var "lhs",+                      H._Alternative_rhs>>: var "rhs",+                      H._Alternative_binds>>: nothing])] $+            Flows.map (ref HaskellUtils.hslambdaDef @@ (ref HaskellUtils.rawNameDef @@ string "x")) (var "caseExpr")],+      _Function_lambda>>: lambda "lam" $ lets [+        "v">: Core.lambdaParameter $ var "lam",+        "body">: Core.lambdaBody $ var "lam"] $+        Flows.bind (ref encodeTermDef @@ var "namespaces" @@ var "body") $ lambda "hbody" $+          Flows.pure $ ref HaskellUtils.hslambdaDef @@ (ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "v") @@ var "hbody",+      _Function_primitive>>: lambda "name" $+        Flows.pure $ inject H._Expression H._Expression_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "name"]++encodeLiteralDef :: TBinding (Literal -> Flow Graph H.Expression)+encodeLiteralDef = haskellCoderDefinition "encodeLiteral" $+  lambda "l" $+    cases _Literal (var "l")+      (Just $ Flows.fail $ Strings.cat2 (string "literal value ") (ref ShowCore.literalDef @@ var "l")) [+      _Literal_boolean>>: lambda "b" $+        Flows.pure $ ref HaskellUtils.hsvarDef @@ Logic.ifElse (var "b") (string "True") (string "False"),+      _Literal_float>>: lambda "fv" $+        cases _FloatValue (var "fv") Nothing [+          _FloatValue_float32>>: lambda "f" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_float $ var "f"),+          _FloatValue_float64>>: lambda "f" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_double $ var "f"),+          _FloatValue_bigfloat>>: lambda "f" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_double $ Literals.bigfloatToFloat64 $ var "f")],+      _Literal_integer>>: lambda "iv" $+        cases _IntegerValue (var "iv") Nothing [+          _IntegerValue_bigint>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ var "i"),+          _IntegerValue_int8>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.int8ToBigint $ var "i"),+          _IntegerValue_int16>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.int16ToBigint $ var "i"),+          _IntegerValue_int32>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_int $ var "i"),+          _IntegerValue_int64>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.int64ToBigint $ var "i"),+          _IntegerValue_uint8>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.uint8ToBigint $ var "i"),+          _IntegerValue_uint16>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.uint16ToBigint $ var "i"),+          _IntegerValue_uint32>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.uint32ToBigint $ var "i"),+          _IntegerValue_uint64>>: lambda "i" $+            Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_integer $ Literals.uint64ToBigint $ var "i")],+      _Literal_string>>: lambda "s" $+        Flows.pure $ ref HaskellUtils.hslitDef @@ (inject H._Literal H._Literal_string $ var "s")]++encodeTermDef :: TBinding (HaskellNamespaces -> Term -> Flow Graph H.Expression)+encodeTermDef = haskellCoderDefinition "encodeTerm" $+  lambda "namespaces" $ lambda "term" $ lets [+    "encode">: ref encodeTermDef @@ var "namespaces"] $+    cases _Term (ref Rewriting.deannotateTermDef @@ var "term")+      (Just $ Flows.fail $ Strings.cat2 (string "unexpected term: ") (ref ShowCore.termDef @@ var "term")) [+      _Term_application>>: lambda "app" $ lets [+        "fun">: Core.applicationFunction $ var "app",+        "arg">: Core.applicationArgument $ var "app"] $+        Flows.bind (var "encode" @@ var "fun") $ lambda "hfun" $+          Flows.bind (var "encode" @@ var "arg") $ lambda "harg" $+            Flows.pure $ ref HaskellUtils.hsappDef @@ var "hfun" @@ var "harg",+      _Term_function>>: lambda "f" $+        ref encodeFunctionDef @@ var "namespaces" @@ var "f",+      _Term_let>>: lambda "letTerm" $ lets [+        "bindings">: Core.letBindings $ var "letTerm",+        "env">: Core.letEnvironment $ var "letTerm",+        "encodeBinding">: lambda "binding" $ lets [+          "name">: Core.bindingName $ var "binding",+          "term'">: Core.bindingTerm $ var "binding",+          "hname">: ref HaskellUtils.simpleNameDef @@ (Core.unName $ var "name")] $+          bind "hexpr" (var "encode" @@ var "term'") $+          Flows.pure $ inject H._LocalBinding H._LocalBinding_value $ ref HaskellUtils.simpleValueBindingDef @@ var "hname" @@ var "hexpr" @@ nothing] $+        bind "hbindings" (Flows.mapList (var "encodeBinding") (var "bindings")) $+        bind "hinner" (var "encode" @@ var "env") $+        Flows.pure $ inject H._Expression H._Expression_let $ record H._LetExpression [+          H._LetExpression_bindings>>: var "hbindings",+          H._LetExpression_inner>>: var "hinner"],+      _Term_list>>: lambda "els" $+        Flows.bind (Flows.mapList (var "encode") (var "els")) $ lambda "helems" $+          Flows.pure $ inject H._Expression H._Expression_list $ var "helems",+      _Term_literal>>: lambda "v" $+        ref encodeLiteralDef @@ var "v",+      _Term_map>>: lambda "m" $ lets [+        "lhs">: ref HaskellUtils.hsvarDef @@ string "M.fromList",+        "encodePair">: lambda "pair" $ lets [+          "k">: first $ var "pair",+          "v">: second $ var "pair",+          "hk">: var "encode" @@ var "k",+          "hv">: var "encode" @@ var "v"] $+          Flows.map+            (unaryFunction $ inject H._Expression H._Expression_tuple)+            (Flows.sequence $ list [var "hk", var "hv"])] $+        bind "rhs" (Flows.map+          (unaryFunction $ inject H._Expression H._Expression_list)+          (Flows.mapList (var "encodePair") $ Maps.toList (var "m"))) $+        Flows.pure $ ref HaskellUtils.hsappDef @@ var "lhs" @@ var "rhs",+      _Term_optional>>: lambda "m" $+        Optionals.cases (var "m")+          (Flows.pure $ ref HaskellUtils.hsvarDef @@ string "Nothing") $+          lambda "t" $+            Flows.bind (var "encode" @@ var "t") $ lambda "ht" $+              Flows.pure $ ref HaskellUtils.hsappDef @@ (ref HaskellUtils.hsvarDef @@ string "Just") @@ var "ht",+      _Term_product>>: lambda "terms" $+        Flows.bind (Flows.mapList (var "encode") (var "terms")) $ lambda "hterms" $+          Flows.pure $ inject H._Expression H._Expression_tuple $ var "hterms",+      _Term_record>>: lambda "record" $ lets [+        "sname">: Core.recordTypeName $ var "record",+        "fields">: Core.recordFields $ var "record",+        "toFieldUpdate">: lambda "field" $ lets [+          "fn">: Core.fieldName $ var "field",+          "ft">: Core.fieldTerm $ var "field",+          "fieldRef">: ref HaskellUtils.recordFieldReferenceDef @@ var "namespaces" @@ var "sname" @@ var "fn"] $+          bind "hft" (var "encode" @@ var "ft") $+          Flows.pure $ record H._FieldUpdate [+            H._FieldUpdate_name>>: var "fieldRef",+            H._FieldUpdate_value>>: var "hft"],+          "typeName">: ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "sname"] $+          bind "updates" (Flows.mapList (var "toFieldUpdate") (var "fields")) $+          Flows.pure $ inject H._Expression H._Expression_constructRecord $ record H._ConstructRecordExpression [+            H._ConstructRecordExpression_name>>: var "typeName",+            H._ConstructRecordExpression_fields>>: var "updates"],+      _Term_set>>: lambda "s" $ lets [+        "lhs">: ref HaskellUtils.hsvarDef @@ string "S.fromList" ] $+        bind "rhs" (ref encodeTermDef @@ var "namespaces" @@ (inject _Term _Term_list $ Sets.toList $ var "s")) $+        Flows.pure $ ref HaskellUtils.hsappDef @@ var "lhs" @@ var "rhs",+      _Term_typeLambda>>: lambda "abs" $ lets [+        "term1">: Core.typeLambdaBody $ var "abs"] $+        var "encode" @@ var "term1",+      _Term_typeApplication>>: lambda "typed" $ lets [+        "term1">: Core.typedTermTerm $ var "typed"] $+        var "encode" @@ var "term1",+      _Term_union>>: lambda "injection" $ lets [+        "sname">: Core.injectionTypeName $ var "injection",+        "field">: Core.injectionField $ var "injection",+        "fn">: Core.fieldName $ var "field",+        "ft">: Core.fieldTerm $ var "field",+        "lhs">: inject H._Expression H._Expression_variable $ ref HaskellUtils.unionFieldReferenceDef @@ var "namespaces" @@ var "sname" @@ var "fn",+        "dflt">: Flows.map (ref HaskellUtils.hsappDef @@ var "lhs") (var "encode" @@ var "ft")] $+        cases _Term (ref Rewriting.deannotateTermDef @@ var "ft")+          (Just $ var "dflt") [+          _Term_unit>>: constant $ Flows.pure $ var "lhs"],+      _Term_unit>>: constant $ Flows.pure $ inject H._Expression H._Expression_tuple $ list [],+      _Term_variable>>: lambda "name" $+        Flows.pure $ inject H._Expression H._Expression_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "name",+      _Term_wrap>>: lambda "wrapped" $ lets [+        "tname">: Core.wrappedTermTypeName $ var "wrapped",+        "term'">: Core.wrappedTermObject $ var "wrapped",+        "lhs">: inject H._Expression H._Expression_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "tname"] $+        bind "rhs" (var "encode" @@ var "term'") $+        Flows.pure $ ref HaskellUtils.hsappDef @@ var "lhs" @@ var "rhs"]++encodeTypeDef :: TBinding (HaskellNamespaces -> Type -> Flow Graph H.Type)+encodeTypeDef = haskellCoderDefinition "encodeType" $+  lambda "namespaces" $+  lambda "typ" $ lets [+  "encode">: ref encodeTypeDef @@ var "namespaces",+  "ref">: lambda "name" $+    Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "name",+  "unitTuple">: inject H._Type H._Type_tuple $ list []] $+  trace "encode type" $+  cases _Type (ref Rewriting.deannotateTypeDef @@ var "typ")+    (Just $ Flows.fail $ Strings.cat2 (string "unexpected type: ") (ref ShowCore.typeDef @@ var "typ")) [+    _Type_application>>: lambda "app" $ lets [+      "lhs">: Core.applicationTypeFunction $ var "app",+      "rhs">: Core.applicationTypeArgument $ var "app"] $+      Flows.bind (var "encode" @@ var "lhs") $ lambda "hlhs" $+        Flows.bind (var "encode" @@ var "rhs") $ lambda "hrhs" $+          Flows.pure $ ref HaskellUtils.toTypeApplicationDef @@ list [var "hlhs", var "hrhs"],+    _Type_function>>: lambda "funType" $ lets [+      "dom">: Core.functionTypeDomain $ var "funType",+      "cod">: Core.functionTypeCodomain $ var "funType"] $+      Flows.bind (var "encode" @@ var "dom") $ lambda "hdom" $+        Flows.bind (var "encode" @@ var "cod") $ lambda "hcod" $+          Flows.pure $ inject H._Type H._Type_function $ record H._FunctionType [+            H._FunctionType_domain>>: var "hdom",+            H._FunctionType_codomain>>: var "hcod"],+    _Type_forall>>: lambda "forallType" $ lets [+      "v">: Core.forallTypeParameter $ var "forallType",+      "body">: Core.forallTypeBody $ var "forallType"] $+      var "encode" @@ var "body",+    _Type_list>>: lambda "lt" $+      Flows.bind (var "encode" @@ var "lt") $ lambda "hlt" $+        Flows.pure $ inject H._Type H._Type_list $ var "hlt",+    _Type_literal>>: lambda "lt" $+      cases _LiteralType (var "lt")+        (Just $ Flows.fail $ Strings.cat2 (string "unexpected literal type: ") (ref ShowCore.literalTypeDef @@ var "lt")) [+        _LiteralType_boolean>>: constant $+          Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Bool",+        _LiteralType_float>>: lambda "ft" $+          cases _FloatType (var "ft") Nothing [+            _FloatType_float32>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Float",+            _FloatType_float64>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Double",+            _FloatType_bigfloat>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Double"],+        _LiteralType_integer>>: lambda "it" $+          cases _IntegerType (var "it")+            (Just $ Flows.fail $ Strings.cat2 (string "unexpected integer type: ") (ref ShowCore.integerTypeDef @@ var "it")) [+            _IntegerType_bigint>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Integer",+            _IntegerType_int8>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "I.Int8",+            _IntegerType_int16>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "I.Int16",+            _IntegerType_int32>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Int",+            _IntegerType_int64>>: constant $+              Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "I.Int64"],+        _LiteralType_string>>: constant $+          Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "String"],+    _Type_map>>: lambda "mapType" $ lets [+      "kt">: Core.mapTypeKeys $ var "mapType",+      "vt">: Core.mapTypeValues $ var "mapType"] $+      Flows.map+        (ref HaskellUtils.toTypeApplicationDef)+        (Flows.sequence $ list [+          Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "M.Map",+          var "encode" @@ var "kt",+          var "encode" @@ var "vt"]),+    _Type_optional>>: lambda "ot" $+      Flows.map+        (ref HaskellUtils.toTypeApplicationDef)+        (Flows.sequence $ list [+          Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "Maybe",+          var "encode" @@ var "ot"]),+    _Type_product>>: lambda "types" $+      Flows.bind (Flows.mapList (var "encode") (var "types")) $ lambda "htypes" $+        Flows.pure $ inject H._Type H._Type_tuple $ var "htypes",+    _Type_record>>: lambda "rt" $ var "ref" @@ (Core.rowTypeTypeName $ var "rt"),+    _Type_set>>: lambda "st" $+      Flows.map+        (ref HaskellUtils.toTypeApplicationDef)+        (Flows.sequence $ list [+          Flows.pure $ inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ string "S.Set",+          var "encode" @@ var "st"]),+    _Type_union>>: lambda "rt" $ lets [+      "typeName">: Core.rowTypeTypeName $ var "rt"] $+      var "ref" @@ var "typeName",+    _Type_unit>>: constant $ Flows.pure $ var "unitTuple",+    _Type_variable>>: lambda "v1" $ var "ref" @@ var "v1",+    _Type_wrap>>: lambda "wrapped" $ lets [+      "name">: Core.wrappedTypeTypeName $ var "wrapped"] $+      var "ref" @@ var "name"]++encodeTypeWithClassAssertionsDef :: TBinding (HaskellNamespaces -> M.Map Name (S.Set TypeClass) -> Type -> Flow Graph H.Type)+encodeTypeWithClassAssertionsDef = haskellCoderDefinition "encodeTypeWithClassAssertions" $+  lambda "namespaces" $ lambda "explicitClasses" $ lambda "typ" $ lets [+    "classes">: Maps.union (var "explicitClasses") (ref getImplicitTypeClassesDef @@ var "typ"),+    "implicitClasses">: ref getImplicitTypeClassesDef @@ var "typ",+    "encodeAssertion">: lambda "pair" $ lets [+      "name">: first $ var "pair",+      "cls">: second $ var "pair",+      "hname">: ref HaskellUtils.rawNameDef @@ cases _TypeClass (var "cls") Nothing [+        _TypeClass_equality>>: constant $ string "Eq",+        _TypeClass_ordering>>: constant $ string "Ord"],+      "htype">: inject H._Type H._Type_variable $ ref HaskellUtils.rawNameDef @@ (Core.unName $ var "name")] $+      inject H._Assertion H._Assertion_class $ record H._ClassAssertion [+        H._ClassAssertion_name>>: var "hname",+        H._ClassAssertion_types>>: list [var "htype"]],+    "assertPairs">: Lists.concat $ Lists.map (var "toPairs") (Maps.toList $ var "classes"),+    "toPairs">: lambda "mapEntry" $ lets [+      "name">: first $ var "mapEntry",+      "clsSet">: second $ var "mapEntry",+      "toPair">: lambda "c" $+        pair (var "name") (var "c")] $+      Lists.map (var "toPair") (Sets.toList $ var "clsSet")] $+    ref Monads.withTraceDef @@ (string "encode with assertions") @@+      (bind "htyp" (ref adaptTypeToHaskellAndEncodeDef @@ var "namespaces" @@ var "typ") $+      Logic.ifElse (Lists.null $ var "assertPairs")+        (Flows.pure $ var "htyp") (lets [+          "encoded">: Lists.map (var "encodeAssertion") (var "assertPairs"),+          "hassert">: Logic.ifElse (Equality.gt (Lists.length $ var "encoded") (int32 1))+            (Lists.head $ var "encoded")+            (inject H._Assertion H._Assertion_tuple $ var "encoded")] $+          Flows.pure $ inject H._Type H._Type_ctx $ record H._ContextType [+            H._ContextType_ctx>>: var "hassert",+            H._ContextType_type>>: var "htyp"]))++findOrdVariablesDef :: TBinding (Type -> S.Set Name)+findOrdVariablesDef = haskellCoderDefinition "findOrdVariables" $+  lambda "typ" $ lets [+    "fold">: lambda "names" $ lambda "typ'" $+      cases _Type (var "typ'")+        (Just $ var "names") [+        _Type_map>>: lambda "mapType" $ lets [+          "kt">: Core.mapTypeKeys $ var "mapType"] $+          var "tryType" @@ var "names" @@ var "kt",+        _Type_set>>: lambda "et" $+          var "tryType" @@ var "names" @@ var "et"],+    "isTypeVariable">: lambda "v" $ lets [+      "nameStr">: Core.unName $ var "v",+      "hasNoNamespace">: Optionals.isNothing $ ref Names.namespaceOfDef @@ var "v",+      "startsWithT">: Equality.equal (Strings.charAt (int32 0) (var "nameStr")) (int32 116)] $ -- 't' character+      Logic.and (var "hasNoNamespace") (var "startsWithT"),+    "tryType">: lambda "names" $ lambda "t" $+      cases _Type (ref Rewriting.deannotateTypeDef @@ var "t")+        (Just $ var "names") [+        _Type_variable>>: lambda "v" $+          Logic.ifElse (var "isTypeVariable" @@ var "v")+            (Sets.insert (var "v") (var "names"))+            (var "names")]] $+    ref Rewriting.foldOverTypeDef @@ Coders.traversalOrderPre @@ var "fold" @@ Sets.empty @@ var "typ"++getImplicitTypeClassesDef :: TBinding (Type -> M.Map Name (S.Set TypeClass))+getImplicitTypeClassesDef = haskellCoderDefinition "getImplicitTypeClasses" $+  lambda "typ" $ lets [+    "toPair">: lambda "name" $+      pair (var "name") (Sets.fromList $ list [Graph.typeClassOrdering])] $+    Maps.fromList $ Lists.map (var "toPair") (Sets.toList $ ref findOrdVariablesDef @@ var "typ")++moduleToHaskellModuleDef :: TBinding (Module -> Flow Graph H.Module)+moduleToHaskellModuleDef = haskellCoderDefinition "moduleToHaskellModule" $+  lambda "mod" $+    bind "namespaces" (ref HaskellUtils.namespacesForModuleDef @@ var "mod") $+      ref AdaptModules.transformModuleDef @@ (ref HaskellLanguage.haskellLanguageDef) @@ (ref encodeTermDef @@ var "namespaces") @@ (ref constructModuleDef @@ var "namespaces") @@ var "mod"++moduleToHaskellDef :: TBinding (Module -> Flow Graph (M.Map String String))+moduleToHaskellDef = haskellCoderDefinition "moduleToHaskell" $ lambda "mod" $+  bind "hsmod" (ref moduleToHaskellModuleDef @@ var "mod") $ lets [+  "s">: ref Serialization.printExprDef @@ (ref Serialization.parenthesizeDef @@ (ref HaskellSerde.moduleToExprDef @@ var "hsmod")),+  "filepath">: ref Names.namespaceToFilePathDef @@ Mantle.caseConventionPascal @@ (wrap _FileExtension $ string "hs") @@ (Module.moduleNamespace $ var "mod")] $+  Flows.pure $ Maps.singleton (var "filepath") (var "s")++nameDeclsDef :: TBinding (Graph -> HaskellNamespaces -> Name -> Type -> [H.DeclarationWithComments])+nameDeclsDef = haskellCoderDefinition "nameDecls" $+  lambda "g" $ lambda "namespaces" $ lambda "name" $ lambda "typ" $ lets [+    "nm">: Core.unName $ var "name",+    "toDecl">: lambda "n" $ lambda "pair" $ lets [+      "k">: first $ var "pair",+      "v">: second $ var "pair",+      "decl">: inject H._Declaration H._Declaration_valueBinding $ inject H._ValueBinding H._ValueBinding_simple $ record H._SimpleValueBinding [+        H._SimpleValueBinding_pattern>>: ref HaskellUtils.applicationPatternDef @@ (ref HaskellUtils.simpleNameDef @@ var "k") @@ list [],+        H._SimpleValueBinding_rhs>>: wrap H._RightHandSide $ inject H._Expression H._Expression_application $ record H._ApplicationExpression [+          H._ApplicationExpression_function>>: inject H._Expression H._Expression_variable $ ref HaskellUtils.elementReferenceDef @@ var "namespaces" @@ var "n",+          H._ApplicationExpression_argument>>: inject H._Expression H._Expression_literal $ inject H._Literal H._Literal_string $ var "v"],+        H._SimpleValueBinding_localBindings>>: nothing]] $+      record H._DeclarationWithComments [+        H._DeclarationWithComments_body>>: var "decl",+        H._DeclarationWithComments_comments>>: nothing],+    "nameDecl">: pair (ref constantForTypeNameDef @@ var "name") (var "nm"),+    "fieldDecls">: Lists.map (var "toConstant") (ref Lexical.fieldsOfDef @@ var "typ"),+    "toConstant">: lambda "fieldType" $ lets [+      "fname">: Core.fieldTypeName $ var "fieldType"] $+      pair (ref constantForFieldNameDef @@ var "name" @@ var "fname") (Core.unName $ var "fname")] $+    Logic.ifElse (ref useCoreImportDef)+      (Lists.cons (var "toDecl" @@ Core.nameLift _Name @@ var "nameDecl") (Lists.map (var "toDecl" @@ Core.nameLift _Name) (var "fieldDecls")))+      (list [])++toDataDeclarationDef :: TBinding (M.Map Type (Coder Graph Graph Term H.Expression) -> HaskellNamespaces -> (Binding, TypedTerm) -> Flow Graph H.DeclarationWithComments)+toDataDeclarationDef = haskellCoderDefinition "toDataDeclaration" $+  lambdas ["coders", "namespaces", "pair"] $ lets [+    "el">: first $ var "pair",+    "tt">: second $ var "pair",+    "term">: Core.typedTermTerm $ var "tt",+    "typ">: Core.typedTermType $ var "tt",+    "coder">: Optionals.fromJust $ Maps.lookup (var "typ") (var "coders"),+    "hname">: ref HaskellUtils.simpleNameDef @@ (ref Names.localNameOfDef @@ (Core.bindingName $ var "el")),+    "rewriteValueBinding">: lambda "vb" $+      cases H._ValueBinding (var "vb") Nothing [+        H._ValueBinding_simple>>: lambda "simple" $ lets [+          "pattern'">: project H._SimpleValueBinding H._SimpleValueBinding_pattern @@ var "simple",+          "rhs">: project H._SimpleValueBinding H._SimpleValueBinding_rhs @@ var "simple",+          "bindings">: project H._SimpleValueBinding H._SimpleValueBinding_localBindings @@ var "simple"] $+          cases H._Pattern (var "pattern'")+            (Just $ var "vb") [+            H._Pattern_application>>: lambda "appPat" $ lets [+              "name'">: project H._ApplicationPattern H._ApplicationPattern_name @@ var "appPat",+              "args">: project H._ApplicationPattern H._ApplicationPattern_args @@ var "appPat",+              "rhsExpr">: unwrap H._RightHandSide @@ var "rhs"] $+              cases H._Expression (var "rhsExpr")+                (Just $ var "vb") [+                H._Expression_lambda>>: lambda "lambda'" $ lets [+                  "vars">: project H._LambdaExpression H._LambdaExpression_bindings @@ var "lambda'",+                  "body">: project H._LambdaExpression H._LambdaExpression_inner @@ var "lambda'",+                  "newPattern">: ref HaskellUtils.applicationPatternDef @@ var "name'" @@ (Lists.concat2 (var "args") (var "vars")),+                  "newRhs">: wrap H._RightHandSide $ var "body"] $+                  var "rewriteValueBinding" @@ (inject H._ValueBinding H._ValueBinding_simple $ record H._SimpleValueBinding [+                    H._SimpleValueBinding_pattern>>: var "newPattern",+                    H._SimpleValueBinding_rhs>>: var "newRhs",+                    H._SimpleValueBinding_localBindings>>: var "bindings"])]]],+    "toDecl">: lambda "comments" $ lambda "hname'" $ lambda "term'" $ lambda "coder'" $ lambda "bindings" $+      cases _Term (ref Rewriting.deannotateTermDef @@ var "term'")+        (Just $+          bind "hterm" (Compute.coderEncode (var "coder'") @@ (var "term'")) $ lets [+         "vb">: ref HaskellUtils.simpleValueBindingDef @@ var "hname'" @@ var "hterm" @@ var "bindings"] $+         bind "explicitClasses" (ref Annotations.getTypeClassesDef @@ (ref Rewriting.removeTypesFromTermDef @@ (Core.bindingTerm $ var "el"))) $+         bind "htype" (ref encodeTypeWithClassAssertionsDef @@ var "namespaces" @@ var "explicitClasses" @@ var "typ") $ lets [+         "decl">: inject H._Declaration H._Declaration_typedBinding $ record H._TypedBinding [+           H._TypedBinding_typeSignature>>: record H._TypeSignature [+             H._TypeSignature_name>>: var "hname'",+             H._TypeSignature_type>>: var "htype"],+           H._TypedBinding_valueBinding>>: var "rewriteValueBinding" @@ var "vb"]] $+          Flows.pure $ record H._DeclarationWithComments [+            H._DeclarationWithComments_body>>: var "decl",+            H._DeclarationWithComments_comments>>: var "comments"]) [+        _Term_let>>: lambda "letTerm" $ lets [+          -- A "let" constant cannot be predicted in advance, so we construct a coder on the fly.+          -- This makes program code with "let" terms more expensive to transform than simple data.+          "lbindings">: Core.letBindings $ var "letTerm",+          "env">: Core.letEnvironment $ var "letTerm",+          "toBinding">: lambda "hname''" $ lambda "hterm'" $+            inject H._LocalBinding H._LocalBinding_value $ ref HaskellUtils.simpleValueBindingDef @@ var "hname''" @@ var "hterm'" @@ nothing,+          "ts">: Lists.map (lambda "binding" $ Core.typeSchemeType $ Optionals.fromJust $ Core.bindingType $ var "binding") (var "lbindings")] $+          bind "coders'" (Flows.mapList (lambda "t" $ ref AdaptModules.constructCoderDef @@ (ref HaskellLanguage.haskellLanguageDef) @@ (ref encodeTermDef @@ var "namespaces") @@ var "t") (var "ts")) $ lets [+          "hnames">: Lists.map (lambda "binding" $ ref HaskellUtils.simpleNameDef @@ (Core.unName $ Core.bindingName $ var "binding")) (var "lbindings"),+          "terms">: Lists.map (unaryFunction $ Core.bindingTerm) (var "lbindings")] $+          bind "hterms" (Flows.sequence $ Lists.zipWith (lambdas ["e", "t"] $ Compute.coderEncode (var "e") @@ var "t") (var "coders'") (var "terms")) $ lets [+          "hbindings">: Lists.zipWith (var "toBinding") (var "hnames") (var "hterms")] $+          var "toDecl" @@ var "comments" @@ var "hname'" @@ var "env" @@ var "coder'" @@ (just $ wrap H._LocalBindings $ var "hbindings")]] $+    bind "comments" (ref Annotations.getTermDescriptionDef @@ var "term") $+    var "toDecl" @@ var "comments" @@ var "hname" @@ var "term" @@ var "coder" @@ nothing++toTypeDeclarationsDef :: TBinding (HaskellNamespaces -> Binding -> Term -> Flow Graph [H.DeclarationWithComments])+toTypeDeclarationsDef = haskellCoderDefinition "toTypeDeclarations" $+  lambda "namespaces" $ lambda "el" $ lambda "term" $ lets [+    "elementName">: Core.bindingName $ var "el",+    "lname">: ref Names.localNameOfDef @@ var "elementName",+    "hname">: ref HaskellUtils.simpleNameDef @@ var "lname",+    "declHead">: lambdas ["name", "vars'"] $ Logic.ifElse (Lists.null $ var "vars'")+      (inject H._DeclarationHead H._DeclarationHead_simple $ var "name")+      (lets [+        "h">: Lists.head $ var "vars'",+        "rest">: Lists.tail $ var "vars'",+        "hvar">: wrap H._Variable $ ref HaskellUtils.simpleNameDef @@ (Core.unName $ var "h")] $+        inject H._DeclarationHead H._DeclarationHead_application $ record H._ApplicationDeclarationHead [+          H._ApplicationDeclarationHead_function>>: var "declHead" @@ var "name" @@ var "rest",+          H._ApplicationDeclarationHead_operand>>: var "hvar"]),+    "newtypeCons">: lambda "el'" $ lambda "typ'" $ lets [+      "hname">: ref HaskellUtils.simpleNameDef @@ (ref HaskellUtils.newtypeAccessorNameDef @@ (Core.bindingName $ var "el'"))] $+      bind "htype" (ref adaptTypeToHaskellAndEncodeDef @@ var "namespaces" @@ var "typ'") $ lets [+      "hfield">: record H._FieldWithComments [+        H._FieldWithComments_field>>: record H._Field [+          H._Field_name>>: var "hname",+          H._Field_type>>: var "htype"],+        H._FieldWithComments_comments>>: nothing],+      "constructorName">: ref HaskellUtils.simpleNameDef @@ (ref Names.localNameOfDef @@ (Core.bindingName $ var "el'"))] $+      Flows.pure $ record H._ConstructorWithComments [+        H._ConstructorWithComments_body>>: inject H._Constructor H._Constructor_record $ record H._RecordConstructor [+          H._RecordConstructor_name>>: var "constructorName",+          H._RecordConstructor_fields>>: list [var "hfield"]],+        H._ConstructorWithComments_comments>>: nothing],+    "recordCons">: lambda "lname'" $ lambda "fields" $ lets [+      "toField">: lambda "fieldType" $ lets [+        "fname">: Core.fieldTypeName $ var "fieldType",+        "ftype">: Core.fieldTypeType $ var "fieldType",+        "hname'">: ref HaskellUtils.simpleNameDef @@ Strings.cat2+          (ref Formatting.decapitalizeDef @@ var "lname'")+          (ref Formatting.capitalizeDef @@ (Core.unName $ var "fname"))] $+        bind "htype" (ref adaptTypeToHaskellAndEncodeDef @@ var "namespaces" @@ var "ftype") $+        bind "comments" (ref Annotations.getTypeDescriptionDef @@ var "ftype") $+        Flows.pure $ record H._FieldWithComments [+          H._FieldWithComments_field>>: record H._Field [+            H._Field_name>>: var "hname'",+            H._Field_type>>: var "htype"],+          H._FieldWithComments_comments>>: var "comments"]] $+      bind "hFields" (Flows.mapList (var "toField") (var "fields")) $+      Flows.pure $ record H._ConstructorWithComments [+        H._ConstructorWithComments_body>>: inject H._Constructor H._Constructor_record $ record H._RecordConstructor [+          H._RecordConstructor_name>>: ref HaskellUtils.simpleNameDef @@ var "lname'",+          H._RecordConstructor_fields>>: var "hFields"],+        H._ConstructorWithComments_comments>>: nothing],+    "unionCons">: lambda "g'" $ lambda "lname'" $ lambda "fieldType" $ lets [+      "fname">: Core.fieldTypeName $ var "fieldType",+      "ftype">: Core.fieldTypeType $ var "fieldType",+      "deconflict">: lambda "name" $ lets [+        "tname">: ref Names.unqualifyNameDef @@ record _QualifiedName [+          _QualifiedName_namespace>>: just $ first $ Module.namespacesFocus $ var "namespaces",+          _QualifiedName_local>>: var "name"]] $+        Logic.ifElse (Optionals.isJust $ Maps.lookup (var "tname") (Graph.graphElements $ var "g'"))+          (var "deconflict" @@ Strings.cat2 (var "name") (string "_"))+          (var "name")] $+      bind "comments" (ref Annotations.getTypeDescriptionDef @@ var "ftype") $ lets [+      "nm">: var "deconflict" @@ Strings.cat2 (ref Formatting.capitalizeDef @@ var "lname'") (ref Formatting.capitalizeDef @@ (Core.unName $ var "fname"))] $+      bind "typeList" (Logic.ifElse (Equality.equal (ref Rewriting.deannotateTypeDef @@ var "ftype") TTypes.unit)+        (Flows.pure $ list []) $+        Flows.bind (ref adaptTypeToHaskellAndEncodeDef @@ var "namespaces" @@ var "ftype") $ lambda "htype" $+          Flows.pure $ list [var "htype"]) $+      Flows.pure $ record H._ConstructorWithComments [+        H._ConstructorWithComments_body>>: inject H._Constructor H._Constructor_ordinary $ record H._OrdinaryConstructor [+          H._OrdinaryConstructor_name>>: ref HaskellUtils.simpleNameDef @@ var "nm",+          H._OrdinaryConstructor_fields>>: var "typeList"],+        H._ConstructorWithComments_comments>>: var "comments"]] $+    ref Monads.withTraceDef @@ (Strings.cat2 (string "type element ") (Core.unName $ var "elementName")) @@ (+      bind "g" (ref Monads.getStateDef) $+      bind "t" (ref DecodeCore.typeDef @@ var "term") $+      bind "isSer" (ref Schemas.isSerializableDef @@ var "el") $ lets [+      "deriv">: wrap H._Deriving $ Logic.ifElse (var "isSer")+        (Lists.map (ref HaskellUtils.rawNameDef) (list [string "Eq", string "Ord", string "Read", string "Show"]))+        (list []),+      "unpackResult">: ref HaskellUtils.unpackForallTypeDef @@ var "g" @@ var "t",+      "vars">: first $ var "unpackResult",+      "t'">: second $ var "unpackResult",+      "hd">: var "declHead" @@ var "hname" @@ (Lists.reverse $ var "vars")] $+      bind "decl" (cases _Type (ref Rewriting.deannotateTypeDef @@ var "t'")+        (Just $ bind "htype" (ref adaptTypeToHaskellAndEncodeDef @@ var "namespaces" @@ var "t") $+          Flows.pure $ inject H._Declaration H._Declaration_type $ record H._TypeDeclaration [+            H._TypeDeclaration_name>>: var "hd",+            H._TypeDeclaration_type>>: var "htype"]) [+        _Type_record>>: lambda "rt" $+          bind "cons" (var "recordCons" @@ var "lname" @@ (Core.rowTypeFields $ var "rt")) $+          Flows.pure $ inject H._Declaration H._Declaration_data $ record H._DataDeclaration [+            H._DataDeclaration_keyword>>: unitVariant H._DataOrNewtype H._DataOrNewtype_data,+            H._DataDeclaration_context>>: list [],+            H._DataDeclaration_head>>: var "hd",+            H._DataDeclaration_constructors>>: list [var "cons"],+            H._DataDeclaration_deriving>>: list [var "deriv"]],+        _Type_union>>: lambda "rt" $+          bind "cons" (Flows.mapList (var "unionCons" @@ var "g" @@ var "lname") (Core.rowTypeFields $ var "rt")) $+          Flows.pure $ inject H._Declaration H._Declaration_data $ record H._DataDeclaration [+            H._DataDeclaration_keyword>>: unitVariant H._DataOrNewtype H._DataOrNewtype_data,+            H._DataDeclaration_context>>: list [],+            H._DataDeclaration_head>>: var "hd",+            H._DataDeclaration_constructors>>: var "cons",+            H._DataDeclaration_deriving>>: list [var "deriv"]],+        _Type_wrap>>: lambda "wrapped" $ lets [+          "tname">: Core.wrappedTypeTypeName $ var "wrapped",+          "wt">: Core.wrappedTypeObject $ var "wrapped"] $+          bind "cons" (var "newtypeCons" @@ var "el" @@ var "wt") $+            Flows.pure $ inject H._Declaration H._Declaration_data $ record H._DataDeclaration [+              H._DataDeclaration_keyword>>: unitVariant H._DataOrNewtype H._DataOrNewtype_newtype,+              H._DataDeclaration_context>>: list [],+              H._DataDeclaration_head>>: var "hd",+              H._DataDeclaration_constructors>>: list [var "cons"],+              H._DataDeclaration_deriving>>: list [var "deriv"]]]) $+      bind "comments" (ref Annotations.getTermDescriptionDef @@ var "term") $+      bind "tdecls" (Logic.ifElse (ref includeTypeDefinitionsDef)+        (Flows.bind (ref typeDeclDef @@ var "namespaces" @@ var "elementName" @@ var "t") $ lambda "decl'" $+          Flows.pure $ list [var "decl'"])+        (Flows.pure $ list [])) $ lets [+      "mainDecl">: record H._DeclarationWithComments [+        H._DeclarationWithComments_body>>: var "decl",+        H._DeclarationWithComments_comments>>: var "comments"],+      "nameDecls'">: ref nameDeclsDef @@ var "g" @@ var "namespaces" @@ var "elementName" @@ var "t"] $+      Flows.pure $ Lists.concat $ list [list [var "mainDecl"], var "nameDecls'", var "tdecls"])++typeDeclDef :: TBinding (HaskellNamespaces -> Name -> Type -> Flow Graph H.DeclarationWithComments)+typeDeclDef = haskellCoderDefinition "typeDecl" $+  lambda "namespaces" $ lambda "name" $ lambda "typ" $ lets [+    "typeName">: lambda "ns" $ lambda "name'" $+      ref Names.qnameDef @@ var "ns" @@ (var "typeNameLocal" @@ var "name'"),+    "typeNameLocal">: lambda "name'" $+      Strings.cat $ list [string "_", ref Names.localNameOfDef @@ var "name'", string "_type_"],+    "rawTerm">: ref EncodeCore.typeDef @@ var "typ",+    "rewrite">: lambda "recurse" $ lambda "term" $ lets [+      "variantResult">: ref Decoding.variantDef @@ Core.nameLift _Type @@ var "term",+      "forType">: lambda "field" $ lets [+        "fname">: Core.fieldName $ var "field",+        "fterm">: Core.fieldTerm $ var "field"] $+        Logic.ifElse (Equality.equal (var "fname") $ Core.nameLift _Type_record)+          nothing+          (Logic.ifElse (Equality.equal (var "fname") $ Core.nameLift _Type_variable)+            (Optionals.bind (ref Decoding.nameDef @@ var "fterm") (var "forVariableType"))+            nothing),+      "forVariableType">: lambda "name''" $ lets [+        "qname">: ref Names.qualifyNameDef @@ var "name''",+        "mns">: Module.qualifiedNameNamespace $ var "qname",+        "local">: Module.qualifiedNameLocal $ var "qname"] $+        Optionals.map (lambda "ns" $ Core.termVariable $ ref Names.qnameDef @@ var "ns" @@ (Strings.cat $ list [string "_", var "local", string "_type_"])) (var "mns")] $+      Optionals.fromMaybe (var "recurse" @@ var "term") (Optionals.bind (var "variantResult") (var "forType")),+    "finalTerm">: ref Rewriting.rewriteTermDef @@ var "rewrite" @@ var "rawTerm"] $+    -- Note: consider constructing this coder just once, then reusing it+    bind "coder" (ref AdaptModules.constructCoderDef @@ (ref HaskellLanguage.haskellLanguageDef) @@ (ref encodeTermDef @@ var "namespaces") @@ (Core.typeVariable $ Core.nameLift _Type)) $+    bind "expr" (Compute.coderEncode (var "coder") @@ var "finalTerm") $ lets [+    "rhs">: wrap H._RightHandSide $ var "expr",+    "hname">: ref HaskellUtils.simpleNameDef @@ (var "typeNameLocal" @@ var "name"),+    "pat">: ref HaskellUtils.applicationPatternDef @@ var "hname" @@ list [],+    "decl">: inject H._Declaration H._Declaration_valueBinding $ inject H._ValueBinding H._ValueBinding_simple $ record H._SimpleValueBinding [+      H._SimpleValueBinding_pattern>>: var "pat",+      H._SimpleValueBinding_rhs>>: var "rhs",+      H._SimpleValueBinding_localBindings>>: nothing]] $+    Flows.pure $ record H._DeclarationWithComments [+      H._DeclarationWithComments_body>>: var "decl",+      H._DeclarationWithComments_comments>>: nothing]
+ src/main/haskell/Hydra/Sources/Haskell/Language.hs view
@@ -0,0 +1,179 @@+module Hydra.Sources.Haskell.Language where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y+++haskellLanguageDefinition :: String -> TTerm a -> TBinding a+haskellLanguageDefinition = definitionInModule haskellLanguageModule++haskellLanguageModule :: Module+haskellLanguageModule = Module (Namespace "hydra.ext.haskell.language")+  [el haskellLanguageDef, el reservedWordsDef]+  []+  KernelTypes.kernelTypesModules $+  Just "Language constraints and reserved words for Haskell"++haskellLanguageDef :: TBinding Language+haskellLanguageDef = haskellLanguageDefinition "haskellLanguage" $+  doc "Language constraints for Haskell" $ lets [+  "eliminationVariants">: Sets.fromList $ list [+    Mantle.eliminationVariantProduct,+    Mantle.eliminationVariantRecord,+    Mantle.eliminationVariantUnion,+    Mantle.eliminationVariantWrap],+  "literalVariants">: Sets.fromList $ list [+    Mantle.literalVariantBoolean,+    Mantle.literalVariantFloat,+    Mantle.literalVariantInteger,+    Mantle.literalVariantString],+  "floatTypes">: Sets.fromList $ list [+    -- Bigfloat is excluded for now+    Core.floatTypeFloat32, -- Float+    Core.floatTypeFloat64], -- Double+  "functionVariants">: Sets.fromList $ list [+    Mantle.functionVariantElimination,+    Mantle.functionVariantLambda,+    Mantle.functionVariantPrimitive],+  "integerTypes">: Sets.fromList $ list [+    Core.integerTypeBigint, -- Integer+    Core.integerTypeInt8, -- Int8+    Core.integerTypeInt16, -- Int16+    Core.integerTypeInt32, -- Int+    Core.integerTypeInt64], -- Int64+  "termVariants">: Sets.fromList $ list [+    Mantle.termVariantApplication,+    Mantle.termVariantFunction,+    Mantle.termVariantLet,+    Mantle.termVariantList,+    Mantle.termVariantLiteral,+    Mantle.termVariantMap,+    Mantle.termVariantOptional,+    Mantle.termVariantProduct,+    Mantle.termVariantRecord,+    Mantle.termVariantSet,+    Mantle.termVariantUnion,+    Mantle.termVariantUnit,+    Mantle.termVariantVariable,+    Mantle.termVariantWrap],+  "typeVariants">: Sets.fromList $ list [+    Mantle.typeVariantAnnotated,+    Mantle.typeVariantApplication,+    Mantle.typeVariantFunction,+    Mantle.typeVariantForall,+    Mantle.typeVariantList,+    Mantle.typeVariantLiteral,+    Mantle.typeVariantMap,+    Mantle.typeVariantOptional,+    Mantle.typeVariantProduct,+    Mantle.typeVariantRecord,+    Mantle.typeVariantSet,+    Mantle.typeVariantUnion,+    Mantle.typeVariantUnit,+    Mantle.typeVariantVariable,+    Mantle.typeVariantWrap],+  "typePredicate">: constant true] $+  Coders.language+    (Coders.languageName $ string "hydra.ext.haskell")+    (Coders.languageConstraints+      (var "eliminationVariants")+      (var "literalVariants")+      (var "floatTypes")+      (var "functionVariants")+      (var "integerTypes")+      (var "termVariants")+      (var "typeVariants")+      (var "typePredicate"))++reservedWordsDef :: TBinding (S.Set String)+reservedWordsDef = haskellLanguageDefinition "reservedWords" $+  doc ("Created on 2025-02-28 using GHCi 9.6.6\n\n"+    <> "You can reproduce these lists of symbols by issuing the command `:browse Prelude` in GHCi, pasting the results into\n"+    <> "/tmp/browse_Prelude.txt, and then running the Bash command provided with each list.\n\n"+    <> "See also https://www.haskell.org/onlinereport/standard-prelude.html") $+  lets [+    "keywordSymbols">:+      doc "Haskell's strictly reserved keywords; they cannot be used as identifiers." $+      list $ string <$> [+        "case", "class", "data", "default", "deriving", "do", "else", "forall", "foreign", "if", "import", "in",+        "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where"],+    "reservedSymbols">:+      doc "Hydra uses these symbols in generated code, so we reserve them to avoid conflicts." $+      list $ string <$> [+        "Bool", "Double", "False", "Float", "Int", "Integer", "Just", "Maybe", "Nothing", "Ord", "Show", "String", "True"]]+    $ Sets.fromList $ Lists.concat2 (var "keywordSymbols") (var "reservedSymbols")
+ src/main/haskell/Hydra/Sources/Haskell/Operators.hs view
@@ -0,0 +1,277 @@+module Hydra.Sources.Haskell.Operators where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import Hydra.Ast+++haskellOperatorsDefinition :: String -> TTerm a -> TBinding a+haskellOperatorsDefinition = definitionInModule haskellOperatorsModule++haskellOperatorsModule :: Module+haskellOperatorsModule = Module ns elements+    [Serialization.module_]+    KernelTypes.kernelTypesModules $+    Just "AST operators for Haskell"+  where+    ns = Namespace "hydra.ext.haskell.operators"+    elements = [+      el andOpDef,+      el apOpDef,+      el appOpDef,+      el applyOpDef,+      el arrowOpDef,+      el assertOpDef,+      el bindOpDef,+      el caseOpDef,+      el composeOpDef,+      el concatOpDef,+      el consOpDef,+      el defineOpDef,+      el diamondOpDef,+      el divOpDef,+      el divideOpDef,+      el elemOpDef,+      el equalOpDef,+      el fmapOpDef,+      el gtOpDef,+      el gteOpDef,+      el indexOpDef,+      el lambdaOpDef,+      el ltOpDef,+      el lteOpDef,+      el minusOpDef,+      el modOpDef,+      el multOpDef,+      el neqOpDef,+      el notElemOpDef,+      el orOpDef,+      el plusOpDef,+      el quotOpDef,+      el remOpDef,+      el typeOpDef]++andOpDef :: TBinding Op+andOpDef = haskellOperatorsDefinition "andOp" $+  ref Serialization.opDef @@ string "&&" @@ int32 3 @@ Ast.associativityRight++apOpDef :: TBinding Op+apOpDef = haskellOperatorsDefinition "apOp" $+  ref Serialization.opDef @@ string "<*>" @@ int32 4 @@ Ast.associativityLeft++appOpDef :: TBinding Op+appOpDef = haskellOperatorsDefinition "appOp" $+  doc "No source" $+  Ast.op+    (Ast.symbol $ string "")+    (Ast.padding Ast.wsNone Ast.wsSpace)+    (Ast.precedence $ int32 0)+    Ast.associativityLeft++applyOpDef :: TBinding Op+applyOpDef = haskellOperatorsDefinition "applyOp" $+  ref Serialization.opDef @@ string "$" @@ int32 0 @@ Ast.associativityRight++arrowOpDef :: TBinding Op+arrowOpDef = haskellOperatorsDefinition "arrowOp" $+  ref Serialization.opDef @@ string "->" @@ (Math.neg $ int32 1) @@ Ast.associativityRight++assertOpDef :: TBinding Op+assertOpDef = haskellOperatorsDefinition "assertOp" $+  doc "No source" $+  ref Serialization.opDef @@ string "=>" @@ int32 0 @@ Ast.associativityNone++bindOpDef :: TBinding Op+bindOpDef = haskellOperatorsDefinition "bindOp" $+  ref Serialization.opDef @@ string ">>=" @@ int32 1 @@ Ast.associativityLeft++caseOpDef :: TBinding Op+caseOpDef = haskellOperatorsDefinition "caseOp" $+  doc "No source" $+  ref Serialization.opDef @@ string "->" @@ int32 0 @@ Ast.associativityNone++composeOpDef :: TBinding Op+composeOpDef = haskellOperatorsDefinition "composeOp" $+  ref Serialization.opDef @@ string "." @@ int32 9 @@ Ast.associativityLeft++concatOpDef :: TBinding Op+concatOpDef = haskellOperatorsDefinition "concatOp" $+  ref Serialization.opDef @@ string "++" @@ int32 5 @@ Ast.associativityRight++consOpDef :: TBinding Op+consOpDef = haskellOperatorsDefinition "consOp" $+  ref Serialization.opDef @@ string ":" @@ int32 5 @@ Ast.associativityRight++defineOpDef :: TBinding Op+defineOpDef = haskellOperatorsDefinition "defineOp" $+  doc "No source" $+  ref Serialization.opDef @@ string "=" @@ int32 0 @@ Ast.associativityNone++diamondOpDef :: TBinding Op+diamondOpDef = haskellOperatorsDefinition "diamondOp" $+  ref Serialization.opDef @@ string "<>" @@ int32 6 @@ Ast.associativityRight++divOpDef :: TBinding Op+divOpDef = haskellOperatorsDefinition "divOp" $+  ref Serialization.opDef @@ string "`div`" @@ int32 7 @@ Ast.associativityLeft++divideOpDef :: TBinding Op+divideOpDef = haskellOperatorsDefinition "divideOp" $+  ref Serialization.opDef @@ string "/" @@ int32 7 @@ Ast.associativityLeft++elemOpDef :: TBinding Op+elemOpDef = haskellOperatorsDefinition "elemOp" $+  ref Serialization.opDef @@ string "`elem`" @@ int32 4 @@ Ast.associativityNone++equalOpDef :: TBinding Op+equalOpDef = haskellOperatorsDefinition "equalOp" $+  ref Serialization.opDef @@ string "==" @@ int32 4 @@ Ast.associativityNone++fmapOpDef :: TBinding Op+fmapOpDef = haskellOperatorsDefinition "fmapOp" $+  ref Serialization.opDef @@ string "<$>" @@ int32 4 @@ Ast.associativityLeft++gtOpDef :: TBinding Op+gtOpDef = haskellOperatorsDefinition "gtOp" $+  ref Serialization.opDef @@ string ">" @@ int32 4 @@ Ast.associativityNone++gteOpDef :: TBinding Op+gteOpDef = haskellOperatorsDefinition "gteOp" $+  ref Serialization.opDef @@ string ">=" @@ int32 4 @@ Ast.associativityNone++indexOpDef :: TBinding Op+indexOpDef = haskellOperatorsDefinition "indexOp" $+  ref Serialization.opDef @@ string "!!" @@ int32 9 @@ Ast.associativityLeft++lambdaOpDef :: TBinding Op+lambdaOpDef = haskellOperatorsDefinition "lambdaOp" $+  doc "No source" $+  ref Serialization.opDef @@ string "->" @@ (Math.neg $ int32 1) @@ Ast.associativityRight++ltOpDef :: TBinding Op+ltOpDef = haskellOperatorsDefinition "ltOp" $+  ref Serialization.opDef @@ string "<" @@ int32 4 @@ Ast.associativityNone++lteOpDef :: TBinding Op+lteOpDef = haskellOperatorsDefinition "lteOp" $+  ref Serialization.opDef @@ string ">=" @@ int32 4 @@ Ast.associativityNone++minusOpDef :: TBinding Op+minusOpDef = haskellOperatorsDefinition "minusOp" $+  doc "Originally: associativityLeft" $+  ref Serialization.opDef @@ string "-" @@ int32 6 @@ Ast.associativityBoth++modOpDef :: TBinding Op+modOpDef = haskellOperatorsDefinition "modOp" $+  ref Serialization.opDef @@ string "`mod`" @@ int32 7 @@ Ast.associativityLeft++multOpDef :: TBinding Op+multOpDef = haskellOperatorsDefinition "multOp" $+  doc "Originally: associativityLeft" $+  ref Serialization.opDef @@ string "*" @@ int32 7 @@ Ast.associativityBoth++neqOpDef :: TBinding Op+neqOpDef = haskellOperatorsDefinition "neqOp" $+  ref Serialization.opDef @@ string "/=" @@ int32 4 @@ Ast.associativityNone++notElemOpDef :: TBinding Op+notElemOpDef = haskellOperatorsDefinition "notElemOp" $+  ref Serialization.opDef @@ string "`notElem`" @@ int32 4 @@ Ast.associativityNone++orOpDef :: TBinding Op+orOpDef = haskellOperatorsDefinition "orOp" $+  ref Serialization.opDef @@ string "||" @@ int32 2 @@ Ast.associativityRight++plusOpDef :: TBinding Op+plusOpDef = haskellOperatorsDefinition "plusOp" $+  doc "Originally: associativityLeft" $+  ref Serialization.opDef @@ string "+" @@ int32 6 @@ Ast.associativityBoth++quotOpDef :: TBinding Op+quotOpDef = haskellOperatorsDefinition "quotOp" $+  ref Serialization.opDef @@ string "`quot`" @@ int32 7 @@ Ast.associativityLeft++remOpDef :: TBinding Op+remOpDef = haskellOperatorsDefinition "remOp" $+  ref Serialization.opDef @@ string "`rem`" @@ int32 7 @@ Ast.associativityLeft++typeOpDef :: TBinding Op+typeOpDef = haskellOperatorsDefinition "typeOp" $+  doc "No source" $+  ref Serialization.opDef @@ string "::" @@ int32 0 @@ Ast.associativityNone
+ src/main/haskell/Hydra/Sources/Haskell/Serde.hs view
@@ -0,0 +1,560 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Haskell.Serde where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import Hydra.Ast++import qualified Hydra.Ext.Haskell.Ast as H+import qualified Hydra.Sources.Haskell.Ast as HaskellAst+import qualified Hydra.Sources.Haskell.Operators as Operators+++haskellSerdeDefinition :: String -> TTerm a -> TBinding a+haskellSerdeDefinition = definitionInModule haskellSerdeModule++haskellSerdeModule :: Module+haskellSerdeModule = Module ns elements+    [Serialization.module_, Operators.haskellOperatorsModule]+    (HaskellAst.haskellAstModule:KernelTypes.kernelTypesModules) $+    Just ("Haskell operator precendence and associativity are drawn from:\n"+      <> "https://self-learning-java-tutorial.blogspot.com/2016/04/haskell-operator-precedence.html\n"+      <> "Other operators were investigated using GHCi, e.g. \":info (->)\"\n"+      <> "Operator names are drawn (loosely) from:\n"+      <> "https://stackoverflow.com/questions/7746894/are-there-pronounceable-names-for-common-haskell-operators")+  where+    ns = Namespace "hydra.ext.haskell.serde"+    elements = [+      el alternativeToExprDef,+      el applicationExpressionToExprDef,+      el applicationPatternToExprDef,+      el assertionToExprDef,+      el caseExpressionToExprDef,+      el caseRhsToExprDef,+      el classAssertionToExprDef,+      el constructorToExprDef,+      el constructorWithCommentsToExprDef,+      el dataOrNewtypeToExprDef,+      el declarationHeadToExprDef,+      el declarationToExprDef,+      el declarationWithCommentsToExprDef,+      el expressionToExprDef,+      el constructRecordExpressionToExprDef,+      el fieldToExprDef,+      el fieldWithCommentsToExprDef,+      el ifExpressionToExprDef,+      el importExportSpecToExprDef,+      el importToExprDef,+      el lambdaExpressionToExprDef,+      el literalToExprDef,+      el localBindingToExprDef,+      el moduleHeadToExprDef,+      el moduleToExprDef,+      el nameToExprDef,+      el patternToExprDef,+      el rightHandSideToExprDef,+      el statementToExprDef,+      el typeSignatureToExprDef,+      el typeToExprDef,+      el valueBindingToExprDef,+      el variableToExprDef,+      el toHaskellCommentsDef,+      el writeQualifiedNameDef]++alternativeToExprDef :: TBinding (H.Alternative -> Expr)+alternativeToExprDef = haskellSerdeDefinition "alternativeToExpr" $+  lambda "alt" $ +    ref Serialization.ifxDef @@ ref Operators.caseOpDef @@+      (ref patternToExprDef @@ (project H._Alternative H._Alternative_pattern @@ var "alt")) @@+      (ref caseRhsToExprDef @@ (project H._Alternative H._Alternative_rhs @@ var "alt"))++applicationExpressionToExprDef :: TBinding (H.ApplicationExpression -> Expr)+applicationExpressionToExprDef = haskellSerdeDefinition "applicationExpressionToExpr" $+  lambda "app" $+    ref Serialization.ifxDef @@ ref Operators.appOpDef @@+      (ref expressionToExprDef @@ (project H._ApplicationExpression H._ApplicationExpression_function @@ var "app")) @@+      (ref expressionToExprDef @@ (project H._ApplicationExpression H._ApplicationExpression_argument @@ var "app"))++applicationPatternToExprDef :: TBinding (H.ApplicationPattern -> Expr)+applicationPatternToExprDef = haskellSerdeDefinition "applicationPatternToExpr" $+  lambda "appPat" $ lets [+            "name">: project H._ApplicationPattern H._ApplicationPattern_name @@ var "appPat",+    "pats">: project H._ApplicationPattern H._ApplicationPattern_args @@ var "appPat"] $+    ref Serialization.spaceSepDef @@ (Lists.cons (ref nameToExprDef @@ var "name") (Lists.map (ref patternToExprDef) (var "pats")))++assertionToExprDef :: TBinding (H.Assertion -> Expr)+assertionToExprDef = haskellSerdeDefinition "assertionToExpr" $+  lambda "sert" $+    cases H._Assertion (var "sert") Nothing [+      H._Assertion_class>>: lambda "cls" $ ref classAssertionToExprDef @@ var "cls",+      H._Assertion_tuple>>: lambda "serts" $+        ref Serialization.parenListDef @@ false @@ (Lists.map (ref assertionToExprDef) (var "serts"))]++caseExpressionToExprDef :: TBinding (H.CaseExpression -> Expr)+caseExpressionToExprDef = haskellSerdeDefinition "caseExpressionToExpr" $+  lambda "caseExpr" $ lets [+    "cs">: project H._CaseExpression H._CaseExpression_case @@ var "caseExpr",+    "alts">: project H._CaseExpression H._CaseExpression_alternatives @@ var "caseExpr",+    "ofOp">: Ast.op+      (Ast.symbol $ string "of")+      (Ast.padding Ast.wsSpace (Ast.wsBreakAndIndent $ string "  "))+      (Ast.precedence $ int32 0)+      Ast.associativityNone,+    "lhs">: ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "case", ref expressionToExprDef @@ var "cs"],+    "rhs">: ref Serialization.newlineSepDef @@ (Lists.map (ref alternativeToExprDef) (var "alts"))] $+    ref Serialization.ifxDef @@ var "ofOp" @@ var "lhs" @@ var "rhs"++caseRhsToExprDef :: TBinding (H.CaseRhs -> Expr)+caseRhsToExprDef = haskellSerdeDefinition "caseRhsToExpr" $+  lambda "rhs" $ ref expressionToExprDef @@ (unwrap H._CaseRhs @@ var "rhs")++classAssertionToExprDef :: TBinding (H.ClassAssertion -> Expr)+classAssertionToExprDef = haskellSerdeDefinition "classAssertionToExpr" $+  lambda "clsAsrt" $ lets [+    "name">: project H._ClassAssertion H._ClassAssertion_name @@ var "clsAsrt",+    "types">: project H._ClassAssertion H._ClassAssertion_types @@ var "clsAsrt"] $+    ref Serialization.spaceSepDef @@ list [+      ref nameToExprDef @@ var "name",+      ref Serialization.commaSepDef @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (ref typeToExprDef) (var "types"))]++constructorToExprDef :: TBinding (H.Constructor -> Expr)+constructorToExprDef = haskellSerdeDefinition "constructorToExpr" $+  lambda "cons" $+    cases H._Constructor (var "cons") Nothing [+      H._Constructor_ordinary>>: lambda "ord" $ lets [+        "name">: project H._OrdinaryConstructor H._OrdinaryConstructor_name @@ var "ord",+        "types">: project H._OrdinaryConstructor H._OrdinaryConstructor_fields @@ var "ord"] $+        ref Serialization.spaceSepDef @@ list [ref nameToExprDef @@ var "name", ref Serialization.spaceSepDef @@ (Lists.map (ref typeToExprDef) (var "types"))],+      H._Constructor_record>>: lambda "rec" $ lets [+        "name">: project H._RecordConstructor H._RecordConstructor_name @@ var "rec",+        "fields">: project H._RecordConstructor H._RecordConstructor_fields @@ var "rec"] $+        ref Serialization.spaceSepDef @@ list [+          ref nameToExprDef @@ var "name",+          ref Serialization.curlyBracesListDef @@ nothing @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (ref fieldWithCommentsToExprDef) (var "fields"))]]++constructorWithCommentsToExprDef :: TBinding (H.ConstructorWithComments -> Expr)+constructorWithCommentsToExprDef = haskellSerdeDefinition "constructorWithCommentsToExpr" $+  lambda "consWithComments" $ lets [+    "body">: project H._ConstructorWithComments H._ConstructorWithComments_body @@ var "consWithComments",+    "mc">: project H._ConstructorWithComments H._ConstructorWithComments_comments @@ var "consWithComments"] $+    Optionals.maybe+      (ref constructorToExprDef @@ var "body")+      (lambda "c" $ ref Serialization.newlineSepDef @@ list [+        ref Serialization.cstDef @@ (ref toHaskellCommentsDef @@ var "c"),+        ref constructorToExprDef @@ var "body"])+      (var "mc")++dataOrNewtypeToExprDef :: TBinding (H.DataOrNewtype -> Expr)+dataOrNewtypeToExprDef = haskellSerdeDefinition "dataOrNewtypeToExpr" $+  lambda "kw" $+    cases H._DataOrNewtype (var "kw") Nothing [+      H._DataOrNewtype_data>>: constant $ ref Serialization.cstDef @@ string "data",+      H._DataOrNewtype_newtype>>: constant $ ref Serialization.cstDef @@ string "newtype"]++declarationHeadToExprDef :: TBinding (H.DeclarationHead -> Expr)+declarationHeadToExprDef = haskellSerdeDefinition "declarationHeadToExpr" $+  lambda "hd" $+    cases H._DeclarationHead (var "hd") Nothing [+      H._DeclarationHead_application>>: lambda "appHead" $ lets [+        "fun">: project H._ApplicationDeclarationHead H._ApplicationDeclarationHead_function @@ var "appHead",+        "op">: project H._ApplicationDeclarationHead H._ApplicationDeclarationHead_operand @@ var "appHead"] $+        ref Serialization.spaceSepDef @@ list [ref declarationHeadToExprDef @@ var "fun", ref variableToExprDef @@ var "op"],+      H._DeclarationHead_simple>>: lambda "name" $ ref nameToExprDef @@ var "name"]++declarationToExprDef :: TBinding (H.Declaration -> Expr)+declarationToExprDef = haskellSerdeDefinition "declarationToExpr" $+  lambda "decl" $+    cases H._Declaration (var "decl") Nothing [+      H._Declaration_data>>: lambda "dataDecl" $ lets [+        "kw">: project H._DataDeclaration H._DataDeclaration_keyword @@ var "dataDecl",+        "hd">: project H._DataDeclaration H._DataDeclaration_head @@ var "dataDecl",+        "cons">: project H._DataDeclaration H._DataDeclaration_constructors @@ var "dataDecl",+        "deriv">: project H._DataDeclaration H._DataDeclaration_deriving @@ var "dataDecl",+        "derivCat">: Lists.concat $ Lists.map (unwrap H._Deriving) (var "deriv"),+        "constructors">: ref Serialization.orSepDef @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (ref constructorWithCommentsToExprDef) (var "cons")),+        "derivingClause">: Logic.ifElse (Lists.null $ var "derivCat")+          (list [])+          (list [ref Serialization.spaceSepDef @@ list [+            ref Serialization.cstDef @@ string "deriving",+            ref Serialization.parenListDef @@ false @@ (Lists.map (ref nameToExprDef) (var "derivCat"))]]),+        "mainParts">: list [+          ref Serialization.spaceSepDef @@ list [ref dataOrNewtypeToExprDef @@ var "kw", ref declarationHeadToExprDef @@ var "hd", ref Serialization.cstDef @@ string "="],+          var "constructors"]] $+        ref Serialization.indentBlockDef @@ Lists.concat2 (var "mainParts") (var "derivingClause"),+      H._Declaration_type>>: lambda "typeDecl" $ lets [+        "hd">: project H._TypeDeclaration H._TypeDeclaration_name @@ var "typeDecl",+        "typ">: project H._TypeDeclaration H._TypeDeclaration_type @@ var "typeDecl"] $+        ref Serialization.spaceSepDef @@ list [+          ref Serialization.cstDef @@ string "type",+          ref declarationHeadToExprDef @@ var "hd",+          ref Serialization.cstDef @@ string "=",+          ref typeToExprDef @@ var "typ"],+      H._Declaration_valueBinding>>: lambda "vb" $ ref valueBindingToExprDef @@ var "vb",+      H._Declaration_typedBinding>>: lambda "typedBinding" $ lets [+        "typeSig">: project H._TypedBinding H._TypedBinding_typeSignature @@ var "typedBinding",+        "vb">: project H._TypedBinding H._TypedBinding_valueBinding @@ var "typedBinding",+        "name">: project H._TypeSignature H._TypeSignature_name @@ var "typeSig",+        "htype">: project H._TypeSignature H._TypeSignature_type @@ var "typeSig"] $+        ref Serialization.newlineSepDef @@ list [+          ref Serialization.ifxDef @@ ref Operators.typeOpDef @@ (ref nameToExprDef @@ var "name") @@ (ref typeToExprDef @@ var "htype"),+          ref valueBindingToExprDef @@ var "vb"]]++declarationWithCommentsToExprDef :: TBinding (H.DeclarationWithComments -> Expr)+declarationWithCommentsToExprDef = haskellSerdeDefinition "declarationWithCommentsToExpr" $+  lambda "declWithComments" $ lets [+    "body">: project H._DeclarationWithComments H._DeclarationWithComments_body @@ var "declWithComments",+    "mc">: project H._DeclarationWithComments H._DeclarationWithComments_comments @@ var "declWithComments"] $+    Optionals.maybe+      (ref declarationToExprDef @@ var "body")+      (lambda "c" $ ref Serialization.newlineSepDef @@ list [+        ref Serialization.cstDef @@ (ref toHaskellCommentsDef @@ var "c"),+        ref declarationToExprDef @@ var "body"])+      (var "mc")++expressionToExprDef :: TBinding (H.Expression -> Expr)+expressionToExprDef = haskellSerdeDefinition "expressionToExpr" $+  lambda "expr" $+    cases H._Expression (var "expr") Nothing [+      H._Expression_application>>: lambda "app" $ ref applicationExpressionToExprDef @@ var "app",+      H._Expression_case>>: lambda "cases" $ ref caseExpressionToExprDef @@ var "cases",+      H._Expression_constructRecord>>: lambda "r" $ ref constructRecordExpressionToExprDef @@ var "r",+      H._Expression_do>>: lambda "statements" $+        ref Serialization.indentBlockDef @@ Lists.cons (ref Serialization.cstDef @@ string "do") (Lists.map (ref statementToExprDef) (var "statements")),+      H._Expression_if>>: lambda "ifte" $ ref ifExpressionToExprDef @@ var "ifte",+      H._Expression_literal>>: lambda "lit" $ ref literalToExprDef @@ var "lit",+      H._Expression_lambda>>: lambda "lam" $ ref Serialization.parenthesizeDef @@ (ref lambdaExpressionToExprDef @@ var "lam"),+      H._Expression_let>>: lambda "letExpr" $ lets [+        "bindings">: project H._LetExpression H._LetExpression_bindings @@ var "letExpr",+        "inner">: project H._LetExpression H._LetExpression_inner @@ var "letExpr",+        "encodeBinding">: lambda "binding" $+          ref Serialization.indentSubsequentLinesDef @@ string "      " @@ (ref localBindingToExprDef @@ var "binding")] $+        ref Serialization.indentBlockDef @@ list [+          ref Serialization.cstDef @@ string "",+          ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "let", ref Serialization.customIndentBlockDef @@ string "    " @@ (Lists.map (var "encodeBinding") (var "bindings"))],+          ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "in", ref expressionToExprDef @@ var "inner"]],+      H._Expression_list>>: lambda "exprs" $+        ref Serialization.bracketListDef @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (ref expressionToExprDef) (var "exprs")),+      H._Expression_parens>>: lambda "expr'" $ ref Serialization.parenthesizeDef @@ (ref expressionToExprDef @@ var "expr'"),+      H._Expression_tuple>>: lambda "exprs" $+        ref Serialization.parenListDef @@ false @@ (Lists.map (ref expressionToExprDef) (var "exprs")),+      H._Expression_variable>>: lambda "name" $ ref nameToExprDef @@ var "name"]++constructRecordExpressionToExprDef :: TBinding (H.ConstructRecordExpression -> Expr)+constructRecordExpressionToExprDef = haskellSerdeDefinition "constructRecordExpressionToExpr" $+  lambda "constructRecord" $ lets [+    "name">: project H._ConstructRecordExpression H._ConstructRecordExpression_name @@ var "constructRecord",+    "updates">: project H._ConstructRecordExpression H._ConstructRecordExpression_fields @@ var "constructRecord",+    "fromUpdate">: lambda "update" $ lets [+      "fn">: project H._FieldUpdate H._FieldUpdate_name @@ var "update",+      "val">: project H._FieldUpdate H._FieldUpdate_value @@ var "update"] $+      ref Serialization.ifxDef @@ ref Operators.defineOpDef @@ (ref nameToExprDef @@ var "fn") @@ (ref expressionToExprDef @@ var "val"),+    "body">: ref Serialization.commaSepDef @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (var "fromUpdate") (var "updates"))] $+    ref Serialization.spaceSepDef @@ list [+      ref nameToExprDef @@ var "name",+      ref Serialization.bracketsDef @@ ref Serialization.curlyBracesDef @@ ref Serialization.halfBlockStyleDef @@ var "body"]++fieldToExprDef :: TBinding (H.Field -> Expr)+fieldToExprDef = haskellSerdeDefinition "fieldToExpr" $+  lambda "field" $ lets [+    "name">: project H._Field H._Field_name @@ var "field",+    "typ">: project H._Field H._Field_type @@ var "field"] $+    ref Serialization.spaceSepDef @@ list [ref nameToExprDef @@ var "name", ref Serialization.cstDef @@ string "::", ref typeToExprDef @@ var "typ"]++fieldWithCommentsToExprDef :: TBinding (H.FieldWithComments -> Expr)+fieldWithCommentsToExprDef = haskellSerdeDefinition "fieldWithCommentsToExpr" $+  lambda "fieldWithComments" $ lets [+    "field">: project H._FieldWithComments H._FieldWithComments_field @@ var "fieldWithComments",+    "mc">: project H._FieldWithComments H._FieldWithComments_comments @@ var "fieldWithComments"] $+    Optionals.maybe+      (ref fieldToExprDef @@ var "field")+      (lambda "c" $ ref Serialization.newlineSepDef @@ list [+        ref Serialization.cstDef @@ (ref toHaskellCommentsDef @@ var "c"),+        ref fieldToExprDef @@ var "field"])+      (var "mc")++ifExpressionToExprDef :: TBinding (H.IfExpression -> Expr)+ifExpressionToExprDef = haskellSerdeDefinition "ifExpressionToExpr" $+  lambda "ifExpr" $ lets [+    "eif">: project H._IfExpression H._IfExpression_condition @@ var "ifExpr",+    "ethen">: project H._IfExpression H._IfExpression_then @@ var "ifExpr",+    "eelse">: project H._IfExpression H._IfExpression_else @@ var "ifExpr",+    "ifOp">: Ast.op+      (Ast.symbol $ string "")+      (Ast.padding Ast.wsNone (Ast.wsBreakAndIndent $ string "  "))+      (Ast.precedence $ int32 0)+      Ast.associativityNone,+    "body">: ref Serialization.newlineSepDef @@ list [+      ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "then", ref expressionToExprDef @@ var "ethen"],+      ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "else", ref expressionToExprDef @@ var "eelse"]]] $+    ref Serialization.ifxDef @@ var "ifOp" @@+      (ref Serialization.spaceSepDef @@ list [ref Serialization.cstDef @@ string "if", ref expressionToExprDef @@ var "eif"]) @@+      var "body"++importExportSpecToExprDef :: TBinding (H.ImportExportSpec -> Expr)+importExportSpecToExprDef = haskellSerdeDefinition "importExportSpecToExpr" $+  lambda "spec" $ ref nameToExprDef @@ (project H._ImportExportSpec H._ImportExportSpec_name @@ var "spec")++importToExprDef :: TBinding (H.Import -> Expr)+importToExprDef = haskellSerdeDefinition "importToExpr" $+  lambda "import" $ lets [+    "qual">: project H._Import H._Import_qualified @@ var "import",+    "modName">: project H._Import H._Import_module @@ var "import",+    "mod">: project H._Import H._Import_as @@ var "import",+    "mspec">: project H._Import H._Import_spec @@ var "import",+    "name">: unwrap H._ModuleName @@ var "modName",+    "hidingSec">: lambda "spec" $+      cases H._SpecImport (var "spec") Nothing [+        H._SpecImport_hiding>>: lambda "names" $+          ref Serialization.spaceSepDef @@ list [+            ref Serialization.cstDef @@ string "hiding ",+            ref Serialization.parensDef @@+              (ref Serialization.commaSepDef @@ ref Serialization.inlineStyleDef @@ (Lists.map (ref importExportSpecToExprDef) (var "names")))]],+    "parts">: Optionals.cat $ list [+      just $ ref Serialization.cstDef @@ string "import",+      Logic.ifElse (var "qual") (just $ ref Serialization.cstDef @@ string "qualified") nothing,+      just $ ref Serialization.cstDef @@ var "name",+      Optionals.map (lambda "m" $ ref Serialization.cstDef @@ Strings.cat2 (string "as ") (unwrap H._ModuleName @@ var "m")) (var "mod"),+      Optionals.map (var "hidingSec") (var "mspec")]] $+    ref Serialization.spaceSepDef @@ var "parts"++lambdaExpressionToExprDef :: TBinding (H.LambdaExpression -> Expr)+lambdaExpressionToExprDef = haskellSerdeDefinition "lambdaExpressionToExpr" $+  lambda "lambdaExpr" $ lets [+    "bindings">: project H._LambdaExpression H._LambdaExpression_bindings @@ var "lambdaExpr",+            "inner">: project H._LambdaExpression H._LambdaExpression_inner @@ var "lambdaExpr",+    "head">: ref Serialization.spaceSepDef @@ (Lists.map (ref patternToExprDef) (var "bindings")),+    "body">: ref expressionToExprDef @@ var "inner"] $+    ref Serialization.ifxDef @@ ref Operators.lambdaOpDef @@+      (ref Serialization.prefixDef @@ string "\\" @@ var "head") @@+      var "body"++literalToExprDef :: TBinding (H.Literal -> Expr)+literalToExprDef = haskellSerdeDefinition "literalToExpr" $+  lambda "lit" $+    ref Serialization.cstDef @@+      cases H._Literal (var "lit") Nothing [+        H._Literal_char>>: lambda "c" $ Literals.showString $ Literals.showUint16 $ var "c", -- Simplified char handling+        H._Literal_double>>: lambda "d" $+          Logic.ifElse (Equality.lt (var "d") (float64 0.0))+            (Strings.cat2 (string "(0") (Strings.cat2 (Literals.showFloat64 $ var "d") (string ")")))+            (Literals.showFloat64 $ var "d"),+        H._Literal_float>>: lambda "f" $+          Logic.ifElse (Equality.lt (var "f") (float32 0.0))+            (Strings.cat2 (string "(0") (Strings.cat2 (Literals.showFloat32 $ var "f") (string ")")))+            (Literals.showFloat32 $ var "f"),+        H._Literal_int>>: lambda "i" $+          Logic.ifElse (Equality.lt (var "i") (int32 0))+            (Strings.cat2 (string "(0") (Strings.cat2 (Literals.showInt32 $ var "i") (string ")")))+            (Literals.showInt32 $ var "i"),+        H._Literal_integer>>: lambda "i" $ Literals.showBigint $ var "i",+        H._Literal_string>>: lambda "s" $ Literals.showString $ var "s"]++localBindingToExprDef :: TBinding (H.LocalBinding -> Expr)+localBindingToExprDef = haskellSerdeDefinition "localBindingToExpr" $+  lambda "binding" $+    cases H._LocalBinding (var "binding") Nothing [+      H._LocalBinding_signature>>: lambda "ts" $ ref typeSignatureToExprDef @@ var "ts",+      H._LocalBinding_value>>: lambda "vb" $ ref valueBindingToExprDef @@ var "vb"]++moduleHeadToExprDef :: TBinding (H.ModuleHead -> Expr)+moduleHeadToExprDef = haskellSerdeDefinition "moduleHeadToExpr" $+  lambda "moduleHead" $ lets [+    "mc">: project H._ModuleHead H._ModuleHead_comments @@ var "moduleHead",+    "modName">: project H._ModuleHead H._ModuleHead_name @@ var "moduleHead",+    "mname">: unwrap H._ModuleName @@ var "modName",+    "head">: ref Serialization.spaceSepDef @@ list [+      ref Serialization.cstDef @@ string "module",+      ref Serialization.cstDef @@ var "mname",+      ref Serialization.cstDef @@ string "where"]] $+    Optionals.maybe+      (var "head")+      (lambda "c" $ ref Serialization.newlineSepDef @@ list [+        ref Serialization.cstDef @@ (ref toHaskellCommentsDef @@ var "c"),+        ref Serialization.cstDef @@ string "",+        var "head"])+      (var "mc")++moduleToExprDef :: TBinding (H.Module -> Expr)+moduleToExprDef = haskellSerdeDefinition "moduleToExpr" $+  lambda "module" $ lets [+    "mh">: project H._Module H._Module_head @@ var "module",+    "imports">: project H._Module H._Module_imports @@ var "module",+    "decls">: project H._Module H._Module_declarations @@ var "module",+    "headerLine">: Optionals.maybe (list []) (lambda "h" $ list [ref moduleHeadToExprDef @@ var "h"]) (var "mh"),+    "declLines">: Lists.map (ref declarationWithCommentsToExprDef) (var "decls"),+    "importLines">: Logic.ifElse (Lists.null $ var "imports")+      (list [])+      (list [ref Serialization.newlineSepDef @@ (Lists.map (ref importToExprDef) (var "imports"))])] $+    ref Serialization.doubleNewlineSepDef @@ (Lists.concat $ list [var "headerLine", var "importLines", var "declLines"])++nameToExprDef :: TBinding (H.Name -> Expr)+nameToExprDef = haskellSerdeDefinition "nameToExpr" $+  lambda "name" $+    ref Serialization.cstDef @@+      cases H._Name (var "name") Nothing [+        H._Name_implicit>>: lambda "qn" $ Strings.cat2 (string "?") (ref writeQualifiedNameDef @@ var "qn"),+        H._Name_normal>>: lambda "qn" $ ref writeQualifiedNameDef @@ var "qn",+        H._Name_parens>>: lambda "qn" $ Strings.cat $ list [string "(", ref writeQualifiedNameDef @@ var "qn", string ")"]]++patternToExprDef :: TBinding (H.Pattern -> Expr)+patternToExprDef = haskellSerdeDefinition "patternToExpr" $+  lambda "pat" $+    cases H._Pattern (var "pat") Nothing [+      H._Pattern_application>>: lambda "app" $ ref applicationPatternToExprDef @@ var "app",+      H._Pattern_list>>: lambda "pats" $+        ref Serialization.bracketListDef @@ ref Serialization.halfBlockStyleDef @@ (Lists.map (ref patternToExprDef) (var "pats")),+      H._Pattern_literal>>: lambda "lit" $ ref literalToExprDef @@ var "lit",+      H._Pattern_name>>: lambda "name" $ ref nameToExprDef @@ var "name",+      H._Pattern_parens>>: lambda "pat'" $ ref Serialization.parenthesizeDef @@ (ref patternToExprDef @@ var "pat'"),+      H._Pattern_tuple>>: lambda "pats" $+        ref Serialization.parenListDef @@ false @@ (Lists.map (ref patternToExprDef) (var "pats")),+      H._Pattern_wildcard>>: constant $ ref Serialization.cstDef @@ string "_"]++rightHandSideToExprDef :: TBinding (H.RightHandSide -> Expr)+rightHandSideToExprDef = haskellSerdeDefinition "rightHandSideToExpr" $+  lambda "rhs" $ ref expressionToExprDef @@ (unwrap H._RightHandSide @@ var "rhs")++statementToExprDef :: TBinding (H.Statement -> Expr)+statementToExprDef = haskellSerdeDefinition "statementToExpr" $+  lambda "stmt" $ ref expressionToExprDef @@ (unwrap H._Statement @@ var "stmt")++typeSignatureToExprDef :: TBinding (H.TypeSignature -> Expr)+typeSignatureToExprDef = haskellSerdeDefinition "typeSignatureToExpr" $+  lambda "typeSig" $ lets [+    "name">: project H._TypeSignature H._TypeSignature_name @@ var "typeSig",+    "typ">: project H._TypeSignature H._TypeSignature_type @@ var "typeSig"] $+    ref Serialization.spaceSepDef @@ list [ref nameToExprDef @@ var "name", ref Serialization.cstDef @@ string "::", ref typeToExprDef @@ var "typ"]++typeToExprDef :: TBinding (H.Type -> Expr)+typeToExprDef = haskellSerdeDefinition "typeToExpr" $+  lambda "htype" $+    cases H._Type (var "htype") Nothing [+      H._Type_application>>: lambda "appType" $ lets [+        "lhs">: project H._ApplicationType H._ApplicationType_context @@ var "appType",+        "rhs">: project H._ApplicationType H._ApplicationType_argument @@ var "appType"] $+        ref Serialization.ifxDef @@ ref Operators.appOpDef @@ (ref typeToExprDef @@ var "lhs") @@ (ref typeToExprDef @@ var "rhs"),+      H._Type_ctx>>: lambda "ctxType" $ lets [+        "ctx">: project H._ContextType H._ContextType_ctx @@ var "ctxType",+        "typ">: project H._ContextType H._ContextType_type @@ var "ctxType"] $+        ref Serialization.ifxDef @@ ref Operators.assertOpDef @@ (ref assertionToExprDef @@ var "ctx") @@ (ref typeToExprDef @@ var "typ"),+      H._Type_function>>: lambda "funType" $ lets [+        "dom">: project H._FunctionType H._FunctionType_domain @@ var "funType",+        "cod">: project H._FunctionType H._FunctionType_codomain @@ var "funType"] $+        ref Serialization.ifxDef @@ ref Operators.arrowOpDef @@ (ref typeToExprDef @@ var "dom") @@ (ref typeToExprDef @@ var "cod"),+      H._Type_list>>: lambda "htype'" $+        ref Serialization.bracketListDef @@ ref Serialization.inlineStyleDef @@ list [ref typeToExprDef @@ var "htype'"],+      H._Type_tuple>>: lambda "types" $+        ref Serialization.parenListDef @@ false @@ (Lists.map (ref typeToExprDef) (var "types")),+      H._Type_variable>>: lambda "name" $ ref nameToExprDef @@ var "name"]++valueBindingToExprDef :: TBinding (H.ValueBinding -> Expr)+valueBindingToExprDef = haskellSerdeDefinition "valueBindingToExpr" $+  lambda "vb" $+    cases H._ValueBinding (var "vb") Nothing [+      H._ValueBinding_simple>>: lambda "simpleVB" $ lets [+        "pat">: project H._SimpleValueBinding H._SimpleValueBinding_pattern @@ var "simpleVB",+        "rhs">: project H._SimpleValueBinding H._SimpleValueBinding_rhs @@ var "simpleVB",+        "local">: project H._SimpleValueBinding H._SimpleValueBinding_localBindings @@ var "simpleVB",+        "body">: ref Serialization.ifxDef @@ ref Operators.defineOpDef @@ (ref patternToExprDef @@ var "pat") @@ (ref rightHandSideToExprDef @@ var "rhs")] $+        Optionals.maybe+          (var "body")+          (lambda "localBindings" $ lets [+            "bindings">: unwrap H._LocalBindings @@ var "localBindings"] $+            ref Serialization.indentBlockDef @@ list [+              var "body",+              ref Serialization.indentBlockDef @@ Lists.cons (ref Serialization.cstDef @@ string "where") (Lists.map (ref localBindingToExprDef) (var "bindings"))])+          (var "local")]++variableToExprDef :: TBinding (H.Variable -> Expr)+variableToExprDef = haskellSerdeDefinition "variableToExpr" $+  lambda "variable" $ ref nameToExprDef @@ (unwrap H._Variable @@ var "variable")++toHaskellCommentsDef :: TBinding (String -> String)+toHaskellCommentsDef = haskellSerdeDefinition "toHaskellComments" $+  lambda "c" $ Strings.intercalate (string "\n") $ Lists.map (lambda "s" $ Strings.cat2 (string "-- | ") (var "s")) (Strings.lines $ var "c")++writeQualifiedNameDef :: TBinding (H.QualifiedName -> String)+writeQualifiedNameDef = haskellSerdeDefinition "writeQualifiedName" $+  lambda "qname" $ lets [+    "qualifiers">: project H._QualifiedName H._QualifiedName_qualifiers @@ var "qname",+    "unqual">: project H._QualifiedName H._QualifiedName_unqualified @@ var "qname",+    "h">: lambda "namePart" $ unwrap H._NamePart @@ var "namePart",+    "allParts">: Lists.concat2 (Lists.map (var "h") (var "qualifiers")) (list [var "h" @@ var "unqual"])] $+    Strings.intercalate (string ".") (var "allParts")
+ src/main/haskell/Hydra/Sources/Haskell/Utils.hs view
@@ -0,0 +1,302 @@+module Hydra.Sources.Haskell.Utils where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import qualified Hydra.Ext.Haskell.Ast as H+import qualified Hydra.Sources.Haskell.Ast as HaskellAst+import qualified Hydra.Sources.Haskell.Language as HaskellLanguage+import qualified Hydra.Sources.Kernel.Terms.Formatting as Formatting++type HaskellNamespaces = Namespaces H.ModuleName++haskellUtilsDefinition :: String -> TTerm a -> TBinding a+haskellUtilsDefinition = definitionInModule haskellUtilsModule++haskellUtilsModule :: Module+haskellUtilsModule = Module ns elements+    [Formatting.module_, HaskellLanguage.haskellLanguageModule, Schemas.module_, Names.module_]+    (HaskellAst.haskellAstModule:KernelTypes.kernelTypesModules) $+    Just "Utilities for working with Haskell syntax trees"+  where+    ns = Namespace "hydra.ext.haskell.utils"+    elements = [+      el applicationPatternDef,+      el elementReferenceDef,+      el hsappDef,+      el hslambdaDef,+      el hslitDef,+      el hsvarDef,+      el namespacesForModuleDef,+      el newtypeAccessorNameDef,+      el rawNameDef,+      el recordFieldReferenceDef,+      el sanitizeHaskellNameDef,+      el simpleNameDef,+      el simpleValueBindingDef,+      el toTypeApplicationDef,+      el typeNameForRecordDef,+      el unionFieldReferenceDef,+      el unpackForallTypeDef]++applicationPatternDef :: TBinding (H.Name -> [H.Pattern] -> H.Pattern)+applicationPatternDef = haskellUtilsDefinition "applicationPattern" $+  lambda "name" $ lambda "args" $+    inject H._Pattern H._Pattern_application $+      record H._ApplicationPattern [+        H._ApplicationPattern_name>>: var "name",+        H._ApplicationPattern_args>>: var "args"]++elementReferenceDef :: TBinding (HaskellNamespaces -> Name -> H.Name)+elementReferenceDef = haskellUtilsDefinition "elementReference" $+  lambda "namespaces" $ lambda "name" $ lets [+    "namespacePair">: Module.namespacesFocus $ var "namespaces",+    "gname">: first $ var "namespacePair",+    "gmod">: unwrap H._ModuleName @@ (second $ var "namespacePair"),+    "namespacesMap">: Module.namespacesMapping $ var "namespaces",+    "qname">: ref Names.qualifyNameDef @@ var "name",+    "local">: Module.qualifiedNameLocal $ var "qname",+    "escLocal">: ref sanitizeHaskellNameDef @@ var "local",+    "mns">: Module.qualifiedNameNamespace $ var "qname"] $+    Optionals.cases (Module.qualifiedNameNamespace $ var "qname")+      (ref simpleNameDef @@ var "local") $+      lambda "ns" $+        Optionals.cases (Maps.lookup (var "ns") (var "namespacesMap"))+          (ref simpleNameDef @@ var "local") $+          lambda "mn" $ lets [+            "aliasStr">: unwrap H._ModuleName @@ var "mn"] $+            Logic.ifElse (Equality.equal (var "ns") (var "gname"))+              (ref simpleNameDef @@ var "escLocal")+              (ref rawNameDef @@ (Strings.cat $ list [+                var "aliasStr",+                string ".",+                ref sanitizeHaskellNameDef @@ var "local"]))++hsappDef :: TBinding (H.Expression -> H.Expression -> H.Expression)+hsappDef = haskellUtilsDefinition "hsapp" $+  lambda "l" $ lambda "r" $+    inject H._Expression H._Expression_application $+      record H._ApplicationExpression [+        H._ApplicationExpression_function>>: var "l",+        H._ApplicationExpression_argument>>: var "r"]++hslambdaDef :: TBinding (H.Name -> H.Expression -> H.Expression)+hslambdaDef = haskellUtilsDefinition "hslambda" $+  lambda "name" $ lambda "rhs" $+    inject H._Expression H._Expression_lambda $+      record H._LambdaExpression [+        H._LambdaExpression_bindings>>: list [inject H._Pattern H._Pattern_name $ var "name"],+        H._LambdaExpression_inner>>: var "rhs"]++hslitDef :: TBinding (H.Literal -> H.Expression)+hslitDef = haskellUtilsDefinition "hslit" $+  lambda "lit" $+    inject H._Expression H._Expression_literal $ var "lit"++hsvarDef :: TBinding (String -> H.Expression)+hsvarDef = haskellUtilsDefinition "hsvar" $+  lambda "s" $+    inject H._Expression H._Expression_variable $ (ref rawNameDef @@ var "s")++namespacesForModuleDef :: TBinding (Module -> Flow Graph HaskellNamespaces)+namespacesForModuleDef = haskellUtilsDefinition "namespacesForModule" $+  lambda "mod" $+    bind "nss"+      (ref Schemas.moduleDependencyNamespacesDef @@ true @@ true @@ true @@ true @@ var "mod") $ lets [+    "ns">: Module.moduleNamespace $ var "mod",+    "focusPair">: var "toPair" @@ var "ns",+    "nssAsList">: Sets.toList $ var "nss",+    "nssPairs">: Lists.map (var "toPair") (var "nssAsList"),+    "emptyState">: pair Maps.empty Sets.empty,+    "finalState">: Lists.foldl (var "addPair") (var "emptyState") (var "nssPairs"),+    "resultMap">: first $ var "finalState",+    "toModuleName">: lambda "namespace" $ lets [+      "namespaceStr">: unwrap _Namespace @@ var "namespace",+      "parts">: Strings.splitOn (string ".") (var "namespaceStr"),+      "lastPart">: Lists.last $ var "parts",+      "capitalized">: ref Formatting.capitalizeDef @@ var "lastPart"] $+      wrap H._ModuleName $ var "capitalized",+    "toPair">: lambda "name" $+      pair (var "name") (var "toModuleName" @@ var "name"),+    "addPair">: lambda "state" $ lambda "namePair" $ lets [+      "currentMap">: first $ var "state",+      "currentSet">: second $ var "state",+      "name">: first $ var "namePair",+      "alias">: second $ var "namePair",+      "aliasStr">: unwrap H._ModuleName @@ var "alias"] $+      Logic.ifElse (Sets.member (var "alias") (var "currentSet"))+        (var "addPair" @@ var "state" @@ pair (var "name") (wrap H._ModuleName $ Strings.cat2 (var "aliasStr") (string "_")))+        (pair (Maps.insert (var "name") (var "alias") (var "currentMap")) (Sets.insert (var "alias") (var "currentSet")))] $+    Flows.pure $ Module.namespaces (var "focusPair") (var "resultMap")++newtypeAccessorNameDef :: TBinding (Name -> String)+newtypeAccessorNameDef = haskellUtilsDefinition "newtypeAccessorName" $+  lambda "name" $+    Strings.cat2 (string "un") (ref Names.localNameOfDef @@ var "name")++rawNameDef :: TBinding (String -> H.Name)+rawNameDef = haskellUtilsDefinition "rawName" $+  lambda "n" $+    inject H._Name H._Name_normal $+      record H._QualifiedName [+        H._QualifiedName_qualifiers>>: list [],+        H._QualifiedName_unqualified>>: wrap H._NamePart $ var "n"]++recordFieldReferenceDef :: TBinding (HaskellNamespaces -> Name -> Name -> H.Name)+recordFieldReferenceDef = haskellUtilsDefinition "recordFieldReference" $+  lambda "namespaces" $ lambda "sname" $ lambda "fname" $ lets [+    "fnameStr">: unwrap _Name @@ var "fname",+    "qname">: ref Names.qualifyNameDef @@ var "sname",+    "ns">: Module.qualifiedNameNamespace $ var "qname",+    "typeNameStr">: ref typeNameForRecordDef @@ var "sname",+    "decapitalized">: ref Formatting.decapitalizeDef @@ var "typeNameStr",+    "capitalized">: ref Formatting.capitalizeDef @@ var "fnameStr",+    "nm">: Strings.cat2 (var "decapitalized") (var "capitalized"),+    "qualName">: record _QualifiedName [+      _QualifiedName_namespace>>: var "ns",+      _QualifiedName_local>>: var "nm"],+    "unqualName">: ref Names.unqualifyNameDef @@ var "qualName"] $+    ref elementReferenceDef @@ var "namespaces" @@ var "unqualName"++sanitizeHaskellNameDef :: TBinding (String -> String)+sanitizeHaskellNameDef = haskellUtilsDefinition "sanitizeHaskellName" $+  ref Formatting.sanitizeWithUnderscoresDef @@ (ref HaskellLanguage.reservedWordsDef)++simpleNameDef :: TBinding (String -> H.Name)+simpleNameDef = haskellUtilsDefinition "simpleName" $+  compose (ref rawNameDef) (ref sanitizeHaskellNameDef)++simpleValueBindingDef :: TBinding (H.Name -> H.Expression -> Maybe H.LocalBindings -> H.ValueBinding)+simpleValueBindingDef = haskellUtilsDefinition "simpleValueBinding" $+  lambda "hname" $ lambda "rhs" $ lambda "bindings" $ lets [+    "pat">: inject H._Pattern H._Pattern_application $+      record H._ApplicationPattern [+        H._ApplicationPattern_name>>: var "hname",+        H._ApplicationPattern_args>>: list []],+    "rightHandSide">: wrap H._RightHandSide $ var "rhs"] $+    inject H._ValueBinding H._ValueBinding_simple $+      record H._SimpleValueBinding [+        H._SimpleValueBinding_pattern>>: var "pat",+        H._SimpleValueBinding_rhs>>: var "rightHandSide",+        H._SimpleValueBinding_localBindings>>: var "bindings"]++toTypeApplicationDef :: TBinding ([H.Type] -> H.Type)+toTypeApplicationDef = haskellUtilsDefinition "toTypeApplication" $+  lambda "types" $ lets [+    "app">: lambda "l" $+      Logic.ifElse (Equality.gt (Lists.length (var "l")) (int32 1))+        (inject H._Type H._Type_application $ record H._ApplicationType [+          H._ApplicationType_context>>: var "app" @@ (Lists.tail (var "l")),+          H._ApplicationType_argument>>: Lists.head (var "l")])+        (Lists.head $ var "l")] $+    var "app" @@ (Lists.reverse $ var "types")++typeNameForRecordDef :: TBinding (Name -> String)+typeNameForRecordDef = haskellUtilsDefinition "typeNameForRecord" $+  lambda "sname" $ lets [+    "snameStr">: Core.unName $ var "sname",+    "parts">: Strings.splitOn (string ".") (var "snameStr")] $+    Lists.last $ var "parts"++unionFieldReferenceDef :: TBinding (HaskellNamespaces -> Name -> Name -> H.Name)+unionFieldReferenceDef = haskellUtilsDefinition "unionFieldReference" $+  lambda "namespaces" $ lambda "sname" $ lambda "fname" $ lets [+    "fnameStr">: unwrap _Name @@ var "fname",+    "qname">: ref Names.qualifyNameDef @@ var "sname",+    "ns">: Module.qualifiedNameNamespace $ var "qname",+    "typeNameStr">: ref typeNameForRecordDef @@ var "sname",+    "capitalizedTypeName">: ref Formatting.capitalizeDef @@ var "typeNameStr",+    "capitalizedFieldName">: ref Formatting.capitalizeDef @@ var "fnameStr",+    "nm">: Strings.cat2 (var "capitalizedTypeName") (var "capitalizedFieldName"),+    "qualName">: record _QualifiedName [+      _QualifiedName_namespace>>: var "ns",+      _QualifiedName_local>>: var "nm"],+    "unqualName">: ref Names.unqualifyNameDef @@ var "qualName"] $+    ref elementReferenceDef @@ var "namespaces" @@ var "unqualName"++unpackForallTypeDef :: TBinding (Graph -> Type -> ([Name], Type))+unpackForallTypeDef = haskellUtilsDefinition "unpackForallType" $+  lambdas ["cx", "t"] $ cases _Type (ref Rewriting.deannotateTypeDef @@ var "t")+    (Just $ pair (list []) (var "t")) [+    _Type_forall>>: lambda "fat" $ lets [+      "v">: Core.forallTypeParameter $ var "fat",+      "tbody">: Core.forallTypeBody $ var "fat",+      "recursiveResult">: ref unpackForallTypeDef @@ var "cx" @@ var "tbody",+      "vars">: first $ var "recursiveResult",+      "finalType">: second $ var "recursiveResult"] $+      pair (Lists.cons (var "v") (var "vars")) (var "finalType")]
+ src/main/haskell/Hydra/Sources/Json/Coder.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Json.Coder where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import Hydra.Json+import qualified Hydra.Sources.Json.Language as JsonLanguage+import qualified Hydra.Sources.Kernel.Terms.Literals as HydraLiterals+++module_ :: Module+module_ = Module (Namespace "hydra.ext.org.json.coder") elements+    [AdaptModules.module_, AdaptTerms.module_, AdaptUtils.module_, EncodeCore.module_,+     ExtractCore.module_, HydraLiterals.module_, Monads.module_, Rewriting.module_, JsonLanguage.module_,+     Variants.module_]+    KernelTypes.kernelTypesModules $+    Just "JSON encoding and decoding for Hydra terms"+  where+    elements = [+      el jsonCoderDef,+      el literalJsonCoderDef,+      el recordCoderDef,+      el encodeRecordDef,+      el decodeRecordDef,+      el termCoderDef,+      el unitCoderDef,+      el untypedTermToJsonDef,+      el readStringStubDef,+      el showValueDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++jsonCoderDef :: TBinding (Type -> Flow Graph (Coder Graph Graph Term Value))+jsonCoderDef = define "jsonCoder" $+  doc "Create a JSON coder for a given type" $+  lambda "typ" $ binds [+    "adapter">: ref AdaptModules.languageAdapterDef @@ ref JsonLanguage.jsonLanguageDef @@ var "typ",+    "coder">: ref termCoderDef @@ (Compute.adapterTarget $ var "adapter")] $+    produce $ ref AdaptUtils.composeCodersDef @@ (Compute.adapterCoder $ var "adapter") @@ var "coder"++literalJsonCoderDef :: TBinding (LiteralType -> Flow Graph (Coder Graph Graph Literal Value))+literalJsonCoderDef = define "literalJsonCoder" $+  doc "Create a JSON coder for literal types" $+  lambda "lt" $ produce $ cases _LiteralType (var "lt") Nothing [+    _LiteralType_boolean>>: constant $ Compute.coder+      (lambda "lit" $ binds [+        "b">: ref ExtractCore.booleanLiteralDef @@ var "lit"] $+        produce $ Json.valueBoolean $ var "b")+      (lambda "s" $ cases _Value (var "s")+        (Just $ ref Monads.unexpectedDef @@ string "boolean" @@ (ref showValueDef @@ var "s")) [+        _Value_boolean>>: lambda "b" $ produce $ Core.literalBoolean $ var "b"]),+    _LiteralType_float>>: constant $ Compute.coder+      (lambda "lit" $ binds [+        "f">: ref ExtractCore.floatLiteralDef @@ var "lit",+        "bf">: ref ExtractCore.bigfloatValueDef @@ var "f"] $+        produce $ Json.valueNumber $ var "bf")+      (lambda "s" $ cases _Value (var "s")+        (Just $ ref Monads.unexpectedDef @@ string "number" @@ (ref showValueDef @@ var "s")) [+        _Value_number>>: lambda "f" $ produce $ Core.literalFloat $ Core.floatValueBigfloat $ var "f"]),+    _LiteralType_integer>>: constant $ Compute.coder+      (lambda "lit" $ binds [+        "i">: ref ExtractCore.integerLiteralDef @@ var "lit",+        "bi">: ref ExtractCore.bigintValueDef @@ var "i"] $+        produce $ Json.valueNumber $ Literals.bigintToBigfloat $ var "bi")+      (lambda "s" $ cases _Value (var "s")+        (Just $ ref Monads.unexpectedDef @@ string "number" @@ (ref showValueDef @@ var "s")) [+        _Value_number>>: lambda "f" $ lets [+          "bi">: Literals.bigfloatToBigint $ var "f"] $+          produce $ Core.literalInteger $ Core.integerValueBigint $ var "bi"]),+    _LiteralType_string>>: constant $ Compute.coder+      (lambda "lit" $ binds [+        "s">: ref ExtractCore.stringLiteralDef @@ var "lit"] $+        produce $ Json.valueString $ var "s")+      (lambda "s" $ cases _Value (var "s")+        (Just $ ref Monads.unexpectedDef @@ string "string" @@ (ref showValueDef @@ var "s")) [+        _Value_string>>: lambda "s'" $ produce $ Core.literalString $ var "s'"])]++recordCoderDef :: TBinding (RowType -> Flow Graph (Coder Graph Graph Term Value))+recordCoderDef = define "recordCoder" $+  doc "Create a JSON coder for record types" $+  lambda "rt" $ lets [+    "fields">: Core.rowTypeFields $ var "rt",+    "getCoder">: lambda "f" $ binds [+      "coder">: ref termCoderDef @@ (Core.fieldTypeType $ var "f")] $+      produce $ pair (var "f") (var "coder")] $ binds [+    "coders">: Flows.mapList (var "getCoder") (var "fields")] $+    produce $ Compute.coder (ref encodeRecordDef @@ var "coders") (ref decodeRecordDef @@ var "rt" @@ var "coders")++encodeRecordDef :: TBinding ([(FieldType, Coder Graph Graph Term Value)] -> Term -> Flow Graph Value)+encodeRecordDef = define "encodeRecord" $+  doc "Encode a record term to JSON" $+  lambdas ["coders", "term"] $ lets [+    "stripped">: ref Rewriting.deannotateTermDef @@ var "term"] $ binds [+    "record">: ref ExtractCore.termRecordDef @@ var "stripped"] $ lets [+    "fields">: Core.recordFields $ var "record",+    "encodeField">: lambda "coderAndField" $ lets [+      "coder">: first $ var "coderAndField",+      "field">: second $ var "coderAndField",+      "ft">: first $ var "coder",+      "coder'">: second $ var "coder",+      "fname">: Core.fieldName $ var "field",+      "fvalue">: Core.fieldTerm $ var "field"] $+      cases _Type (Core.fieldTypeType $ var "ft")+        (Just $ binds [+          "encoded">: Compute.coderEncode (var "coder'") @@ var "fvalue"] $+          produce $ just $ pair (Core.unName $ var "fname") (var "encoded")) [+        _Type_optional>>: lambda "ot" $ cases _Term (var "fvalue")+          (Just $ binds [+            "encoded">: Compute.coderEncode (var "coder'") @@ var "fvalue"] $+            produce $ just $ pair (Core.unName $ var "fname") (var "encoded")) [+          _Term_optional>>: lambda "opt" $ Optionals.maybe+            (produce nothing)+            (lambda "v" $ binds [+              "encoded">: Compute.coderEncode (var "coder'") @@ var "v"] $+              produce $ just $ pair (Core.unName $ var "fname") (var "encoded"))+            (var "opt")]]] $ binds [+    "maybeFields">: Flows.mapList (var "encodeField") (Lists.zip (var "coders") (var "fields"))] $+    produce $ Json.valueObject $ Maps.fromList $ Optionals.cat $ var "maybeFields"++decodeRecordDef :: TBinding (RowType -> [(FieldType, Coder Graph Graph Term Value)] -> Value -> Flow Graph Term)+decodeRecordDef = define "decodeRecord" $+  doc "Decode a JSON value to a record term" $+  lambdas ["rt", "coders", "n"] $ cases _Value (var "n")+    (Just $ ref Monads.unexpectedDef @@ string "object" @@ (ref showValueDef @@ var "n")) [+    _Value_object>>: lambda "m" $ lets [+      "decodeField">: lambda "coder" $ lets [+        "ft">: first $ var "coder",+        "coder'">: second $ var "coder",+        "fname">: Core.fieldTypeName $ var "ft",+        "defaultValue">: Json.valueNull,+        "jsonValue">: Optionals.fromMaybe (var "defaultValue") $ Maps.lookup (Core.unName $ var "fname") (var "m")] $ binds [+        "v">: Compute.coderDecode (var "coder'") @@ var "jsonValue"] $+        produce $ Core.field (var "fname") (var "v")] $ binds [+      "fields">: Flows.mapList (var "decodeField") (var "coders")] $+      produce $ Core.termRecord $ Core.record (Core.rowTypeTypeName $ var "rt") (var "fields")]++termCoderDef :: TBinding (Type -> Flow Graph (Coder Graph Graph Term Value))+termCoderDef = define "termCoder" $+  doc "Create a JSON coder for term types" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"] $+    cases _Type (var "stripped")+      (Just $ Flows.fail $ Strings.cat $ list [+        string "unsupported type in JSON: ",+        ref ShowCore.typeDef @@ var "typ"]) [+      _Type_literal>>: lambda "at" $ binds [+        "ac">: ref literalJsonCoderDef @@ var "at"] $+        produce $ Compute.coder+          (lambda "term" $ cases _Term (var "term")+            (Just $ ref Monads.unexpectedDef @@ string "literal term" @@ (ref ShowCore.termDef @@ var "term")) [+            _Term_literal>>: lambda "av" $ Compute.coderEncode (var "ac") @@ var "av"])+          (lambda "n" $ binds [+            "lit">: Compute.coderDecode (var "ac") @@ var "n"] $+            produce $ Core.termLiteral $ var "lit"),+      _Type_list>>: lambda "lt" $ binds [+        "lc">: ref termCoderDef @@ var "lt"] $+        produce $ Compute.coder+          (lambda "term" $ cases _Term (var "term")+            (Just $ ref Monads.unexpectedDef @@ string "list term" @@ (ref ShowCore.termDef @@ var "term")) [+            _Term_list>>: lambda "els" $ binds [+              "encodedEls">: Flows.mapList (Compute.coderEncode $ var "lc") (var "els")] $+              produce $ Json.valueArray $ var "encodedEls"])+          (lambda "n" $ cases _Value (var "n")+            (Just $ ref Monads.unexpectedDef @@ string "sequence" @@ (ref showValueDef @@ var "n")) [+            _Value_array>>: lambda "nodes" $ binds [+              "decodedNodes">: Flows.mapList (Compute.coderDecode $ var "lc") (var "nodes")] $+              produce $ Core.termList $ var "decodedNodes"]),+      _Type_map>>: lambda "mt" $ lets [+        "kt">: Core.mapTypeKeys $ var "mt",+        "vt">: Core.mapTypeValues $ var "mt"] $ binds [+        "kc">: ref termCoderDef @@ var "kt",+        "vc">: ref termCoderDef @@ var "vt",+        "cx">: ref Monads.getStateDef] $ lets [+        "isStringKey">: Equality.equal (ref Rewriting.deannotateTypeDef @@ var "kt") TTypes.string,+        "toString">: lambda "v" $ Logic.ifElse (var "isStringKey")+          (cases _Term (ref Rewriting.deannotateTermDef @@ var "v")+            (Just $ ref ShowCore.termDef @@ var "v") [+            _Term_literal>>: lambda "lit" $ cases _Literal (var "lit")+              (Just $ ref ShowCore.termDef @@ var "v") [+              _Literal_string>>: lambda "s" $ var "s"]])+          (ref ShowCore.termDef @@ var "v"),+        "fromString">: lambda "s" $ Logic.ifElse (var "isStringKey")+          (Core.termLiteral $ Core.literalString $ var "s")+          (ref readStringStubDef @@ var "s"),+        "encodeEntry">: lambda "kv" $ lets [+          "k">: first $ var "kv",+          "v">: second $ var "kv"] $ binds [+          "encodedV">: Compute.coderEncode (var "vc") @@ var "v"] $+          produce $ pair (var "toString" @@ var "k") (var "encodedV"),+        "decodeEntry">: lambda "kv" $ lets [+          "k">: first $ var "kv",+          "v">: second $ var "kv"] $ binds [+          "decodedV">: Compute.coderDecode (var "vc") @@ var "v"] $+          produce $ pair (var "fromString" @@ var "k") (var "decodedV")] $+        produce $ Compute.coder+          (lambda "term" $ cases _Term (var "term")+            (Just $ ref Monads.unexpectedDef @@ string "map term" @@ (ref ShowCore.termDef @@ var "term")) [+            _Term_map>>: lambda "m" $ binds [+              "entries">: Flows.mapList (var "encodeEntry") $ Maps.toList $ var "m"] $+              produce $ Json.valueObject $ Maps.fromList $ var "entries"])+          (lambda "n" $ cases _Value (var "n")+            (Just $ ref Monads.unexpectedDef @@ string "mapping" @@ (ref showValueDef @@ var "n")) [+            _Value_object>>: lambda "m" $ binds [+              "entries">: Flows.mapList (var "decodeEntry") $ Maps.toList $ var "m"] $+              produce $ Core.termMap $ Maps.fromList $ var "entries"]),+      _Type_optional>>: lambda "ot" $ binds [+        "oc">: ref termCoderDef @@ var "ot"] $+        produce $ Compute.coder+          (lambda "t" $ lets [+            "stripped">: ref Rewriting.deannotateTermDef @@ var "t"] $+            cases _Term (var "stripped")+              (Just $ ref Monads.unexpectedDef @@ string "optional term" @@ (ref ShowCore.termDef @@ var "t")) [+              _Term_optional>>: lambda "el" $ Optionals.maybe+                (produce Json.valueNull)+                (Compute.coderEncode $ var "oc")+                (var "el")])+          (lambda "n" $ cases _Value (var "n")+            (Just $ binds [+              "decoded">: Compute.coderDecode (var "oc") @@ var "n"] $+              produce $ Core.termOptional $ just $ var "decoded") [+            _Value_null>>: constant $ produce $ Core.termOptional nothing]),+      _Type_record>>: lambda "rt" $ ref recordCoderDef @@ var "rt",+      _Type_unit>>: constant $ produce $ ref unitCoderDef,+      _Type_variable>>: lambda "name" $ produce $ Compute.coder+        (lambda "term" $ produce $ Json.valueString $ Strings.cat $ list [+          string "variable '",+          Core.unName $ var "name",+          string "' for: ",+          ref ShowCore.termDef @@ var "term"])+        (lambda "term" $ Flows.fail $ Strings.cat $ list [+          string "type variable ",+          Core.unName $ var "name",+          string " does not support decoding"])]++unitCoderDef :: TBinding (Coder Graph Graph Term Value)+unitCoderDef = define "unitCoder" $+  doc "JSON coder for unit values" $+  Compute.coder+    (lambda "term" $ cases _Term (ref Rewriting.deannotateTermDef @@ var "term")+      (Just $ ref Monads.unexpectedDef @@ string "unit" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_unit>>: constant $ produce Json.valueNull])+    (lambda "n" $ cases _Value (var "n")+      (Just $ ref Monads.unexpectedDef @@ string "null" @@ (ref showValueDef @@ var "n")) [+      _Value_null>>: constant $ produce Core.termUnit])++untypedTermToJsonDef :: TBinding (Term -> Flow s Value)+untypedTermToJsonDef = define "untypedTermToJson" $+  doc "A simplistic, unidirectional encoding for terms as JSON values. Not type-aware; best used for human consumption." $+  lambda "term" $ lets [+    "unexp">: lambda "msg" $ produce $ Json.valueString $ Strings.cat2 (string "FAIL: ") (var "msg"),+    "asRecord">: lambda "fields" $ ref untypedTermToJsonDef @@ (Core.termRecord $ Core.record (Core.name $ string "") (var "fields")),+    "asVariant">: lambdas ["name", "term"] $ ref untypedTermToJsonDef @@+      (Core.termUnion $ Core.injection (Core.name $ string "") $ Core.field (Core.name $ var "name") (var "term")),+    "fieldToKeyval">: lambda "f" $ lets [+      "forTerm">: lambda "t" $ cases _Term (var "t")+        (Just $ Flows.map (unaryFunction just) $ ref untypedTermToJsonDef @@ var "t") [+        _Term_optional>>: lambda "mt" $ Optionals.maybe+          (produce nothing)+          (var "forTerm")+          (var "mt")]] $ binds [+      "mjson">: var "forTerm" @@ (Core.fieldTerm $ var "f")] $+      produce $ Optionals.map+        (lambda "j" $ pair (Core.unName $ Core.fieldName $ var "f") (var "j"))+        (var "mjson")] $+    cases _Term (var "term")+      (Just $ var "unexp" @@ (Strings.cat $ list [+        string "unsupported term variant: ",+        ref ShowCore.termDef @@ var "term"])) [+      _Term_annotated>>: lambda "at" $ lets [+        "term1">: Core.annotatedTermSubject $ var "at",+        "ann">: Core.annotatedTermAnnotation $ var "at",+        "encodePair">: lambda "kv" $ lets [+          "k">: Core.unName $ first $ var "kv",+          "v">: second $ var "kv"] $ binds [+          "json">: ref untypedTermToJsonDef @@ var "v"] $+          produce $ pair (var "k") (var "json")] $ binds [+        "json">: ref untypedTermToJsonDef @@ var "term1",+        "pairs">: Flows.mapList (var "encodePair") $ Maps.toList $ var "ann"] $+        produce $ Json.valueObject $ Maps.fromList $ list [+          pair (string "term") (var "json"),+          pair (string "annotations") (Json.valueObject $ Maps.fromList $ var "pairs")],+      _Term_application>>: lambda "app" $ var "asRecord" @@ list [+        Core.field (Core.name $ string "function") (Core.applicationFunction $ var "app"),+        Core.field (Core.name $ string "argument") (Core.applicationArgument $ var "app")],+      _Term_function>>: lambda "f" $ cases _Function (var "f") Nothing [+        _Function_elimination>>: lambda "elm" $ cases _Elimination (var "elm")+          (Just $ var "unexp" @@ (Strings.cat $ list [+            string "unexpected elimination variant: ",+            ref ShowCore.eliminationDef @@ var "elm"])) [+          _Elimination_record>>: lambda "proj" $ var "asVariant" @@ string "project" @@+            (Core.termVariable $ Core.projectionField $ var "proj")],+        _Function_lambda>>: lambda "l" $ var "asRecord" @@ list [+          Core.field (Core.name $ string "parameter") (Core.termVariable $ Core.lambdaParameter $ var "l"),+          Core.field (Core.name $ string "domain") (Core.termOptional $+            Optionals.map (ref EncodeCore.typeDef) (Core.lambdaDomain $ var "l")),+          Core.field (Core.name $ string "body") (Core.lambdaBody $ var "l")],+        _Function_primitive>>: lambda "name" $ produce $ Json.valueString $ Core.unName $ var "name"],+      _Term_let>>: lambda "lt" $ lets [+        "bindings">: Core.letBindings $ var "lt",+        "env">: Core.letEnvironment $ var "lt",+        "fromBinding">: lambda "b" $ Core.field+          (Core.bindingName $ var "b")+          (Core.bindingTerm $ var "b")] $+        var "asRecord" @@ list [+          Core.field (Core.name $ string "bindings") (Core.termRecord $ Core.record+            (Core.name $ string "")+            (Lists.map (var "fromBinding") (var "bindings"))),+          Core.field (Core.name $ string "environment") (var "env")],+      _Term_list>>: lambda "terms" $ binds [+        "jsonTerms">: Flows.mapList (ref untypedTermToJsonDef) (var "terms")] $+        produce $ Json.valueArray $ var "jsonTerms",+      _Term_literal>>: lambda "lit" $ produce $ cases _Literal (var "lit") Nothing [+        _Literal_binary>>: lambda "b" $ Json.valueString $ Literals.binaryToString $ var "b",+        _Literal_boolean>>: lambda "b" $ Json.valueBoolean $ var "b",+        _Literal_float>>: lambda "f" $ Json.valueNumber $ ref HydraLiterals.floatValueToBigfloatDef @@ var "f",+        _Literal_integer>>: lambda "i" $ lets [+          "bf">: ref HydraLiterals.integerValueToBigintDef @@ var "i",+          "f">: Literals.bigintToBigfloat $ var "bf"] $+          Json.valueNumber $ var "f",+        _Literal_string>>: lambda "s" $ Json.valueString $ var "s"],+      _Term_optional>>: lambda "mt" $ Optionals.maybe+        (produce Json.valueNull)+        (ref untypedTermToJsonDef)+        (var "mt"),+      _Term_product>>: lambda "els" $ ref untypedTermToJsonDef @@ (Core.termList $ var "els"),+      _Term_record>>: lambda "r" $ lets [+        "fields">: Core.recordFields $ var "r"] $ binds [+        "keyvals">: Flows.mapList (var "fieldToKeyval") (var "fields")] $+        produce $ Json.valueObject $ Maps.fromList $ Optionals.cat $ var "keyvals",+      _Term_set>>: lambda "vals" $ ref untypedTermToJsonDef @@ (Core.termList $ Sets.toList $ var "vals"),+      _Term_sum>>: lambda "s" $ var "asRecord" @@ list [+        Core.field (Core.name $ string "index") (Core.termLiteral $ Core.literalInteger $+          Core.integerValueInt32 $ Core.sumIndex $ var "s"),+        Core.field (Core.name $ string "size") (Core.termLiteral $ Core.literalInteger $+          Core.integerValueInt32 $ Core.sumSize $ var "s"),+        Core.field (Core.name $ string "term") (Core.sumTerm $ var "s")],+      _Term_typeLambda>>: lambda "ta" $ var "asRecord" @@ list [+        Core.field (Core.name $ string "parameter") (Core.termVariable $ Core.typeLambdaParameter $ var "ta"),+        Core.field (Core.name $ string "body") (Core.typeLambdaBody $ var "ta")],+      _Term_typeApplication>>: lambda "tt" $ var "asRecord" @@ list [+        Core.field (Core.name $ string "term") (Core.typedTermTerm $ var "tt"),+        Core.field (Core.name $ string "type") (ref EncodeCore.typeDef @@ (Core.typedTermType $ var "tt"))],+      _Term_union>>: lambda "i" $ lets [+        "field">: Core.injectionField $ var "i"] $+        Logic.ifElse (Equality.equal (Core.fieldTerm $ var "field") Core.termUnit)+          (produce $ Json.valueString $ Core.unName $ Core.fieldName $ var "field")+          (binds [+            "mkeyval">: var "fieldToKeyval" @@ var "field"] $+            produce $ Json.valueObject $ Maps.fromList $ Optionals.maybe+              (list [])+              (lambda "keyval" $ list [var "keyval"])+              (var "mkeyval")),+      _Term_variable>>: lambda "v" $ produce $ Json.valueString $ Core.unName $ var "v",+      _Term_wrap>>: lambda "wt" $ ref untypedTermToJsonDef @@ (Core.wrappedTermObject $ var "wt")]++readStringStubDef :: TBinding (String -> Term)+readStringStubDef = define "readStringStub" $+  doc "Placeholder for reading a string into a term (to be implemented)" $+  lambda "s" $ Core.termLiteral $ Core.literalString $ Strings.cat2 (string "TODO: read ") (var "s")++-- TODO: implement this function, and deduplicate with hydra.json.coder.showValue+showValueDef :: TBinding (Value -> String)+showValueDef = define "showValue" $+  doc "Show a JSON value as a string (placeholder implementation)" $+  lambda "value" $ string "TODO: implement showValue"
+ src/main/haskell/Hydra/Sources/Json/Decoding.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Json.Decoding where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import Hydra.Json+import qualified Hydra.Sources.Kernel.Types.Json as Json+++module_ :: Module+module_ = Module (Namespace "hydra.ext.org.json.decoding") elements+    []+    KernelTypes.kernelTypesModules $+    Just "Decoding functions for JSON data"+  where+   elements = [+     Phantoms.el decodeArrayDef,+     Phantoms.el decodeBooleanDef,+     Phantoms.el decodeFieldDef,+--     Phantoms.el decodeNumberDef, TODO: restore+     Phantoms.el decodeObjectDef,+     Phantoms.el decodeOptionalFieldDef,+     Phantoms.el decodeStringDef]++define :: String -> TTerm a -> TBinding a+define label = definitionInModule module_ ("decode" <> label)++decodeArrayDef :: TBinding ((Value -> Flow s a) -> Value -> Flow s [a])+decodeArrayDef  = define "Array" $+  lambda "decodeElem" $ match _Value (Just $ Flows.fail "expected an array") [+    _Value_array>>: lambda "a" $ Flows.mapList (var "decodeElem") $ var "a"]++decodeBooleanDef :: TBinding (Value -> Flow s Bool)+decodeBooleanDef  = define "Boolean" $+  match _Value (Just $ Flows.fail $ "expected a boolean") [+    _Value_boolean>>: lambda "b" $ Flows.pure $ var "b"]++decodeFieldDef :: TBinding ((Value -> Flow s a) -> String -> (M.Map String Value) -> Flow s a)+decodeFieldDef  = define "Field" $+  lambda "decodeValue" $ lambda "name" $ lambda "m" $+    Flows.bind+      (ref decodeOptionalFieldDef @@ var "decodeValue" @@ var "name" @@ var "m")+      (primitive _optionals_maybe+        @@ (Flows.fail $ Strings.cat2 "missing field: " (var "name"))+        @@ (lambda "f" $ Flows.pure $ var "f"))++decodeNumberDef :: TBinding (Value -> Flow s Double)+decodeNumberDef  = define "Number" $+  match _Value (Just $ Flows.fail "expected a number") [+    _Value_number>>: lambda "n" $ Flows.pure $ var "n"]++decodeObjectDef :: TBinding (Value -> Flow s (M.Map String Value))+decodeObjectDef  = define "Object" $+  match _Value (Just $ Flows.fail "expected an object") [+    _Value_object>>: lambda "o" $ Flows.pure $ var "o"]++decodeOptionalFieldDef :: TBinding ((Value -> Flow s a) -> String -> (M.Map String Value) -> Flow s (Maybe a))+decodeOptionalFieldDef  = define "OptionalField" $+  lambda "decodeValue" $ lambda "name" $ lambda "m" $+    (primitive _optionals_maybe+        @@ (Flows.pure nothing)+        @@ (lambda "v" (Flows.map (lambda "x" (just $ var "x")) (var "decodeValue" @@ var "v"))))+      @@ (Maps.lookup (var "name") (var "m"))++decodeStringDef :: TBinding (Value -> Flow s String)+decodeStringDef  = define "String" $+  match _Value (Just $ Flows.fail "expected a string") [+    _Value_string>>: lambda "s" $ Flows.pure $ var "s"]
+ src/main/haskell/Hydra/Sources/Json/Extract.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Json.Extract where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y++import Hydra.Json+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+++module_ :: Module+module_ = Module (Namespace "hydra.extract.json") elements+    [Monads.module_]+    KernelTypes.kernelTypesModules $+    Just "Utilities for extracting values from JSON objects"+  where+    elements = [+      el expectArrayDef,+      el expectNumberDef,+      el expectObjectDef,+      el expectStringDef,+      el optDef,+      el optArrayDef,+      el optStringDef,+      el requireDef,+      el requireArrayDef,+      el requireNumberDef,+      el requireStringDef,+      el showValueDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++expectArrayDef :: TBinding (Value -> Flow s [Value])+expectArrayDef = define "expectArray" $+  doc "Extract an array from a JSON value, failing if the value is not an array" $+  lambda "value" $ cases _Value (var "value")+    (Just $ ref Monads.unexpectedDef @@ string "JSON array" @@ (ref showValueDef @@ var "value")) [+    _Value_array>>: lambda "els" $ Flows.pure $ var "els"]++expectNumberDef :: TBinding (Value -> Flow s Double)+expectNumberDef = define "expectNumber" $+  doc "Extract a number from a JSON value, failing if the value is not a number" $+  lambda "value" $ cases _Value (var "value")+    (Just $ ref Monads.unexpectedDef @@ string "JSON number" @@ (ref showValueDef @@ var "value")) [+    _Value_number>>: lambda "d" $ Flows.pure $ var "d"]++expectObjectDef :: TBinding (Value -> Flow s (M.Map String Value))+expectObjectDef = define "expectObject" $+  doc "Extract an object from a JSON value, failing if the value is not an object" $+  lambda "value" $ cases _Value (var "value")+    (Just $ ref Monads.unexpectedDef @@ string "JSON object" @@ (ref showValueDef @@ var "value")) [+    _Value_object>>: lambda "m" $ Flows.pure $ var "m"]++expectStringDef :: TBinding (Value -> Flow s String)+expectStringDef = define "expectString" $+  doc "Extract a string from a JSON value, failing if the value is not a string" $+  lambda "value" $ cases _Value (var "value")+    (Just $ ref Monads.unexpectedDef @@ string "JSON string" @@ (ref showValueDef @@ var "value")) [+    _Value_string>>: lambda "s" $ Flows.pure $ var "s"]++optDef :: TBinding (String -> M.Map String Value -> Maybe Value)+optDef = define "opt" $+  doc "Look up an optional field in a JSON object" $+  lambdas ["fname", "m"] $ Maps.lookup (var "fname") (var "m")++optArrayDef :: TBinding (String -> M.Map String Value -> Flow s (Maybe [Value]))+optArrayDef = define "optArray" $+  doc "Look up an optional array field in a JSON object" $+  lambdas ["fname", "m"] $ Optionals.maybe+    (Flows.pure nothing)+    (lambda "a" $ Flows.map (unaryFunction just) $ ref expectArrayDef @@ var "a")+    (ref optDef @@ var "fname" @@ var "m")++optStringDef :: TBinding (String -> M.Map String Value -> Flow s (Maybe String))+optStringDef = define "optString" $+  doc "Look up an optional string field in a JSON object" $+  lambdas ["fname", "m"] $ Optionals.maybe+    (Flows.pure nothing)+    (lambda "s" $ Flows.map (unaryFunction just) $ ref expectStringDef @@ var "s")+    (ref optDef @@ var "fname" @@ var "m")++requireDef :: TBinding (String -> M.Map String Value -> Flow s Value)+requireDef = define "require" $+  doc "Look up a required field in a JSON object, failing if not found" $+  lambdas ["fname", "m"] $ Optionals.maybe+    (Flows.fail $ Strings.cat $ list [+      string "required attribute ",+      ref showValueDef @@ var "fname",+      string " not found"])+    (lambda "value" $ Flows.pure $ var "value")+    (Maps.lookup (var "fname") (var "m"))++requireArrayDef :: TBinding (String -> M.Map String Value -> Flow s [Value])+requireArrayDef = define "requireArray" $+  doc "Look up a required array field in a JSON object" $+  lambdas ["fname", "m"] $ Flows.bind+    (ref requireDef @@ var "fname" @@ var "m")+    (ref expectArrayDef)++requireNumberDef :: TBinding (String -> M.Map String Value -> Flow s Double)+requireNumberDef = define "requireNumber" $+  doc "Look up a required number field in a JSON object" $+  lambdas ["fname", "m"] $ Flows.bind+    (ref requireDef @@ var "fname" @@ var "m")+    (ref expectNumberDef)++requireStringDef :: TBinding (String -> M.Map String Value -> Flow s String)+requireStringDef = define "requireString" $+  doc "Look up a required string field in a JSON object" $+  lambdas ["fname", "m"] $ Flows.bind+    (ref requireDef @@ var "fname" @@ var "m")+    (ref expectStringDef)++-- TODO: implement this function, and deduplicate with hydra.json.coder.showValue+showValueDef :: TBinding (Value -> String)+showValueDef = define "showValue" $+  doc "Show a JSON value as a string (placeholder implementation)" $+  lambda "value" $ string "TODO: implement showValue"
+ src/main/haskell/Hydra/Sources/Json/Language.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Json.Language where++-- Standard imports for term-level sources outside of the kernel+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors                        as Accessors+import qualified Hydra.Dsl.Annotations                      as Anns+import qualified Hydra.Dsl.Ast                              as Ast+import qualified Hydra.Dsl.Coders                           as Coders+import qualified Hydra.Dsl.Compute                          as Compute+import qualified Hydra.Dsl.Core                             as Core+import qualified Hydra.Dsl.Grammar                          as Grammar+import qualified Hydra.Dsl.Graph                            as Graph+import qualified Hydra.Dsl.Json                             as Json+import qualified Hydra.Dsl.Lib.Chars                        as Chars+import qualified Hydra.Dsl.Lib.Equality                     as Equality+import qualified Hydra.Dsl.Lib.Flows                        as Flows+import qualified Hydra.Dsl.Lib.Lists                        as Lists+import qualified Hydra.Dsl.Lib.Literals                     as Literals+import qualified Hydra.Dsl.Lib.Logic                        as Logic+import qualified Hydra.Dsl.Lib.Maps                         as Maps+import qualified Hydra.Dsl.Lib.Math                         as Math+import qualified Hydra.Dsl.Lib.Optionals                    as Optionals+import qualified Hydra.Dsl.Lib.Sets                         as Sets+import           Hydra.Dsl.Lib.Strings                      as Strings+import qualified Hydra.Dsl.Mantle                           as Mantle+import qualified Hydra.Dsl.Module                           as Module+import           Hydra.Dsl.Phantoms                         as Phantoms+import qualified Hydra.Dsl.TTerms                           as TTerms+import qualified Hydra.Dsl.TTypes                           as TTypes+import qualified Hydra.Dsl.Tabular                          as Tabular+import qualified Hydra.Dsl.Terms                            as Terms+import qualified Hydra.Dsl.Topology                         as Topology+import qualified Hydra.Dsl.Types                            as Types+import qualified Hydra.Dsl.Typing                           as Typing+import qualified Hydra.Sources.Kernel.Types.All             as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+import           Prelude hiding ((++))+import qualified Data.Int                                   as I+import qualified Data.List                                  as L+import qualified Data.Map                                   as M+import qualified Data.Set                                   as S+import qualified Data.Maybe                                 as Y+++module_ :: Module+module_ = Module (Namespace "hydra.ext.org.json.language")+  [el jsonLanguageDef]+  [Rewriting.module_]+  KernelTypes.kernelTypesModules $+  Just "Language constraints for JSON"++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++jsonLanguageDef :: TBinding Language+jsonLanguageDef = define "jsonLanguage" $+  doc "Language constraints for JSON" $ lets [+  "eliminationVariants">: Sets.empty,+  "literalVariants">: Sets.fromList $ list [+    Mantle.literalVariantBoolean,+    Mantle.literalVariantFloat,+    Mantle.literalVariantInteger,+    Mantle.literalVariantString],+  "floatTypes">: Sets.fromList $ list [Core.floatTypeBigfloat],+  "functionVariants">: Sets.empty,+  "integerTypes">: Sets.fromList $ list [Core.integerTypeBigint],+    -- Note: TermVariantUnit is excluded because JSON null is used for optionals+  "termVariants">: Sets.fromList $ list [+    Mantle.termVariantList,+    Mantle.termVariantLiteral,+    Mantle.termVariantMap,+    Mantle.termVariantOptional,+    Mantle.termVariantRecord],+    -- Note: TypeVariantUnit is excluded because JSON null is used for optionals+  "typeVariants">: Sets.fromList $ list [+    Mantle.typeVariantList,+    Mantle.typeVariantLiteral,+    Mantle.typeVariantMap,+    Mantle.typeVariantOptional,+    Mantle.typeVariantRecord],+  "typePredicate">: lambda "typ" $ cases _Type (ref Rewriting.deannotateTypeDef @@ var "typ")+    (Just true) [+    _Type_optional>>: lambda "innerType" $+      cases _Type (var "innerType")+        (Just true) [+        _Type_optional>>: constant false]]] $+  Coders.language+    (Coders.languageName "hydra.ext.org.json")+    (Coders.languageConstraints+      (var "eliminationVariants")+      (var "literalVariants")+      (var "floatTypes")+      (var "functionVariants")+      (var "integerTypes")+      (var "termVariants")+      (var "typeVariants")+      (var "typePredicate"))
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Adapt/Literals.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Adapt.Literals where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Describe.Core as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.adapt.literals") elements+    [ExtractCore.module_, Monads.module_, DescribeCore.module_, AdaptUtils.module_, ShowCore.module_, Variants.module_]+    kernelTypesModules $+    Just "Adapter framework for literal types and terms"+  where+   elements = [+     el comparePrecisionDef,+     el convertFloatValueDef,+     el convertIntegerValueDef,+     el disclaimerDef,+     el literalAdapterDef,+     el floatAdapterDef,+     el integerAdapterDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++comparePrecisionDef :: TBinding (Precision -> Precision -> Comparison)+comparePrecisionDef = define "comparePrecision" $+  doc "Compare two precision values" $+  lambdas ["p1", "p2"] $+    cases _Precision (var "p1") Nothing [+      _Precision_arbitrary>>: constant $+        cases _Precision (var "p2") Nothing [+          _Precision_arbitrary>>: constant Graph.comparisonEqualTo,+          _Precision_bits>>: constant Graph.comparisonGreaterThan],+      _Precision_bits>>: lambda "b1" $+        cases _Precision (var "p2") Nothing [+          _Precision_arbitrary>>: constant Graph.comparisonLessThan,+          _Precision_bits>>: lambda "b2" $+            Logic.ifElse (Equality.lt (var "b1") (var "b2"))+              Graph.comparisonLessThan+              Graph.comparisonGreaterThan]]++convertFloatValueDef :: TBinding (FloatType -> FloatValue -> FloatValue)+convertFloatValueDef = define "convertFloatValue" $+  doc "Convert a float value to a different float type" $+  lambdas ["target", "fv"] $ lets [+    "decoder">: lambda "fv" $+      cases _FloatValue (var "fv") Nothing [+        _FloatValue_bigfloat>>: lambda "d" $ var "d",+        _FloatValue_float32>>: lambda "f" $ Literals.float32ToBigfloat $ var "f",+        _FloatValue_float64>>: lambda "d" $ Literals.float64ToBigfloat $ var "d"],+    "encoder">: lambda "d" $+      cases _FloatType (var "target") Nothing [+        _FloatType_bigfloat>>: constant $ Core.floatValueBigfloat $ var "d",+        _FloatType_float32>>: constant $ Core.floatValueFloat32 $ Literals.bigfloatToFloat32 $ var "d",+        _FloatType_float64>>: constant $ Core.floatValueFloat64 $ Literals.bigfloatToFloat64 $ var "d"]]+    $ var "encoder" @@ (var "decoder" @@ var "fv")++convertIntegerValueDef :: TBinding (IntegerType -> IntegerValue -> IntegerValue)+convertIntegerValueDef = define "convertIntegerValue" $+  doc "Convert an integer value to a different integer type" $+  lambdas ["target", "iv"] $ lets [+    "decoder">: lambda "iv" $+      cases _IntegerValue (var "iv") Nothing [+        _IntegerValue_bigint>>: lambda "v" $ var "v",+        _IntegerValue_int8>>: lambda "v" $ Literals.int8ToBigint $ var "v",+        _IntegerValue_int16>>: lambda "v" $ Literals.int16ToBigint $ var "v",+        _IntegerValue_int32>>: lambda "v" $ Literals.int32ToBigint $ var "v",+        _IntegerValue_int64>>: lambda "v" $ Literals.int64ToBigint $ var "v",+        _IntegerValue_uint8>>: lambda "v" $ Literals.uint8ToBigint $ var "v",+        _IntegerValue_uint16>>: lambda "v" $ Literals.uint16ToBigint $ var "v",+        _IntegerValue_uint32>>: lambda "v" $ Literals.uint32ToBigint $ var "v",+        _IntegerValue_uint64>>: lambda "v" $ Literals.uint64ToBigint $ var "v"],+    "encoder">: lambda "d" $+      cases _IntegerType (var "target") Nothing [+        _IntegerType_bigint>>: constant $ Core.integerValueBigint $ var "d",+        _IntegerType_int8>>: constant $ Core.integerValueInt8 $ Literals.bigintToInt8 $ var "d",+        _IntegerType_int16>>: constant $ Core.integerValueInt16 $ Literals.bigintToInt16 $ var "d",+        _IntegerType_int32>>: constant $ Core.integerValueInt32 $ Literals.bigintToInt32 $ var "d",+        _IntegerType_int64>>: constant $ Core.integerValueInt64 $ Literals.bigintToInt64 $ var "d",+        _IntegerType_uint8>>: constant $ Core.integerValueUint8 $ Literals.bigintToUint8 $ var "d",+        _IntegerType_uint16>>: constant $ Core.integerValueUint16 $ Literals.bigintToUint16 $ var "d",+        _IntegerType_uint32>>: constant $ Core.integerValueUint32 $ Literals.bigintToUint32 $ var "d",+        _IntegerType_uint64>>: constant $ Core.integerValueUint64 $ Literals.bigintToUint64 $ var "d"]]+    $ var "encoder" @@ (var "decoder" @@ var "iv")++disclaimerDef :: TBinding (Bool -> String -> String -> String)+disclaimerDef = define "disclaimer" $+  doc "Generate a disclaimer message for type conversions" $+  lambdas ["lossy", "source", "target"] $+    Strings.cat $ list [+      string "replace ",+      var "source",+      string " with ",+      var "target",+      Logic.ifElse (var "lossy") (string " (lossy)") (string "")]++literalAdapterDef :: TBinding (LiteralType -> Flow AdapterContext (SymmetricAdapter s LiteralType Literal))+literalAdapterDef = define "literalAdapter" $+  doc "Create an adapter for literal types" $+  lambda "lt" $ lets [+    "alts">: lambda "t" $ cases _LiteralType (var "t") Nothing [+      _LiteralType_binary>>: constant $ lets [+        "step">: Compute.coder+          (lambda "lit" $ cases _Literal (var "lit") Nothing [+            _Literal_binary>>: lambda "b" $ Flows.pure $ Core.literalString $ Literals.binaryToString $ var "b"])+          (lambda "lit" $ cases _Literal (var "lit") Nothing [+            _Literal_string>>: lambda "s" $ Flows.pure $ Core.literalBinary $ Literals.stringToBinary $ var "s"])] $+        Flows.pure $ list [Compute.adapter false (var "t") Core.literalTypeString (var "step")],+      _LiteralType_boolean>>: constant $+        bind "cx" (ref Monads.getStateDef) $ lets [+        "constraints">: Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx",+        "hasIntegers">: Logic.not $ Sets.null $ Coders.languageConstraintsIntegerTypes $ var "constraints",+        "hasStrings">: Sets.member Mantle.literalVariantString (Coders.languageConstraintsLiteralVariants $ var "constraints")] $+        Logic.ifElse (var "hasIntegers")+          (bind "adapter" (ref integerAdapterDef @@ Core.integerTypeUint8) $ lets [+            "step'">: Compute.adapterCoder $ var "adapter",+            "step">: Compute.coder+              (lambda "lit" $ cases _Literal (var "lit") Nothing [+                _Literal_boolean>>: lambda "bv" $ Flows.bind+                  (Compute.coderEncode (var "step'") @@ (Core.integerValueUint8 $ Logic.ifElse (var "bv") (uint8 1) (uint8 0)))+                  (lambda "iv" $ Flows.pure $ Core.literalInteger $ var "iv")])+              (lambda "lit" $ cases _Literal (var "lit") Nothing [+                _Literal_integer>>: lambda "iv" $ Flows.bind+                  (Compute.coderDecode (var "step'") @@ var "iv")+                  (lambda "val" $ cases _IntegerValue (var "val") Nothing [+                    _IntegerValue_uint8>>: lambda "v" $ Flows.pure $ Core.literalBoolean $ Equality.equal (var "v") (uint8 1)])])] $+            Flows.pure $ list [Compute.adapter false (var "t") (Core.literalTypeInteger $ Compute.adapterTarget $ var "adapter") (var "step")])+          (Logic.ifElse (var "hasStrings")+            (Flows.pure $ lets [+              "encode">: lambda "lit" $+                bind "b" (ref ExtractCore.booleanLiteralDef @@ var "lit") $+                Flows.pure $ Core.literalString $ Logic.ifElse (var "b") "true" "false",+              "decode">: lambda "lit" $+                bind "s" (ref ExtractCore.stringLiteralDef @@ var "lit") $+                Logic.ifElse (Equality.equal (var "s") (string "true"))+                  (Flows.pure $ Core.literalBoolean true)+                  (Logic.ifElse (Equality.equal (var "s") (string "false"))+                    (Flows.pure $ Core.literalBoolean false)+                    (ref Monads.unexpectedDef @@ "boolean literal" @@ var "s"))] $+              list [Compute.adapter false (var "t") Core.literalTypeString (Compute.coder (var "encode") (var "decode"))])+            (Flows.fail $ string "no alternatives available for boolean encoding")),+      _LiteralType_float>>: lambda "ft" $+        Flows.bind (ref Monads.getStateDef) $ lambda "cx" $ lets [+          "constraints">: Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx",+          "hasFloats">: Logic.not $ Sets.null $ Coders.languageConstraintsFloatTypes $ var "constraints"] $+        Logic.ifElse (var "hasFloats")+          (Flows.bind (ref floatAdapterDef @@ var "ft") $ lambda "adapter" $ lets [+            "step">: ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "l"] $+              cases _Literal (var "l") (Just $ ref Monads.unexpectedDef @@ string "floating-point literal" @@ (ref ShowCore.literalDef @@ var "l")) [+                _Literal_float>>: lambda "fv" $ Flows.map (unaryFunction Core.literalFloat) $+                  ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "adapter") @@ var "fv"])] $+            Flows.pure $ list [Compute.adapter (Compute.adapterIsLossy $ var "adapter") (var "t") (Core.literalTypeFloat $ Compute.adapterTarget $ var "adapter") (var "step")])+          (Flows.fail $ string "no float types available"),+      _LiteralType_integer>>: lambda "it" $+        Flows.bind (ref Monads.getStateDef) $ lambda "cx" $ lets [+          "constraints">: Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx",+          "hasIntegers">: Logic.not $ Sets.null $ Coders.languageConstraintsIntegerTypes $ var "constraints"] $+        Logic.ifElse (var "hasIntegers")+          (Flows.bind (ref integerAdapterDef @@ var "it") $ lambda "adapter" $ lets [+            "step">: ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "lit"] $+              cases _Literal (var "lit") (Just $ ref Monads.unexpectedDef @@ string "integer literal" @@ (ref ShowCore.literalDef @@ var "lit")) [+                _Literal_integer>>: lambda "iv" $ Flows.map (unaryFunction Core.literalInteger) $+                  ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "adapter") @@ var "iv"])] $+            Flows.pure $ list [Compute.adapter (Compute.adapterIsLossy $ var "adapter") (var "t") (Core.literalTypeInteger $ Compute.adapterTarget $ var "adapter") (var "step")])+          (Flows.fail $ string "no integer types available"),+      _LiteralType_string>>: constant $ Flows.fail $ string "no substitute for the literal string type"]] $+  Flows.bind (ref Monads.getStateDef) $ lambda "cx" $ lets [+    "supported">: ref AdaptUtils.literalTypeIsSupportedDef @@ (Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx")] $+  ref AdaptUtils.chooseAdapterDef+    @@ var "alts"+    @@ var "supported"+    @@ ref ShowCore.literalTypeDef+    @@ ref DescribeCore.literalTypeDef+    @@ var "lt"++floatAdapterDef :: TBinding (FloatType -> Flow AdapterContext (SymmetricAdapter s FloatType FloatValue))+floatAdapterDef = define "floatAdapter" $+  doc "Create an adapter for float types" $+  lambda "ft" $ lets [+      "alts">: lambda "t" $ Flows.mapList (var "makeAdapter" @@ var "t") $ cases _FloatType (var "t") Nothing [+        _FloatType_bigfloat>>: constant $ list [Core.floatTypeFloat64, Core.floatTypeFloat32],+        _FloatType_float32>>: constant $ list [Core.floatTypeFloat64, Core.floatTypeBigfloat],+        _FloatType_float64>>: constant $ list [Core.floatTypeBigfloat, Core.floatTypeFloat32]],+      "makeAdapter">: lambdas ["source", "target"] $ lets [+          "lossy">: Equality.equal+            (ref comparePrecisionDef+              @@ (ref Variants.floatTypePrecisionDef @@ var "source")+              @@ (ref Variants.floatTypePrecisionDef @@ var "target"))+            Graph.comparisonGreaterThan,+          "step">: Compute.coder+            (lambda "fv" $ Flows.pure $ ref convertFloatValueDef @@ var "target" @@ var "fv")+            (lambda "fv" $ Flows.pure $ ref convertFloatValueDef @@ var "source" @@ var "fv"),+          "msg">: ref disclaimerDef+            @@ var "lossy"+            @@ (ref DescribeCore.floatTypeDef @@ var "source")+            @@ (ref DescribeCore.floatTypeDef @@ var "target")] $+        ref Monads.warnDef+          @@ var "msg"+          @@ (Flows.pure (Compute.adapter (var "lossy") (var "source") (var "target") (var "step")))] $+    Flows.bind (ref Monads.getStateDef) $ lambda "cx" $+      lets [+        "supported">: ref AdaptUtils.floatTypeIsSupportedDef+          @@ (Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx")] $+      ref AdaptUtils.chooseAdapterDef+        @@ var "alts"+        @@ var "supported"+        @@ ref ShowCore.floatTypeDef+        @@ ref DescribeCore.floatTypeDef+        @@ var "ft"++integerAdapterDef :: TBinding (IntegerType -> Flow AdapterContext (SymmetricAdapter s IntegerType IntegerValue))+integerAdapterDef = define "integerAdapter" $+  doc "Create an adapter for integer types" $+  lambda "it" $ lets [+    "interleave">: lambdas ["xs", "ys"] $ Lists.concat $ Lists.transpose $ list [var "xs", var "ys"],+    "signedOrdered">: Lists.filter+      (lambda "v" $ Logic.and+        (ref Variants.integerTypeIsSignedDef @@ var "v")+        (Logic.not $ Equality.equal (ref Variants.integerTypePrecisionDef @@ var "v") Mantle.precisionArbitrary))+      (ref Variants.integerTypesDef),+    "unsignedOrdered">: Lists.filter+      (lambda "v" $ Logic.and+        (Logic.not $ ref Variants.integerTypeIsSignedDef @@ var "v")+        (Logic.not $ Equality.equal (ref Variants.integerTypePrecisionDef @@ var "v") Mantle.precisionArbitrary))+      (ref Variants.integerTypesDef),+    "signedPref">: var "interleave" @@ var "signedOrdered" @@ var "unsignedOrdered",+    "unsignedPref">: var "interleave" @@ var "unsignedOrdered" @@ var "signedOrdered",+    "signedNonPref">: Lists.reverse $ var "unsignedPref",+    "unsignedNonPref">: Lists.reverse $ var "signedPref",+    "signed">: lambda "i" $ Lists.concat $ list [+      Lists.drop (Math.mul (var "i") (int32 2)) (var "signedPref"),+      list [Core.integerTypeBigint],+      Lists.drop (Math.add (Math.sub (int32 8) (Math.mul (var "i") (int32 2))) (int32 1)) (var "signedNonPref")],+    "unsigned">: lambda "i" $ Lists.concat $ list [+      Lists.drop (Math.mul (var "i") (int32 2)) (var "unsignedPref"),+      list [Core.integerTypeBigint],+      Lists.drop (Math.add (Math.sub (int32 8) (Math.mul (var "i") (int32 2))) (int32 1)) (var "unsignedNonPref")],+    "alts">: lambda "t" $ Flows.mapList (var "makeAdapter" @@ var "t") $ cases _IntegerType (var "t") Nothing [+      _IntegerType_bigint>>: constant $ Lists.reverse $ var "unsignedPref",+      _IntegerType_int8>>: constant $ var "signed" @@ int32 1,+      _IntegerType_int16>>: constant $ var "signed" @@ int32 2,+      _IntegerType_int32>>: constant $ var "signed" @@ int32 3,+      _IntegerType_int64>>: constant $ var "signed" @@ int32 4,+      _IntegerType_uint8>>: constant $ var "unsigned" @@ int32 1,+      _IntegerType_uint16>>: constant $ var "unsigned" @@ int32 2,+      _IntegerType_uint32>>: constant $ var "unsigned" @@ int32 3,+      _IntegerType_uint64>>: constant $ var "unsigned" @@ int32 4],+    "makeAdapter">: lambdas ["source", "target"] $ lets [+      "lossy">: Logic.not $ Equality.equal+        (ref comparePrecisionDef+          @@ (ref Variants.integerTypePrecisionDef @@ var "source")+          @@ (ref Variants.integerTypePrecisionDef @@ var "target"))+        Graph.comparisonLessThan,+      "step">: Compute.coder+        (lambda "iv" $ Flows.pure $ ref convertIntegerValueDef @@ var "target" @@ var "iv")+        (lambda "iv" $ Flows.pure $ ref convertIntegerValueDef @@ var "source" @@ var "iv"),+      "msg">: ref disclaimerDef+        @@ var "lossy"+        @@ (ref DescribeCore.integerTypeDef @@ var "source")+        @@ (ref DescribeCore.integerTypeDef @@ var "target")] $+      ref Monads.warnDef+        @@ var "msg"+        @@ (Flows.pure $ Compute.adapter (var "lossy") (var "source") (var "target") (var "step"))] $+  Flows.bind (ref Monads.getStateDef) $ lambda "cx" $+    lets [+      "supported">: ref AdaptUtils.integerTypeIsSupportedDef+        @@ (Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx")] $+    ref AdaptUtils.chooseAdapterDef+      @@ var "alts"+      @@ var "supported"+      @@ ref ShowCore.integerTypeDef+      @@ ref DescribeCore.integerTypeDef+      @@ var "it"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Adapt/Modules.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Adapt.Modules where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Decode.Core as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Core as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas as Schemas+++module_ :: Module+module_ = Module (Namespace "hydra.adapt.modules") elements+    [AdaptTerms.module_, AdaptUtils.module_, Annotations.module_, DecodeCore.module_, DescribeCore.module_,+      Lexical.module_, Monads.module_, Rewriting.module_, Schemas.module_]+    kernelTypesModules $+    Just "Entry point for Hydra's adapter (type/term rewriting) framework"+  where+   elements = [+     el adaptTypeToLanguageAndEncodeDef,+     el adaptTypeToLanguageDef,+     el adaptedModuleDefinitionsDef,+     el constructCoderDef,+     el languageAdapterDef,+     el transformModuleDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++adaptTypeToLanguageAndEncodeDef :: TBinding (Language -> (Type -> Flow Graph t) -> Type -> Flow Graph t)+adaptTypeToLanguageAndEncodeDef = define "adaptTypeToLanguageAndEncode" $+  doc "Given a target language, an encoding function, and a type, adapt and encode the type" $+  lambdas ["lang", "enc", "typ"] $+    cases _Type (ref Rewriting.deannotateTypeDef @@ var "typ")+      (Just $ bind "adaptedType" (ref adaptTypeToLanguageDef @@ var "lang" @@ var "typ") $+        var "enc" @@ var "adaptedType") [+      _Type_variable>>: constant (var "enc" @@ var "typ")]++adaptTypeToLanguageDef :: TBinding (Language -> Type -> Flow Graph Type)+adaptTypeToLanguageDef = define "adaptTypeToLanguage" $+  doc "Given a target language and a source type, find the target type to which the latter will be adapted" $+  lambdas ["lang", "typ"] $+    bind "adapter" (ref languageAdapterDef @@ var "lang" @@ var "typ") $+      Flows.pure $ Compute.adapterTarget $ var "adapter"++constructCoderDef :: TBinding (Language -> (Term -> Flow Graph c) -> Type -> Flow Graph (Coder Graph Graph Term c))+constructCoderDef = define "constructCoder" $+  doc "Given a target language, a unidirectional last-mile encoding, and a source type, construct a unidirectional adapting coder for terms of that type" $+  lambdas ["lang", "encodeTerm", "typ"] $+  trace (Strings.cat2 (string "coder for ") (ref DescribeCore.typeDef @@ var "typ")) $+  bind "adapter" (ref languageAdapterDef @@ var "lang" @@ var "typ") $+  Flows.pure $ ref AdaptUtils.composeCodersDef+    @@ (Compute.adapterCoder $ var "adapter")+    @@ (ref AdaptUtils.unidirectionalCoderDef @@ var "encodeTerm")++languageAdapterDef :: TBinding (Language -> Type -> Flow Graph (SymmetricAdapter Graph Type Term))+languageAdapterDef = define "languageAdapter" $+  doc "Given a target language and a source type, produce an adapter, which rewrites the type and its terms according to the language's constraints" $+  lambdas ["lang", "typ"] $+    bind "g" (ref Monads.getStateDef) $ lets [+      "cx0">: Coders.adapterContext (var "g") (var "lang") Maps.empty] $+    bind "result" (ref Monads.withStateDef @@ var "cx0" @@+      (bind "ad" (ref AdaptTerms.termAdapterDef @@ var "typ") $+       bind "cx" (ref Monads.getStateDef) $+       Flows.pure $ pair (var "ad") (var "cx"))) $ lets [+      "adapter">: first $ var "result",+      "cx">: second $ var "result",+      "encode">: lambda "term" $ ref Monads.withStateDef @@ var "cx" @@+        (Compute.coderEncode (Compute.adapterCoder $ var "adapter") @@ var "term"),+      "decode">: lambda "term" $ ref Monads.withStateDef @@ var "cx" @@+        (Compute.coderDecode (Compute.adapterCoder $ var "adapter") @@ var "term"),+      "ac">: Compute.coder (var "encode") (var "decode")] $+    Flows.pure $ Compute.adapterWithCoder (var "adapter") (var "ac")++transformModuleDef :: TBinding (Language -> (Term -> Flow Graph e) -> (Module -> M.Map Type (Coder Graph Graph Term e) -> [(Binding, TypedTerm)] -> Flow Graph d) -> Module -> Flow Graph d)+transformModuleDef = define "transformModule" $+  doc "Given a target language, a unidirectional last mile encoding, and an intermediate helper function, transform a given module into a target representation" $+  lambdas ["lang", "encodeTerm", "createModule", "mod"] $+  trace (Strings.cat2 (string "transform module ") (unwrap _Namespace @@ (Module.moduleNamespace $ var "mod"))) $ lets [+  "els">: Module.moduleElements $ var "mod",+  "codersFor">: lambda "types" $+    bind "cdrs" (Flows.mapList (ref constructCoderDef @@ var "lang" @@ var "encodeTerm") (var "types")) $+    Flows.pure $ Maps.fromList $ Lists.zip (var "types") (var "cdrs")] $+  bind "tterms" (ref Lexical.withSchemaContextDef @@ (Flows.mapList (ref Schemas.elementAsTypedTermDef) (var "els"))) $ lets [+  "types">: Lists.nub $ Lists.map (unaryFunction Core.typedTermType) (var "tterms")] $+  bind "coders" (var "codersFor" @@ var "types") $+  var "createModule" @@ var "mod" @@ var "coders" @@ (Lists.zip (var "els") (var "tterms"))++adaptedModuleDefinitionsDef :: TBinding (Language -> Module -> Flow Graph [Definition])+adaptedModuleDefinitionsDef = define "adaptedModuleDefinitions" $+  doc "Map a Hydra module to a list of type and/or term definitions which have been adapted to the target language" $+  lambdas ["lang", "mod"] $ lets [+    "els">: Module.moduleElements $ var "mod",+    "adaptersFor">: lambda "types" $+      bind "adapters" (Flows.mapList (ref languageAdapterDef @@ var "lang") (var "types")) $+      Flows.pure $ Maps.fromList $ Lists.zip (var "types") (var "adapters"),+    "classify">: lambdas ["adapters", "pair"] $ lets [+      "el">: first $ var "pair",+      "tt">: second $ var "pair",+      "term">: Core.typedTermTerm $ var "tt",+      "typ">: Core.typedTermType $ var "tt",+      "name">: Core.bindingName $ var "el"] $+      Logic.ifElse (ref Annotations.isNativeTypeDef @@ var "el")+        (bind "adaptedTyp" (bind "coreTyp" (ref DecodeCore.typeDef @@ var "term") $ ref adaptTypeToLanguageDef @@ var "lang" @@ var "coreTyp") $+         Flows.pure $ Module.definitionType $ Module.typeDefinition (var "name") (var "adaptedTyp"))+        (Optionals.maybe+          (Flows.fail $ Strings.cat2 (string "no adapter for element ") (unwrap _Name @@ var "name"))+          (lambda "adapter" $+            bind "adapted" (Compute.coderEncode (Compute.adapterCoder $ var "adapter") @@ var "term") $+            Flows.pure $ Module.definitionTerm $ Module.termDefinition (var "name") (var "adapted") (Compute.adapterTarget $ var "adapter"))+          (Maps.lookup (var "typ") (var "adapters")))] $+  bind "tterms" (ref Lexical.withSchemaContextDef @@ (Flows.mapList (ref Schemas.elementAsTypedTermDef) (var "els"))) $+  lets ["types">: Sets.toList $ Sets.fromList $ Lists.map (ref Rewriting.deannotateTypeDef <.> unaryFunction Core.typedTermType) (var "tterms")] $+  bind "adapters" (var "adaptersFor" @@ var "types") $+  Flows.mapList (var "classify" @@ var "adapters") $ Lists.zip (var "els") (var "tterms")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Adapt/Simple.hs view
@@ -0,0 +1,407 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Adapt.Simple where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Decode.Core as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Inference as Inference+import qualified Hydra.Sources.Kernel.Terms.Literals as Lits+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Reduction as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas as Schemas+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.adapt.simple") elements+    [DecodeCore.module_, Inference.module_, Lits.module_, Monads.module_, Reduction.module_, Rewriting.module_, Schemas.module_,+      ShowCore.module_, ShowGraph.module_, Variants.module_]+    kernelTypesModules $+    Just "Simple, one-way adapters for types and terms"+  where+    elements = [+      el adaptFloatTypeDef,+      el adaptDataGraphDef,+      el adaptGraphSchemaDef,+      el adaptIntegerTypeDef,+      el adaptLiteralDef,+      el adaptLiteralTypeDef,+      el adaptLiteralTypesMapDef,+      el adaptLiteralValueDef,+      el adaptPrimitiveDef,+      el adaptTermDef,+      el adaptTypeDef,+      el adaptTypeSchemeDef,+      el dataGraphToDefinitionsDef,+      el literalTypeSupportedDef,+      el schemaGraphToDefinitionsDef,+      el termAlternativesDef,+      el typeAlternativesDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++adaptFloatTypeDef :: TBinding (LanguageConstraints -> FloatType -> Maybe FloatType)+adaptFloatTypeDef = define "adaptFloatType" $+  doc "Attempt to adapt a floating-point type using the given language constraints" $+  "constraints" ~> "ft" ~>+  "supported" <~ Sets.member (var "ft") (Coders.languageConstraintsFloatTypes $ var "constraints") $+  "alt" <~ (ref adaptFloatTypeDef @@ var "constraints") $+  Logic.ifElse (var "supported")+    (just $ var "ft")+    (cases _FloatType (var "ft")+      Nothing [+      _FloatType_bigfloat>>: constant nothing,+      _FloatType_float32>>: constant $ var "alt" @@ Core.floatTypeFloat64,+      _FloatType_float64>>: constant $ var "alt" @@ Core.floatTypeBigfloat])++adaptDataGraphDef :: TBinding (LanguageConstraints -> Bool -> Graph -> Flow s Graph)+adaptDataGraphDef = define "adaptDataGraph" $+  doc "Adapt a graph and its schema to the given language constraints, prior to inference" $+  "constraints" ~> "doExpand" ~> "graph0" ~>+  "litmap" <~ ref adaptLiteralTypesMapDef @@ var "constraints" $+  "els0" <~ Graph.graphElements (var "graph0") $+  "env0" <~ Graph.graphEnvironment (var "graph0") $+  "body0" <~ Graph.graphBody (var "graph0") $+  "prims0" <~ Graph.graphPrimitives (var "graph0") $+  "schema0" <~ Graph.graphSchema (var "graph0") $+  "schema1" <<~ optCases (var "schema0")+    (produce nothing)+--    ("sg" ~> Flows.fail $ "schema graph: " ++ (ref ShowGraph.graphDef @@ var "sg")) $+    ( "sg" ~>+      "tmap0" <<~ ref Schemas.graphAsTypesDef @@ var "sg" $+      "tmap1" <<~ ref adaptGraphSchemaDef @@ var "constraints" @@ var "litmap" @@ var "tmap0" $+      "emap" <~ ref Schemas.typesToElementsDef @@ var "tmap1" $+      produce $ just $ Graph.graphWithElements (var "sg") (var "emap")) $+  "gterm0" <~ ref Schemas.graphAsTermDef @@ var "graph0" $+  "gterm1" <~ Logic.ifElse (var "doExpand")+    (ref Reduction.expandLambdasDef @@ var "graph0" @@ var "gterm0")+    (var "gterm0") $+  "gterm2" <<~ ref adaptTermDef @@ var "constraints" @@ var "litmap" @@ var "gterm1" $+  "els1" <~ ref Schemas.termAsGraphDef @@ var "gterm2" $+  "prims1" <<~ Flows.mapElems (ref adaptPrimitiveDef @@ var "constraints" @@ var "litmap") (var "prims0") $+--  Flows.fail $ "adapted data graph: " ++ (ref ShowCore.termDef @@ var "gterm2")+--  Flows.fail $ "schema graph: " ++ (optCases (var "schema1")+--    ("none")+--    ("sg" ~> ref ShowGraph.graphDef @@ var "sg"))+  produce $ Graph.graph+    (var "els1")+    (var "env0")+    Maps.empty+    Core.termUnit+    (var "prims1")+    (var "schema1")++adaptGraphSchemaDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType -> M.Map Name Type -> Flow s (M.Map Name Type))+adaptGraphSchemaDef = define "adaptGraphSchema" $+  doc "Adapt a schema graph to the given language constraints" $+  "constraints" ~> "litmap" ~> "types0" ~>+  "mapPair" <~ ("pair" ~>+    "name" <~ first (var "pair") $+    "typ" <~ second (var "pair") $+    "typ1" <<~ ref adaptTypeDef @@ var "constraints" @@ var "litmap" @@ var "typ" $+    produce $ pair (var "name") (var "typ1")) $+  "pairs" <<~ Flows.mapList (var "mapPair") (Maps.toList $ var "types0") $+  produce $ Maps.fromList (var "pairs")++adaptIntegerTypeDef :: TBinding (LanguageConstraints -> IntegerType -> Maybe IntegerType)+adaptIntegerTypeDef = define "adaptIntegerType" $+  doc "Attempt to adapt an integer type using the given language constraints" $+  "constraints" ~> "it" ~>+  "supported" <~ Sets.member (var "it") (Coders.languageConstraintsIntegerTypes $ var "constraints") $+  "alt" <~ (ref adaptIntegerTypeDef @@ var "constraints") $+  Logic.ifElse (var "supported")+    (just $ var "it")+    (cases _IntegerType (var "it")+      Nothing [+      _IntegerType_bigint>>: constant nothing,+      _IntegerType_int8>>: constant $ var "alt" @@ Core.integerTypeUint16,+      _IntegerType_int16>>: constant $ var "alt" @@ Core.integerTypeUint32,+      _IntegerType_int32>>: constant $ var "alt" @@ Core.integerTypeUint64,+      _IntegerType_int64>>: constant $ var "alt" @@ Core.integerTypeBigint,+      _IntegerType_uint8>>: constant $ var "alt" @@ Core.integerTypeInt16,+      _IntegerType_uint16>>: constant $ var "alt" @@ Core.integerTypeInt32,+      _IntegerType_uint32>>: constant $ var "alt" @@ Core.integerTypeInt64,+      _IntegerType_uint64>>: constant $ var "alt" @@ Core.integerTypeBigint])++adaptLiteralDef :: TBinding (LiteralType -> Literal -> Literal)+adaptLiteralDef = define "adaptLiteral" $+  doc "Convert a literal to a different type" $+  "lt" ~> "l" ~>+  cases _Literal (var "l")+    Nothing [+    _Literal_binary>>: "b" ~> cases _LiteralType (var "lt")+      Nothing [+      _LiteralType_string>>: constant $ Core.literalString $ Literals.binaryToString $ var "b"],+    _Literal_boolean>>: "b" ~> cases _LiteralType (var "lt")+      Nothing [+      _LiteralType_integer>>: "it" ~> Core.literalInteger $+        ref Lits.bigintToIntegerValueDef @@ var "it" @@ Logic.ifElse (var "b") (bigint 1) (bigint 0)],+    _Literal_float>>: "f" ~> cases _LiteralType (var "lt")+      Nothing [+      _LiteralType_float>>: "ft" ~> Core.literalFloat $+        ref Lits.bigfloatToFloatValueDef @@ var "ft" @@ (ref Lits.floatValueToBigfloatDef @@ var "f")],+    _Literal_integer>>: "i" ~> cases _LiteralType (var "lt")+      Nothing [+      _LiteralType_integer>>: "it" ~> Core.literalInteger $+        ref Lits.bigintToIntegerValueDef @@ var "it" @@ (ref Lits.integerValueToBigintDef @@ var "i")]]++adaptLiteralTypeDef :: TBinding (LanguageConstraints -> LiteralType -> Maybe LiteralType)+adaptLiteralTypeDef = define "adaptLiteralType" $+  doc "Attempt to adapt a literal type using the given language constraints" $+  "constraints" ~> "lt" ~>+  Logic.ifElse (ref literalTypeSupportedDef @@ var "constraints" @@ var "lt")+    nothing+    (cases _LiteralType (var "lt")+      (Just nothing) [+      _LiteralType_binary>>: constant $ just Core.literalTypeString,+      _LiteralType_boolean>>: constant $ Optionals.map (unaryFunction Core.literalTypeInteger) $+          ref adaptIntegerTypeDef @@ var "constraints" @@ Core.integerTypeInt8,+      _LiteralType_float>>: "ft" ~> Optionals.map (unaryFunction Core.literalTypeFloat) $+        ref adaptFloatTypeDef @@ var "constraints" @@ var "ft",+      _LiteralType_integer>>: "it" ~> Optionals.map (unaryFunction Core.literalTypeInteger) $+        ref adaptIntegerTypeDef @@ var "constraints" @@ var "it"])++adaptLiteralTypesMapDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType)+adaptLiteralTypesMapDef = define "adaptLiteralTypesMap" $+  doc "Derive a map of adapted literal types for the given language constraints" $+  "constraints" ~>+  "tryType" <~ ("lt" ~> optCases (ref adaptLiteralTypeDef @@ var "constraints" @@ var "lt")+    nothing+    ("lt2" ~> just $ pair (var "lt") (var "lt2"))) $+  Maps.fromList $ Optionals.cat $ Lists.map (var "tryType") (ref Variants.literalTypesDef)++adaptLiteralValueDef :: TBinding (M.Map LiteralType LiteralType -> LiteralType -> Literal -> Literal)+adaptLiteralValueDef = define "adaptLiteralValue" $+  doc "Adapt a literal value using the given language constraints" $+  "litmap" ~> "lt" ~> "l" ~> optCases (Maps.lookup (var "lt") (var "litmap"))+    (Core.literalString $ ref ShowCore.literalDef @@ var "l")+    ("lt2" ~> ref adaptLiteralDef @@ var "lt2" @@ var "l")++adaptPrimitiveDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType -> Primitive -> Flow s Primitive)+adaptPrimitiveDef = define "adaptPrimitive" $+  doc "Adapt a primitive to the given language constraints, prior to inference" $+  "constraints" ~> "litmap" ~> "prim0" ~>+  "ts0" <~ Graph.primitiveType (var "prim0") $+  "ts1" <<~ ref adaptTypeSchemeDef @@ var "constraints" @@ var "litmap" @@ var "ts0" $+  produce $ Graph.primitiveWithType (var "prim0") (var "ts1")++-- Note: this function could be made more efficient through precomputation of alternatives,+--       similar to what is done for literals.+adaptTermDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType -> Term -> Flow Graph Term)+adaptTermDef = define "adaptTerm" $+  doc "Adapt a term using the given language constraints" $+  "constraints" ~> "litmap" ~> "term0" ~>+  "rewrite" <~ ("recurse" ~> "term0" ~>+    "term1" <<~ var "recurse" @@ var "term0" $+    "tryTerm" <~ ("term" ~>+      "supportedVariant" <~ Sets.member+        (ref Variants.termVariantDef @@ var "term")+        (Coders.languageConstraintsTermVariants $ var "constraints") $+      Logic.ifElse (var "supportedVariant")+        (cases _Term (var "term")+          (Just $ produce $ just $ var "term") [+          _Term_literal>>: "l" ~>+            "lt" <~ ref Variants.literalTypeDef @@ var "l" $+            produce $ just $ Logic.ifElse (ref literalTypeSupportedDef @@ var "constraints" @@ var "lt")+              (var "term")+              (Core.termLiteral $ ref adaptLiteralValueDef @@ var "litmap" @@ var "lt" @@ var "l")])+        ("tryAlts" <~ ("alts" ~> Logic.ifElse (Lists.null $ var "alts")+          (produce nothing)+          ( "mterm" <<~ var "tryTerm" @@ Lists.head (var "alts") $+            optCases (var "mterm")+              (var "tryAlts" @@ Lists.tail (var "alts"))+              ("t" ~> produce $ just $ var "t"))) $+           "alts" <<~ ref termAlternativesDef @@ var "term1" $+           var "tryAlts" @@ var "alts")) $+    "mterm" <<~ var "tryTerm" @@ var "term1" $+    optCases (var "mterm")+      (Flows.fail $ "no alternatives for term: " ++ (ref ShowCore.termDef @@ var "term1"))+      ("term2" ~> produce $ var "term2")) $+  ref Rewriting.rewriteTermMDef @@ var "rewrite" @@ var "term0"++adaptTypeDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType -> Type -> Flow s Type)+adaptTypeDef = define "adaptType" $+  doc "Adapt a type using the given language constraints" $+  "constraints" ~> "litmap" ~> "type0" ~>+  "rewrite" <~ ("recurse" ~> "typ" ~>+    "type1" <<~ var "recurse" @@ var "typ" $+    "tryType" <~ ("typ" ~>+      "supportedVariant" <~ Sets.member+        (ref Variants.typeVariantDef @@ var "typ")+        (Coders.languageConstraintsTypeVariants $ var "constraints") $+      Logic.ifElse (var "supportedVariant")+        (cases _Type (var "typ")+          (Just $ just $ var "typ") [+          _Type_literal>>: "lt" ~> Logic.ifElse (ref literalTypeSupportedDef @@ var "constraints" @@ var "lt")+            (just $ var "typ")+            (optCases (Maps.lookup (var "lt") (var "litmap"))+              (just $ Core.typeLiteral Core.literalTypeString)+              ("lt2" ~> just $ Core.typeLiteral $ var "lt2"))])+        ("tryAlts" <~ ("alts" ~> Logic.ifElse (Lists.null $ var "alts")+          nothing+          ( optCases (var "tryType" @@ Lists.head (var "alts"))+              (var "tryAlts" @@ Lists.tail (var "alts"))+              ("t" ~> just $ var "t"))) $+           "alts" <~ ref typeAlternativesDef @@ var "type1" $+           var "tryAlts" @@ var "alts")) $+    optCases (var "tryType" @@ var "type1")+      (Flows.fail $ "no alternatives for type: " ++ (ref ShowCore.typeDef @@ var "typ"))+      ("type2" ~> produce $ var "type2")) $+  ref Rewriting.rewriteTypeMDef @@ var "rewrite" @@ var "type0"++adaptTypeSchemeDef :: TBinding (LanguageConstraints -> M.Map LiteralType LiteralType -> TypeScheme -> Flow s TypeScheme)+adaptTypeSchemeDef = define "adaptTypeScheme" $+  doc "Adapt a type scheme to the given language constraints, prior to inference" $+  "constraints" ~> "litmap" ~> "ts0" ~>+  "vars0" <~ Core.typeSchemeVariables (var "ts0") $+  "t0" <~ Core.typeSchemeType (var "ts0") $+  "t1" <<~ ref adaptTypeDef @@ var "constraints" @@ var "litmap" @@ var "t0" $+  produce $ Core.typeScheme (var "vars0") (var "t1")++dataGraphToDefinitionsDef :: TBinding (LanguageConstraints -> Bool -> Graph -> [[Name]] -> Flow s (Graph, [[TermDefinition]]))+dataGraphToDefinitionsDef = define "dataGraphToDefinitions" $+  doc ("Given a data graph along with language constraints and a designated list of element names,"+    <> " adapt the graph to the language constraints, perform inference,"+    <> " then return a corresponding term definition for each element name.") $+  "constraints" ~> "doExpand" ~> "graph" ~> "nameLists" ~>+  "graph1" <<~ ref adaptDataGraphDef @@ var "constraints" @@ var "doExpand" @@ var "graph" $+--  Flows.fail ("adapted graph: " ++ (ref ShowGraph.graphDef @@ var "graph1"))+  "graph2" <<~ ref Inference.inferGraphTypesDef @@ var "graph1" $+  "toDef" <~ ("el" ~>+    "ts" <~ Optionals.fromJust (Core.bindingType $ var "el") $+    Module.termDefinition+      (Core.bindingName $ var "el")+      (Core.bindingTerm $ var "el")+      (ref Schemas.typeSchemeToFTypeDef @@ var "ts")) $+  produce $ pair+    (var "graph2")+    (Lists.map+      ("names" ~> Lists.map (var "toDef") $+        Lists.map ("n" ~> Optionals.fromJust $ Maps.lookup (var"n") (Graph.graphElements $ var "graph2")) (var "names"))+      (var "nameLists"))++literalTypeSupportedDef :: TBinding (LanguageConstraints -> LiteralType -> Bool)+literalTypeSupportedDef = define "literalTypeSupported" $+  doc "Check if a literal type is supported by the given language constraints" $+  "constraints" ~> "lt" ~>+  Logic.ifElse+    (Sets.member+      (ref Variants.literalTypeVariantDef @@ var "lt")+      (Coders.languageConstraintsLiteralVariants $ var "constraints"))+    (cases _LiteralType (var "lt")+      (Just true) [+        _LiteralType_float>>: "ft" ~> Sets.member (var "ft") (Coders.languageConstraintsFloatTypes $ var "constraints"),+        _LiteralType_integer>>: "it" ~> Sets.member (var "it") (Coders.languageConstraintsIntegerTypes $ var "constraints")])+    false++schemaGraphToDefinitionsDef :: TBinding (LanguageConstraints -> Graph -> [[Name]] -> Flow s (M.Map Name Type, [[TypeDefinition]]))+schemaGraphToDefinitionsDef = define "schemaGraphToDefinitions" $+  doc ("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.") $+  "constraints" ~> "graph" ~> "nameLists" ~>+  "litmap" <~ ref adaptLiteralTypesMapDef @@ var "constraints" $+  "tmap0" <<~ ref Schemas.graphAsTypesDef @@ var "graph" $+  "tmap1" <<~ ref adaptGraphSchemaDef @@ var "constraints" @@ var "litmap" @@ var "tmap0" $+  "toDef" <~ ("pair" ~> Module.typeDefinition (first $ var "pair") (second $ var "pair")) $+  produce $ pair+    (var "tmap1")+    (Lists.map+      ("names" ~> Lists.map (var "toDef") $+        Lists.map ("n" ~> pair (var "n") (Optionals.fromJust $ Maps.lookup (var "n") (var "tmap1"))) (var "names"))+      (var "nameLists"))++termAlternativesDef :: TBinding (Term -> Flow Graph [Term])+termAlternativesDef = define "termAlternatives" $+  doc "Find a list of alternatives for a given term, if any" $+  "term" ~> cases _Term (var "term")+    (Just $ produce $ list []) [+    _Term_annotated>>: "at" ~>+      "term2" <~ Core.annotatedTermSubject (var "at") $+      produce $ list [+        var "term2"], -- TODO: lossy+    _Term_optional>>: "ot" ~> produce $ list [+      Core.termList $ optCases (var "ot")+        (list [])+        ("term2" ~> list [var "term2"])],+    -- Note: no type abstractions or type applications, as we are not expecting System F terms here+    _Term_union>>: "inj" ~>+      "tname" <~ Core.injectionTypeName (var "inj") $+      "field" <~ Core.injectionField (var "inj") $+      "fname" <~ Core.fieldName (var "field") $+      "fterm" <~ Core.fieldTerm (var "field") $+      "rt" <<~ ref Schemas.requireUnionTypeDef @@ var "tname" $+      produce $ list [+        "forFieldType" <~ ("ft" ~>+          "ftname" <~ Core.fieldTypeName (var "ft") $+          Core.field (var "fname") $ Core.termOptional $ Logic.ifElse (Equality.equal (var "ftname") (var "fname"))+            (just $ var "fterm")+            (nothing)) $+        "fields" <~ Lists.map (var "forFieldType") (Core.rowTypeFields $ var "rt") $+        Core.termRecord $ Core.record (var "tname") (var "fields")],+    _Term_unit>>: constant $ produce $ list [+      Core.termLiteral $ Core.literalBoolean true],+    _Term_wrap>>: "wt" ~>+      "term2" <~ Core.wrappedTermObject (var "wt") $+      produce $ list [+         var "term2"]]++typeAlternativesDef :: TBinding (Type -> [Type])+typeAlternativesDef = define "typeAlternatives" $+  doc "Find a list of alternatives for a given type, if any" $+  "type" ~> cases _Type (var "type")+    (Just $ list []) [+    _Type_annotated>>: "at" ~>+      "type2" <~ Core.annotatedTypeSubject (var "at") $+       list [var "type2"], -- TODO: lossy+    _Type_optional>>: "ot" ~> list [+      Core.typeList $ var "ot"],+    _Type_union>>: "rt" ~>+      "tname" <~ Core.rowTypeTypeName (var "rt") $+      "fields" <~ Core.rowTypeFields (var "rt") $+      list [+        Core.typeRecord $ Core.rowType (var "tname") (var "fields")],+    _Type_unit>>: constant $ list [+      Core.typeLiteral $ Core.literalTypeBoolean]]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Adapt/Terms.hs view
@@ -0,0 +1,764 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Adapt.Terms where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Describe.Core as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Literals as Lits+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas as Schemas+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.adapt.terms") elements+    [ExtractCore.module_, AdaptLiterals.module_, Lits.module_, Rewriting.module_,+      Schemas.module_, ShowCore.module_]+    kernelTypesModules $+    Just "Adapter framework for types and terms"+  where+    elements = [+      el fieldAdapterDef,+      el forTypeReferenceDef,+      el functionProxyNameDef,+      el functionProxyTypeDef,+      el functionToUnionDef,+      el lambdaToMonotypeDef,+      el optionalToListDef,+      el passApplicationDef,+      el passFunctionDef,+      el passForallDef,+      el passLiteralDef,+      el passListDef,+      el passMapDef,+      el passOptionalDef,+      el passProductDef,+      el passRecordDef,+      el passSetDef,+      el passSumDef,+      el passUnionDef,+      el passUnitDef,+      el passWrappedDef,+      el setToListDef,+      el simplifyApplicationDef,+      el termAdapterDef,+      el unionToRecordDef,+      el unionTypeToRecordTypeDef,+      el unitToRecordDef,+      el wrapToUnwrappedDef,+      el withGraphContextDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++fieldAdapterDef :: TBinding (FieldType -> Flow AdapterContext (SymmetricAdapter AdapterContext FieldType Field))+fieldAdapterDef = define "fieldAdapter" $+  doc "Create an adapter for field types" $+  lambda "ftyp" $+    Flows.bind (ref termAdapterDef @@ (Core.fieldTypeType $ var "ftyp")) $ lambda "ad" $+      Flows.pure $ Compute.adapter+        (Compute.adapterIsLossy $ var "ad")+        (var "ftyp")+        (Core.fieldType (Core.fieldTypeName $ var "ftyp") (Compute.adapterTarget $ var "ad"))+        (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "field"] $ lets [+          "name">: Core.fieldName $ var "field",+          "term">: Core.fieldTerm $ var "field"] $+          Flows.map (lambda "newTerm" $ Core.field (var "name") (var "newTerm")) $+            ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "term"))++forTypeReferenceDef :: TBinding (Name -> Flow AdapterContext (SymmetricAdapter AdapterContext Type Term))+forTypeReferenceDef = define "forTypeReference" $+  doc "This function accounts for recursive type definitions" $+  lambda "name" $+  trace (Strings.cat2 (string "adapt named type ") (unwrap _Name @@ var "name")) $ lets [+  "lossy">: false,+  "placeholder">: Compute.adapter (var "lossy") (Core.typeVariable $ var "name") (Core.typeVariable $ var "name") $+    ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+      bind "cx" (ref Monads.getStateDef) $ lets [+        "adapters">: Coders.adapterContextAdapters $ var "cx"] $+        Optionals.maybe+          (Flows.fail $ Strings.cat2 (string "no adapter for reference type ") (unwrap _Name @@ var "name"))+          (lambda "ad" $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "term")+          (Maps.lookup (var "name") (var "adapters")))] $+  bind "cx" (ref Monads.getStateDef) $ lets [+  "adapters">: Coders.adapterContextAdapters $ var "cx"] $+  Optionals.maybe+    (lets [+      "newAdapters">: Maps.insert (var "name") (var "placeholder") (var "adapters"),+      "newCx">: Coders.adapterContext+        (Coders.adapterContextGraph $ var "cx")+        (Coders.adapterContextLanguage $ var "cx")+        (var "newAdapters")] $+      Flows.bind (ref Monads.putStateDef @@ var "newCx") $ constant $+        bind "mt" (ref withGraphContextDef @@ (ref Schemas.resolveTypeDef @@ (Core.typeVariable $ var "name"))) $+          Optionals.maybe+            (Flows.pure $ Compute.adapter (var "lossy") (Core.typeVariable $ var "name") (Core.typeVariable $ var "name") $+              ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ Flows.pure $ var "term"))+            (lambda "t" $+              bind "actual" (ref termAdapterDef @@ var "t") $ lets [+                "finalAdapters">: Maps.insert (var "name") (var "actual") (var "adapters"),+                "finalCx">: Coders.adapterContext+                  (Coders.adapterContextGraph $ var "cx")+                  (Coders.adapterContextLanguage $ var "cx")+                  (var "finalAdapters")] $+              Flows.bind (ref Monads.putStateDef @@ var "finalCx") $ constant $ Flows.pure $ var "actual")+            (var "mt"))+    (unaryFunction Flows.pure)+    (Maps.lookup (var "name") (var "adapters"))++functionProxyNameDef :: TBinding Name+functionProxyNameDef = define "functionProxyName" $+  Core.name "hydra.core.FunctionProxy"++functionProxyTypeDef :: TBinding (a -> Type)+functionProxyTypeDef = define "functionProxyType" $+  doc "Generate a function proxy type for a given domain type" $+  constant $ Core.typeUnion $ Core.rowType (ref functionProxyNameDef) $ list [+    Core.fieldType (Core.nameLift _Elimination_wrap) TTypes.string,+    Core.fieldType (Core.nameLift _Elimination_record) TTypes.string,+    Core.fieldType (Core.nameLift _Elimination_union) TTypes.string,+    Core.fieldType (Core.nameLift _Function_lambda) TTypes.string,+    Core.fieldType (Core.nameLift _Function_primitive) TTypes.string,+    Core.fieldType (Core.nameLift _Term_variable) TTypes.string]++functionToUnionDef :: TBinding TypeAdapter+functionToUnionDef = define "functionToUnion" $+  doc "Convert function types to union types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_function>>: lambda "ft" $ lets [+      "dom">: Core.functionTypeDomain $ var "ft",+      "cod">: Core.functionTypeCodomain $ var "ft",+      "unionType">:+        bind "domAd" (ref termAdapterDef @@ var "dom") $+        Flows.pure $ Core.typeUnion $ Core.rowType (ref functionProxyNameDef) $ list [+          Core.fieldType (Core.nameLift _Elimination_wrap) TTypes.string,+          Core.fieldType (Core.nameLift _Elimination_record) TTypes.string,+          Core.fieldType (Core.nameLift _Elimination_union) TTypes.string,+          Core.fieldType (Core.nameLift _Function_lambda) TTypes.string,+          Core.fieldType (Core.nameLift _Function_primitive) TTypes.string,+          Core.fieldType (Core.nameLift _Term_variable) TTypes.string],+      "encode">: lambdas ["ad", "term"] $ lets [+        "strippedTerm">: ref Rewriting.deannotateTermDef @@ var "term"] $+        Compute.coderEncode (Compute.adapterCoder $ var "ad") @@ (cases _Term (var "strippedTerm") Nothing [+          _Term_function>>: lambda "f" $ cases _Function (var "f") Nothing [+            _Function_elimination>>: lambda "e" $ cases _Elimination (var "e") Nothing [+              _Elimination_wrap>>: lambda "name" $ Core.termUnion $ Core.injection (ref functionProxyNameDef) $+                Core.field (Core.nameLift _Elimination_wrap) $ TTerms.stringLift $ unwrap _Name @@ var "name",+              _Elimination_record>>: lambda "r" $ Core.termUnion $ Core.injection (ref functionProxyNameDef) $+                Core.field (Core.nameLift _Elimination_record) $ TTerms.stringLift (ref ShowCore.termDef @@ var "term"),+              _Elimination_union>>: lambda "u" $ Core.termUnion $ Core.injection (ref functionProxyNameDef) $+                Core.field (Core.nameLift _Elimination_union) $ TTerms.stringLift (ref ShowCore.termDef @@ var "term")],+            _Function_lambda>>: lambda "l" $ Core.termUnion $ Core.injection (ref functionProxyNameDef) $+              Core.field (Core.nameLift _Function_lambda) $ TTerms.stringLift (ref ShowCore.termDef @@ var "term"),+            _Function_primitive>>: lambda "name" $ Core.termUnion $ Core.injection (ref functionProxyNameDef) $+              Core.field (Core.nameLift _Function_primitive) $ TTerms.stringLift $ unwrap _Name @@ var "name"],+          _Term_variable>>: lambda "name" $+            Core.termUnion $ Core.injection (ref functionProxyNameDef) $ Core.field (Core.nameLift _Term_variable) $ TTerms.stringLift $ unwrap _Name @@ var "name"]),+      "decode">: lambdas ["ad", "term"] $ lets [+        "readFromString">: lambda "term" $+          bind "s" (ref ExtractCore.stringDef @@ var "term") $+            Optionals.maybe+              (Flows.fail $ Strings.cat2 ("failed to parse term: ") (var "s"))+              (unaryFunction Flows.pure)+              (ref ShowCore.readTermDef @@ var "s"),+        "notFound">: lambda "fname" $ Flows.fail $ Strings.cat2 (string "unexpected field: ") (unwrap _Name @@ var "fname"),+        "forCases">: lambda "fterm" $ ref withGraphContextDef @@ (var "readFromString" @@ var "fterm"),+        "forLambda">: lambda "fterm" $ ref withGraphContextDef @@ (var "readFromString" @@ var "fterm"),+        "forWrapped">: lambda "fterm" $ ref withGraphContextDef @@ (Flows.map (lambda "s" $ TTerms.unwrap $ Core.name $ var "s") (ref ExtractCore.stringDef @@ var "fterm")),+        "forPrimitive">: lambda "fterm" $ ref withGraphContextDef @@ (Flows.map (lambda "s" $ TTerms.primitiveLift $ Core.name $ var "s") (ref ExtractCore.stringDef @@ var "fterm")),+        "forProjection">: lambda "fterm" $ ref withGraphContextDef @@ (var "readFromString" @@ var "fterm"),+        "forVariable">: lambda "fterm" $ ref withGraphContextDef @@ (Flows.map (lambda "s" $ Core.termVariable $ Core.name $ var "s") (ref ExtractCore.stringDef @@ var "fterm"))] $+        bind "injTerm" (Compute.coderDecode (Compute.adapterCoder $ var "ad") @@ var "term") $+        bind "field" (ref withGraphContextDef @@ (ref ExtractCore.injectionDef @@ (ref functionProxyNameDef) @@ var "injTerm")) $ lets [+            "fname">: Core.fieldName $ var "field",+            "fterm">: Core.fieldTerm $ var "field"] $+            Optionals.fromMaybe (var "notFound" @@ var "fname") $ Maps.lookup (var "fname") $ Maps.fromList $ list [+              pair (Core.nameLift _Elimination_wrap) (var "forWrapped" @@ var "fterm"),+              pair (Core.nameLift _Elimination_record) (var "forProjection" @@ var "fterm"),+              pair (Core.nameLift _Elimination_union) (var "forCases" @@ var "fterm"),+              pair (Core.nameLift _Function_lambda) (var "forLambda" @@ var "fterm"),+              pair (Core.nameLift _Function_primitive) (var "forPrimitive" @@ var "fterm"),+              pair (Core.nameLift _Term_variable) (var "forVariable" @@ var "fterm")]] $+    bind "ut" (var "unionType") $+    bind "ad" (ref termAdapterDef @@ var "ut") $+    Flows.pure $ Compute.adapter+      (Compute.adapterIsLossy $ var "ad")+      (var "t")+      (Compute.adapterTarget $ var "ad")+      (Compute.coder (var "encode" @@ var "ad") (var "decode" @@ var "ad"))]++lambdaToMonotypeDef :: TBinding TypeAdapter+lambdaToMonotypeDef = define "lambdaToMonotype" $+  doc "Convert forall types to monotypes" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_forall>>: lambda "ft" $ lets [+        "body">: Core.forallTypeBody $ var "ft"] $+        bind "ad" (ref termAdapterDef @@ var "body") $+        Flows.pure $ Compute.adapter+          (Compute.adapterIsLossy $ var "ad")+          (var "t")+          (Compute.adapterTarget $ var "ad")+          (Compute.adapterCoder $ var "ad")]++optionalToListDef :: TBinding TypeAdapter+optionalToListDef = define "optionalToList" $+  doc "Convert optional types to list types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_optional>>: lambda "ot" $+      bind "ad" (ref termAdapterDef @@ var "ot") $ lets [+        "encode">: lambda "term" $ cases _Term (var "term") Nothing [+          _Term_optional>>: lambda "m" $ Optionals.maybe+            (Flows.pure $ TTerms.list [])+            (lambda "r" $+              bind "encoded" (Compute.coderEncode (Compute.adapterCoder $ var "ad") @@ var "r") $+              Flows.pure $ Core.termList $ list [var "encoded"])+            (var "m")],+        "decode">: lambda "term" $ cases _Term (var "term") Nothing [+          _Term_list>>: lambda "l" $ Flows.map (unaryFunction Core.termOptional) $ Logic.ifElse (Lists.null $ var "l")+            (Flows.pure $ nothing)+            (bind "decoded" (Compute.coderDecode (Compute.adapterCoder $ var "ad") @@ (Lists.head $ var "l")) $+              Flows.pure $ just $ var "decoded")]] $+      Flows.pure $ Compute.adapter+        false+        (var "t")+        (Core.typeList $ Compute.adapterTarget $ var "ad")+        (Compute.coder (var "encode") (var "decode"))]++passApplicationDef :: TBinding TypeAdapter+passApplicationDef = define "passApplication" $+  doc "Pass through application types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_application>>: lambda "at" $ lets [+        "lhs">: Core.applicationTypeFunction $ var "at",+        "rhs">: Core.applicationTypeArgument $ var "at"] $+        bind "lhsAd" (ref termAdapterDef @@ var "lhs") $+        bind "rhsAd" (ref termAdapterDef @@ var "rhs") $+        Flows.pure $ Compute.adapter+          (Logic.or (Compute.adapterIsLossy $ var "lhsAd") (Compute.adapterIsLossy $ var "rhsAd"))+          (var "t")+          (Core.typeApplication $ Core.applicationType (Compute.adapterTarget $ var "lhsAd") (Compute.adapterTarget $ var "rhsAd"))+          (ref AdaptUtils.bidirectionalDef @@+            (lambdas ["dir", "term"] $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "lhsAd") @@ var "term"))]++passFunctionDef :: TBinding TypeAdapter+passFunctionDef = define "passFunction" $+  doc "Pass through function types with adaptation" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_function >>: lambda "ft" $ lets [+      "dom">: Core.functionTypeDomain $ var "ft",+      "cod">: Core.functionTypeCodomain $ var "ft"] $+      bind "domAd" (ref termAdapterDef @@ var "dom") $+      bind "codAd" (ref termAdapterDef @@ var "cod") $+      bind "caseAds" (cases _Type (ref Rewriting.deannotateTypeDef @@ var "dom") (Just $ Flows.pure $ Maps.empty) [+        _Type_union >>: lambda "rt" $+          bind "pairs" (Flows.mapList+            (lambda "f" $+              bind "ad" (ref fieldAdapterDef @@ Core.fieldType+                (Core.fieldTypeName $ var "f")+                (Core.typeFunction $ Core.functionType+                  (Core.fieldTypeType $ var "f")+                  (var "cod")))+              $ Flows.pure $ pair (Core.fieldTypeName $ var "f") (var "ad"))+            (Core.rowTypeFields $ var "rt")) $+          Flows.pure $ Maps.fromList $ var "pairs"]) $+      bind "optionAd" (cases _Type (ref Rewriting.deannotateTypeDef @@ var "dom") (Just $ Flows.pure nothing) [+        _Type_optional >>: lambda "ot" $+          Flows.map (unaryFunction just) $ ref termAdapterDef @@ TTypes.function (var "ot") (var "cod")]) $ lets [+      "lossy">: Logic.or+        (Compute.adapterIsLossy $ var "codAd")+        (Logic.ors $ Lists.map (lambda "pair" $ Compute.adapterIsLossy $ second $ var "pair") $ Maps.toList $ var "caseAds"),+      "target">: TTypes.function (Compute.adapterTarget $ var "domAd") (Compute.adapterTarget $ var "codAd"),+      "getCoder">: lambda "fname" $ Optionals.maybe+        (ref AdaptUtils.idCoderDef)+        (unaryFunction Compute.adapterCoder)+        (Maps.lookup (var "fname") (var "caseAds"))] $+      Flows.pure $ Compute.adapter (var "lossy") (var "t") (var "target") $+        ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+          cases _Term (ref Rewriting.deannotateTermDef @@ var "term") (Just $ Flows.pure $ var "term") [+            _Term_function >>: lambda "f" $+              Flows.map (unaryFunction Core.termFunction) $+                cases _Function (var "f") Nothing [+                  _Function_elimination >>: lambda "e" $+                    Flows.map (unaryFunction Core.functionElimination) $+                      cases _Elimination (var "e") Nothing [+                        _Elimination_union >>: lambda "cs" $ lets [+                          "n">: Core.caseStatementTypeName $ var "cs",+                          "def">: Core.caseStatementDefault $ var "cs",+                          "cases">: Core.caseStatementCases $ var "cs"] $+                          bind "rcases" (Flows.mapList+                            (lambda "f" $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (var "getCoder" @@ Core.fieldName (var "f")) @@ var "f")+                            (var "cases")) $+                          bind "rdef" (Optionals.maybe+                            (Flows.pure nothing)+                            (lambda "d" $ Flows.map (unaryFunction just) $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ Compute.adapterCoder (var "codAd") @@ var "d")+                            (var "def")) $+                          Flows.pure $ Core.eliminationUnion $ Core.caseStatement (var "n") (var "rdef") (var "rcases")],+                  _Function_lambda >>: lambda "l" $ lets [+                    "var">: Core.lambdaParameter $ var "l",+                    "d" >: Core.lambdaDomain $ var "l",+                    "body">: Core.lambdaBody $ var "l"] $+                    bind "newBody" (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ Compute.adapterCoder (var "codAd") @@ var "body") $+                    Flows.pure $ Core.functionLambda $ Core.lambda (var "var") (var "d") (var "newBody"),+                  _Function_primitive >>: lambda "name" $ Flows.pure $ Core.functionPrimitive $ var "name"]]+         )]++passForallDef :: TBinding TypeAdapter+passForallDef = define "passForall" $+  doc "Pass through forall types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_forall>>: lambda "ft" $ lets [+        "v">: Core.forallTypeParameter $ var "ft",+        "body">: Core.forallTypeBody $ var "ft"] $+        Flows.bind (ref termAdapterDef @@ var "body") $ lambda "ad" $+          Flows.pure $ Compute.adapter+            (Compute.adapterIsLossy $ var "ad")+            (var "t")+            (Core.typeForall $ Core.forallType (var "v") (Compute.adapterTarget $ var "ad"))+            (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+              ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "term"))]++passLiteralDef :: TBinding TypeAdapter+passLiteralDef = define "passLiteral" $+  doc "Pass through literal types with literal adaptation" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_literal>>: lambda "lt" $+      bind "ad" (ref AdaptLiterals.literalAdapterDef @@ var "lt") $ lets [+      "step">: ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+        bind "l" (ref withGraphContextDef @@ (ref ExtractCore.literalDef @@ var "term")) $+        Flows.map (unaryFunction $ Core.termLiteral) (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "l"))] $+      Flows.pure $ Compute.adapter+        (Compute.adapterIsLossy $ var "ad")+        (Core.typeLiteral $ Compute.adapterSource $ var "ad")+        (Core.typeLiteral $ Compute.adapterTarget $ var "ad")+        (var "step")]++passListDef :: TBinding TypeAdapter+passListDef = define "passList" $+  doc "Pass through list types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_list>>: lambda "lt" $+      bind "ad" (ref termAdapterDef @@ var "lt") $+      Flows.pure $ Compute.adapter+        (Compute.adapterIsLossy $ var "ad")+        (var "t")+        (TTypes.list $ Compute.adapterTarget $ var "ad")+        (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+          _Term_list>>: lambda "terms" $+            bind "newTerms" (Flows.mapList (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad")) (var "terms")) $+            Flows.pure $ Core.termList $ var "newTerms"]))]++passMapDef :: TBinding TypeAdapter+passMapDef = define "passMap" $+  doc "Pass through map types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_map>>: lambda "mt" $ lets [+        "kt">: Core.mapTypeKeys $ var "mt",+        "vt">: Core.mapTypeValues $ var "mt"] $+          bind "kad" (ref termAdapterDef @@ var "kt") $+          bind "vad" (ref termAdapterDef @@ var "vt") $+          Flows.pure $ Compute.adapter+            (Logic.or (Compute.adapterIsLossy $ var "kad") (Compute.adapterIsLossy $ var "vad"))+            (var "t")+            (TTypes.map (Compute.adapterTarget $ var "kad") (Compute.adapterTarget $ var "vad"))+            (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+              _Term_map>>: lambda "m" $+                bind "newPairs" (Flows.mapList+                  (lambda "pair" $ lets [+                    "k">: first $ var "pair",+                    "v">: second $ var "pair"] $+                      bind "newK" (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "kad") @@ var "k") $+                      bind "newV" (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "vad") @@ var "v") $+                      Flows.pure $ pair (var "newK") (var "newV"))+                  (Maps.toList $ var "m")) $+                Flows.pure $ Core.termMap $ Maps.fromList $ var "newPairs"]))]++passOptionalDef :: TBinding TypeAdapter+passOptionalDef = define "passOptional" $+  doc "Pass through optional types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_optional>>: lambda "ot" $ lets [+      "mapTerm">: lambdas ["coder", "dir", "term"] $+        bind "opt" (ref withGraphContextDef @@ (ref ExtractCore.optionalDef @@ unaryFunction Flows.pure @@ var "term")) $+        bind "newOpt" (Flows.mapOptional (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ var "coder") (var "opt")) $+        Flows.pure $ Core.termOptional $ var "newOpt"] $+      bind "adapter" (ref termAdapterDef @@ var "ot") $+        Flows.pure $ Compute.adapter+          (Compute.adapterIsLossy $ var "adapter")+          (var "t")+          (Core.typeOptional $ Compute.adapterTarget $ var "adapter")+          (ref AdaptUtils.bidirectionalDef @@ (var "mapTerm" @@ (Compute.adapterCoder $ var "adapter")))]++passProductDef :: TBinding TypeAdapter+passProductDef = define "passProduct" $+  doc "Pass through product types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_product>>: lambda "types" $+      Flows.bind (Flows.mapList (ref termAdapterDef) (var "types")) $ lambda "ads" $ lets [+        "lossy">: Logic.ors $ Lists.map (unaryFunction Compute.adapterIsLossy) (var "ads")] $+        Flows.pure $ Compute.adapter+          (var "lossy")+          (var "t")+          (Core.typeProduct $ Lists.map (unaryFunction Compute.adapterTarget) (var "ads"))+          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+            _Term_product>>: lambda "tuple" $+              bind "newTuple" (Flows.sequence $ Lists.zipWith+                (lambdas ["term", "ad"] $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "term")+                (var "tuple")+                (var "ads")) $ Flows.pure $ Core.termProduct $ var "newTuple"]))]++passRecordDef :: TBinding TypeAdapter+passRecordDef = define "passRecord" $+  doc "Pass through record types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_record>>: lambda "rt" $+      bind "adapters" (Flows.mapList (ref fieldAdapterDef) (Core.rowTypeFields $ var "rt")) $ lets [+        "lossy">: Logic.ors $ Lists.map (unaryFunction Compute.adapterIsLossy) (var "adapters"),+        "sfields'">: Lists.map (unaryFunction Compute.adapterTarget) (var "adapters")] $+        Flows.pure $ Compute.adapter+          (var "lossy")+          (var "t")+          (Core.typeRecord $ Core.rowType (Core.rowTypeTypeName $ var "rt") (var "sfields'"))+          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+            _Term_record>>: lambda "rec" $ lets [+              "dfields">: Core.recordFields $ var "rec"] $+              bind "newFields" (Flows.sequence $ Lists.zipWith+                (lambdas ["ad", "f"] $ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "f" )+                (var "adapters")+                (var "dfields")) $+                Flows.pure $ Core.termRecord $ Core.record (Core.rowTypeTypeName $ var "rt") (var "newFields")]))]++passSetDef :: TBinding TypeAdapter+passSetDef = define "passSet" $+  doc "Pass through set types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_set>>: lambda "st" $+      Flows.bind (ref termAdapterDef @@ var "st") $ lambda "ad" $+        Flows.pure $ Compute.adapter+          (Compute.adapterIsLossy $ var "ad")+          (var "t")+          (TTypes.set $ Compute.adapterTarget $ var "ad")+          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+            _Term_set>>: lambda "terms" $+              bind "newTerms" (Flows.mapList (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad")) (Sets.toList $ var "terms")) $+              Flows.pure $ Core.termSet $ Sets.fromList $ var "newTerms"]))]++passSumDef :: TBinding TypeAdapter+passSumDef = define "passSum" $+  doc "Pass through sum types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_sum>>: lambda "types" $+      Flows.bind (Flows.mapList (ref termAdapterDef) (var "types")) $ lambda "ads" $ lets [+        "lossy">: Logic.ors $ Lists.map (unaryFunction Compute.adapterIsLossy) (var "ads")] $+        Flows.pure $ Compute.adapter+          (var "lossy")+          (var "t")+          (Core.typeSum $ Lists.map (unaryFunction Compute.adapterTarget) (var "ads"))+          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $ cases _Term (var "term") Nothing [+            _Term_sum>>: lambda "s" $ lets [+                "i">: Core.sumIndex $ var "s",+                "n">: Core.sumSize $ var "s",+                "term">: Core.sumTerm $ var "s"] $+                  bind "newTerm" (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ Lists.at (var "i") (var "ads")) @@ var "term") $+                    Flows.pure $ Core.termSum $ Core.sum (var "i") (var "n") (var "newTerm")]))]++passUnionDef :: TBinding TypeAdapter+passUnionDef = define "passUnion" $+  doc "Pass through union types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_union>>: lambda "rt" $ lets [+      "sfields">: Core.rowTypeFields $ var "rt",+      "tname">: Core.rowTypeTypeName $ var "rt",+      "getAdapter">: lambdas ["adaptersMap", "f"] $+        Optionals.maybe+          (Flows.fail $ Strings.cat2 (string "no such field: ") (unwrap _Name @@ (Core.fieldName $ var "f")))+          (unaryFunction Flows.pure)+          (Maps.lookup (Core.fieldName $ var "f") (var "adaptersMap"))] $+      bind "adapters" (Flows.mapList+          (lambda "f" $ Flows.bind (ref fieldAdapterDef @@ var "f") $ lambda "ad" $+            Flows.pure $ pair (Core.fieldTypeName $ var "f") (var "ad"))+          (var "sfields")) $ lets [+          "adaptersMap">: Maps.fromList $ var "adapters",+          "lossy">: Logic.ors $ Lists.map (lambda "pair" $ Compute.adapterIsLossy $ second $ var "pair") (var "adapters"),+          "sfields'">: Lists.map (lambda "pair" $ Compute.adapterTarget $ second $ var "pair") (var "adapters")] $+        Flows.pure $ Compute.adapter+          (var "lossy")+          (var "t")+          (Core.typeUnion $ Core.rowType (var "tname") (var "sfields'"))+          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+            -- Note: this is a shortcut, since we anticipate deprecating the current term adapter logic+            produce $ var "term"))]+          -- TODO: consider restoring the following+--          (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+--            "dfield" <<~ ref withGraphContextDef @@ (ref ExtractCore.injectionDef @@ var "tname" @@ var "term") $+--            "ad" <<~ var "getAdapter" @@ var "adaptersMap" @@ var "dfield" $+--            "newField" <<~ ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "dfield" $+--            produce $ Core.termUnion $ Core.injection (var "tname") (var "newField")))]++passUnitDef :: TBinding TypeAdapter+passUnitDef = define "passUnit" $+  doc "Pass through unit types" $+  constant $ Flows.pure $ Compute.adapter false Core.typeUnit Core.typeUnit $+    Compute.coder+      (constant $ Flows.pure Core.termUnit)+      (constant $ Flows.pure Core.termUnit)++passWrappedDef :: TBinding TypeAdapter+passWrappedDef = define "passWrapped" $+  doc "Pass through wrapped types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_wrap>>: lambda "wt" $ lets [+        "tname">: Core.wrappedTypeTypeName $ var "wt",+        "ot">: Core.wrappedTypeObject $ var "wt",+        "mapTerm">: lambdas ["coder", "dir", "term"] $+          bind "unwrapped" (ref withGraphContextDef @@ (ref ExtractCore.wrapDef @@ var "tname" @@ var "term")) $+          bind "newTerm" (ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ var "coder" @@ var "unwrapped") $+          Flows.pure $ Core.termWrap $ Core.wrappedTerm (var "tname") (var "newTerm")] $+        bind "adapter" (ref termAdapterDef @@ var "ot") $+          Flows.pure $ Compute.adapter+            (Compute.adapterIsLossy $ var "adapter")+            (var "t")+            (Core.typeWrap $ Core.wrappedType (var "tname") (Compute.adapterTarget $ var "adapter"))+            (ref AdaptUtils.bidirectionalDef @@ (var "mapTerm" @@ (Compute.adapterCoder $ var "adapter")))]++setToListDef :: TBinding TypeAdapter+setToListDef = define "setToList" $+  doc "Convert set types to list types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_set>>: lambda "st" $ lets [+      "encode">: lambda "ad" $ lambda "term" $ cases _Term (var "term") Nothing [+        _Term_set>>: lambda "s" $ Compute.coderEncode (Compute.adapterCoder $ var "ad") @@ (Core.termList $ Sets.toList $ var "s")],+      "decode">:+        lambdas ["ad", "term"] $+        bind "listTerm" (Compute.coderDecode (Compute.adapterCoder $ var "ad") @@ var "term") $+          cases _Term (var "listTerm") Nothing [+            _Term_list>>: lambda "l" $ Flows.pure $ Core.termSet $ Sets.fromList $ var "l"]] $+      bind "ad" (ref termAdapterDef @@ (TTypes.list $ var "st")) $+      Flows.pure $ Compute.adapter+        (Compute.adapterIsLossy $ var "ad")+        (var "t")+        (Compute.adapterTarget $ var "ad")+        (Compute.coder (var "encode" @@ var "ad") (var "decode" @@ var "ad"))]++simplifyApplicationDef :: TBinding TypeAdapter+simplifyApplicationDef = define "simplifyApplication" $+  doc "Simplify application types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_application>>: lambda "at" $ lets [+        "lhs">: Core.applicationTypeFunction $ var "at"] $+        bind "ad" (ref termAdapterDef @@ var "lhs") $+          Flows.pure $ Compute.adapter+            false+            (var "t")+            (Compute.adapterTarget $ var "ad")+            (ref AdaptUtils.bidirectionalDef @@ (lambdas ["dir", "term"] $+              ref AdaptUtils.encodeDecodeDef @@ var "dir" @@ (Compute.adapterCoder $ var "ad") @@ var "term"))]++unitToRecordDef :: TBinding TypeAdapter+unitToRecordDef = define "unitToRecord" $+    doc "Convert unit terms to records" $+    constant $ Flows.pure $+      Compute.adapter false Core.typeUnit (Core.typeRecord $ Core.rowType unitName $ list []) $+        Compute.coder+          (constant $ Flows.pure $ Core.termRecord $ Core.record unitName $ list [])+          (constant $ Flows.pure Core.termUnit)+  where+    unitName = Core.name $ string "_Unit"++unionToRecordDef :: TBinding TypeAdapter+unionToRecordDef = define "unionToRecord" $+  doc "Convert union types to record types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_union>>: lambda "rt" $ lets [+      "nm">: Core.rowTypeTypeName $ var "rt",+      "sfields">: Core.rowTypeFields $ var "rt",+      "target">: Core.typeRecord $ ref unionTypeToRecordTypeDef @@ var "rt",+      "toRecordField">: lambdas ["term", "fn", "f"] $ lets [+          "fn'">: Core.fieldTypeName $ var "f"] $+          Core.field (var "fn'") $ Core.termOptional $ Logic.ifElse+            (Equality.equal (var "fn'") (var "fn"))+            (just $ var "term")+            nothing,+      "fromRecordFields">: lambdas ["term", "term'", "t'", "fields"] $ lets [+        "matches">: Optionals.mapMaybe+          (lambda "field" $ lets [+              "fn">: Core.fieldName $ var "field",+              "fterm">: Core.fieldTerm $ var "field"] $+              cases _Term (var "fterm") Nothing [+                _Term_optional>>: lambda "opt" $ Optionals.bind (var "opt") $ lambda "t" $+                  just $ Core.field (var "fn") (var "t")])+          (var "fields")] $+        Logic.ifElse (Lists.null $ var "matches")+          (Flows.fail $ Strings.cat $ list [+            string "cannot convert term back to union: ",+            ref ShowCore.termDef @@ var "term",+            string " where type = ",+            ref ShowCore.typeDef @@ var "t",+            string "    and target type = ",+            ref ShowCore.typeDef @@ var "t'"])+          (Flows.pure $ Lists.head $ var "matches")] $+      bind "ad" (ref termAdapterDef @@ var "target") $+      Flows.pure $ Compute.adapter+        (Compute.adapterIsLossy $ var "ad")+        (var "t")+        (Compute.adapterTarget $ var "ad")+        (Compute.coder+          (lambda "term'" $+            bind "field" (ref withGraphContextDef @@ (ref ExtractCore.injectionDef @@ (Core.rowTypeTypeName $ var "rt") @@ var "term'")) $ lets [+              "fn">: Core.fieldName $ var "field",+              "term">: Core.fieldTerm $ var "field"] $+            Compute.coderEncode (Compute.adapterCoder $ var "ad") @@+              (Core.termRecord $ Core.record (var "nm") $ Lists.map (var "toRecordField" @@ var "term" @@ var "fn") (var "sfields")))+          (lambda "term" $+            bind "recTerm" (Compute.coderDecode (Compute.adapterCoder $ var "ad") @@ var "term") $+              cases _Term (var "recTerm") Nothing [+                _Term_record>>: lambda "rec" $ lets [+                  "fields">: Core.recordFields $ var "rec"] $+                  bind "resultField"+                    (var "fromRecordFields"+                      @@ var "term"+                      @@ (Core.termRecord $ Core.record (var "nm") (var "fields"))+                      @@ (Compute.adapterTarget $ var "ad")+                      @@ var "fields") $+                  Flows.pure $ Core.termUnion $ Core.injection (var "nm") (var "resultField")]))]++unionTypeToRecordTypeDef :: TBinding (RowType -> RowType)+unionTypeToRecordTypeDef = define "unionTypeToRecordType" $+  doc "Convert a union row type to a record row type" $+  lambda "rt" $ lets [+    "makeOptional">: lambda "f" $ lets [+        "fn">: Core.fieldTypeName $ var "f",+        "ft">: Core.fieldTypeType $ var "f"] $+        Core.fieldType (var "fn") $ ref Rewriting.mapBeneathTypeAnnotationsDef @@ unaryFunction Core.typeOptional @@ var "ft"] $+    Core.rowType (Core.rowTypeTypeName $ var "rt") $ Lists.map (var "makeOptional") (Core.rowTypeFields $ var "rt")++wrapToUnwrappedDef :: TBinding TypeAdapter+wrapToUnwrappedDef = define "wrapToUnwrapped" $+  doc "Convert wrapped types to unwrapped types" $+  lambda "t" $ cases _Type (var "t") Nothing [+    _Type_wrap>>: lambda "wt" $ lets [+        "tname">: Core.wrappedTypeTypeName $ var "wt",+        "typ">: Core.wrappedTypeObject $ var "wt",+        "encode">: lambda "ad" $ lambda "term" $+          bind "unwrapped" (ref withGraphContextDef @@ (ref ExtractCore.wrapDef @@ var "tname" @@ var "term")) $+          Compute.coderEncode (Compute.adapterCoder $ var "ad") @@ var "unwrapped",+        "decode">: lambda "ad" $ lambda "term" $+          bind "decoded" (Compute.coderDecode (Compute.adapterCoder $ var "ad") @@ var "term") $+          Flows.pure $ Core.termWrap $ Core.wrappedTerm (var "tname") (var "decoded")] $+        bind "ad" (ref termAdapterDef @@ var "typ") $+          Flows.pure $ Compute.adapter+            false+            (var "t")+            (Compute.adapterTarget $ var "ad")+            (Compute.coder (var "encode" @@ var "ad") (var "decode" @@ var "ad"))]++-- Note: those constructors which cannot be mapped meaningfully at this time are simply+--       preserved as strings.+termAdapterDef :: TBinding TypeAdapter+termAdapterDef = define "termAdapter" $+  doc "Create an adapter for any type" $+  "typ" ~> lets [+    "constraints">: "cx" ~> Coders.languageConstraintsProjection $ Coders.adapterContextLanguage $ var "cx",+    "supported">: "cx" ~> ref AdaptUtils.typeIsSupportedDef @@ (var "constraints" @@ var "cx"),+    "variantIsSupported">: "cx" ~> "t" ~>+      Sets.member (ref Variants.typeVariantDef @@ var "t") $ Coders.languageConstraintsTypeVariants $ var "constraints" @@ var "cx",+    "supportedAtTopLevel">: "cx" ~> "t" ~> Logic.and+      (var "variantIsSupported" @@ var "cx" @@ var "t")+      (Coders.languageConstraintsTypes (var "constraints" @@ var "cx") @@ var "t"),+    "pass">: "t" ~> cases _TypeVariant (ref Variants.typeVariantDef @@ (ref Rewriting.deannotateTypeDef @@ var "t")) Nothing [+      _TypeVariant_application>>: constant $ list [ref passApplicationDef],+      _TypeVariant_forall>>: constant $ list [ref passForallDef],+      _TypeVariant_function>>: constant $ list [ref passFunctionDef],+      _TypeVariant_list>>: constant $ list [ref passListDef],+      _TypeVariant_literal>>: constant $ list [ref passLiteralDef],+      _TypeVariant_map>>: constant $ list [ref passMapDef],+      _TypeVariant_optional>>: constant $ list [ref passOptionalDef, ref optionalToListDef],+      _TypeVariant_product>>: constant $ list [ref passProductDef],+      _TypeVariant_record>>: constant $ list [ref passRecordDef],+      _TypeVariant_set>>: constant $ list [ref passSetDef],+      _TypeVariant_sum>>: constant $ list [ref passSumDef],+      _TypeVariant_union>>: constant $ list [ref passUnionDef],+      _TypeVariant_unit>>: constant $ list [ref passUnitDef],+      _TypeVariant_wrap>>: constant $ list [ref passWrappedDef]],+    "trySubstitution">: "t" ~> cases _TypeVariant (ref Variants.typeVariantDef @@ var "t")+      Nothing [+      _TypeVariant_application>>: constant $ list [ref simplifyApplicationDef],+      _TypeVariant_function>>: constant $ list [ref functionToUnionDef],+      _TypeVariant_forall>>: constant $ list [ref lambdaToMonotypeDef],+      _TypeVariant_optional>>: constant $ list [ref optionalToListDef],+      _TypeVariant_set>>: constant $ list [ref setToListDef],+      _TypeVariant_union>>: constant $ list [ref unionToRecordDef],+      _TypeVariant_unit>>: constant $ list [ref unitToRecordDef],+      _TypeVariant_wrap>>: constant $ list [ref wrapToUnwrappedDef]],+    "alts">: "cx" ~> "t" ~> Flows.mapList ("c" ~> var "c" @@ var "t") $+       Logic.ifElse (var "supportedAtTopLevel" @@ var "cx" @@ var "t")+         (var "pass" @@ var "t")+         (var "trySubstitution" @@ var "t")] $+    cases _Type (var "typ")+      (Just $+        trace (Strings.cat2 (string "adapter for ") (ref DescribeCore.typeDef @@ var "typ")) $+        cases _Type (var "typ")+          (Just $+            bind "cx" (ref Monads.getStateDef) $+            ref AdaptUtils.chooseAdapterDef+              @@ (var "alts" @@ var "cx")+              @@ (var "supported" @@ var "cx")+              @@ ref ShowCore.typeDef+              @@ (ref DescribeCore.typeDef)+              @@ (var "typ")) [+          -- Account for let-bound variables+          _Type_variable>>: "name" ~> ref forTypeReferenceDef @@ var "name"]) [+      _Type_annotated>>: "at" ~>+        bind "ad" (ref termAdapterDef @@ Core.annotatedTypeSubject (var "at")) $+        Flows.pure (Compute.adapterWithTarget (var "ad") $+          Core.typeAnnotated $ Core.annotatedType (Compute.adapterTarget $ var "ad") (Core.annotatedTypeAnnotation $ var "at"))]++withGraphContextDef :: TBinding (Flow Graph a -> Flow AdapterContext a)+withGraphContextDef = define "withGraphContext" $+  doc "Execute a flow with graph context" $+  "f" ~>+  "cx" <<~ ref Monads.getStateDef $+  ref Monads.withStateDef @@ (Coders.adapterContextGraph $ var "cx") @@ var "f"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Adapt/Utils.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Adapt.Utils where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Formatting as Formatting+import qualified Hydra.Sources.Kernel.Terms.Names as Names+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.adapt.utils") elements+    [Names.module_, Rewriting.module_, Variants.module_, ShowCore.module_]+    kernelTypesModules $+    Just ("Additional adapter utilities, above and beyond the generated ones.")+  where+   elements = [+     el bidirectionalDef,+     el chooseAdapterDef,+     el composeCodersDef,+     el encodeDecodeDef,+     el floatTypeIsSupportedDef,+     el idAdapterDef,+     el idCoderDef,+     el integerTypeIsSupportedDef,+     el literalTypeIsSupportedDef,+     el nameToFilePathDef,+     el typeIsSupportedDef,+     el unidirectionalCoderDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++bidirectionalDef :: TBinding ((CoderDirection -> b -> Flow s b) -> Coder s s b b)+bidirectionalDef = define "bidirectional" $+  doc "Create a bidirectional coder from a direction-aware function" $+  lambda "f" $ Compute.coder (var "f" @@ Coders.coderDirectionEncode) (var "f" @@ Coders.coderDirectionDecode)++chooseAdapterDef :: TBinding ((t -> Flow so [SymmetricAdapter si t v]) -> (t -> Bool) -> (t -> String ) -> (t -> String) -> t -> Flow so (SymmetricAdapter si t v))+chooseAdapterDef = define "chooseAdapter" $+  doc "Choose an appropriate adapter for a type" $+  lambdas ["alts", "supported", "show", "describe", "typ"] $+    Logic.ifElse (var "supported" @@ var "typ")+      (Flows.pure $ Compute.adapter false (var "typ") (var "typ") (ref idCoderDef))+      (Flows.bind (var "alts" @@ var "typ") $+        lambda "raw" $ lets [+          "candidates">: Lists.filter (lambda "adapter" $ var "supported" @@ Compute.adapterTarget (var "adapter")) (var "raw")]+          $ Logic.ifElse (Lists.null $ var "candidates")+              (Flows.fail $ Strings.cat $ list [+                string "no adapters found for ",+                var "describe" @@ var "typ",+                Logic.ifElse (Lists.null $ var "raw")+                  (string "")+                  (Strings.cat $ list [+                    string " (discarded ",+                    Literals.showInt32 $ Lists.length $ var "raw",+                    string " unsupported candidate types: ",+                    ref ShowCore.listDef @@ var "show" @@ (Lists.map (unaryFunction Compute.adapterTarget) (var "raw")),+                    string ")"]),+                string ". Original type: ",+                var "show" @@ var "typ"])+              (Flows.pure $ Lists.head $ var "candidates"))++composeCodersDef :: TBinding (Coder s s a b -> Coder s s b c -> Coder s s a c)+composeCodersDef = define "composeCoders" $+  doc "Compose two coders" $+  lambda "c1" $ lambda "c2" $+    Compute.coder+      (lambda "a" $ Flows.bind (Compute.coderEncode (var "c1") @@ var "a") (Compute.coderEncode (var "c2")))+      (lambda "c" $ Flows.bind (Compute.coderDecode (var "c2") @@ var "c") (Compute.coderDecode (var "c1")))++encodeDecodeDef :: TBinding (CoderDirection -> Coder s s x x -> x -> Flow s x)+encodeDecodeDef = define "encodeDecode" $+  doc "Apply coder in the specified direction" $+  lambda "dir" $ lambda "coder" $+    match _CoderDirection Nothing [+      _CoderDirection_encode>>: constant $ Compute.coderEncode (var "coder"),+      _CoderDirection_decode>>: constant $ Compute.coderDecode (var "coder")]+    @@ var "dir"++floatTypeIsSupportedDef :: TBinding (LanguageConstraints -> FloatType -> Bool)+floatTypeIsSupportedDef = define "floatTypeIsSupported" $+  doc "Check if float type is supported by language constraints" $+  lambda "constraints" $ lambda "ft" $+    Sets.member (var "ft") (Coders.languageConstraintsFloatTypes $ var "constraints")++idAdapterDef :: TBinding (t -> SymmetricAdapter s t v)+idAdapterDef = define "idAdapter" $+  doc "Identity adapter" $+  lambda "t" $ Compute.adapter false (var "t") (var "t") (ref idCoderDef)++idCoderDef :: TBinding (Coder s s a a)+idCoderDef = define "idCoder" $+  doc "Identity coder" $+  Compute.coder (unaryFunction Flows.pure) (unaryFunction Flows.pure)++integerTypeIsSupportedDef :: TBinding (LanguageConstraints -> IntegerType -> Bool)+integerTypeIsSupportedDef = define "integerTypeIsSupported" $+  doc "Check if integer type is supported by language constraints" $+  lambda "constraints" $ lambda "it" $+    Sets.member (var "it") (Coders.languageConstraintsIntegerTypes $ var "constraints")++literalTypeIsSupportedDef :: TBinding (LanguageConstraints -> LiteralType -> Bool)+literalTypeIsSupportedDef = define "literalTypeIsSupported" $+  doc "Check if literal type is supported by language constraints" $+  lambda "constraints" $ lambda "lt" $+    Logic.and+      (Sets.member (ref Variants.literalTypeVariantDef @@ var "lt") (Coders.languageConstraintsLiteralVariants $ var "constraints"))+      (match _LiteralType (Just true) [+        _LiteralType_float>>: lambda "ft" $ ref floatTypeIsSupportedDef @@ var "constraints" @@ var "ft",+        _LiteralType_integer>>: lambda "it" $ ref integerTypeIsSupportedDef @@ var "constraints" @@ var "it"]+      @@ var "lt")++nameToFilePathDef :: TBinding (CaseConvention -> CaseConvention -> FileExtension -> Name -> FilePath)+nameToFilePathDef = define "nameToFilePath" $+  doc "Convert a name to file path, given case conventions for namespaces and local names, and assuming '/' as the file path separator" $+  lambda "nsConv" $ lambda "localConv" $ lambda "ext" $ lambda "name" $ lets [+    "qualName">: ref Names.qualifyNameDef @@ var "name",+    "ns">: Module.qualifiedNameNamespace $ var "qualName",+    "local">: Module.qualifiedNameLocal $ var "qualName",+    "nsToFilePath">: lambda "ns" $+      Strings.intercalate (string "/") $ Lists.map+        (lambda "part" $ ref Formatting.convertCaseDef @@ Mantle.caseConventionCamel @@ var "nsConv" @@ var "part")+        (Strings.splitOn (string ".") $ Module.unNamespace $ var "ns"),+    "prefix">: Optionals.maybe (string "")+      (lambda "n" $ Strings.cat2 (var "nsToFilePath" @@ var "n") (string "/"))+      (var "ns"),+    "suffix">: ref Formatting.convertCaseDef @@ Mantle.caseConventionPascal @@ var "localConv" @@ var "local"]+    $ Strings.cat $ list [var "prefix", var "suffix", string ".", Module.unFileExtension $ var "ext"]++typeIsSupportedDef :: TBinding (LanguageConstraints -> Type -> Bool)+typeIsSupportedDef = define "typeIsSupported" $+  doc "Check if type is supported by language constraints" $+  lambda "constraints" $ lambda "t" $ lets [+    "base">: ref Rewriting.deannotateTypeDef @@ var "t",+    "isSupportedVariant">: lambda "v" $+      Logic.or+        (cases _TypeVariant (var "v") (Just false) [_TypeVariant_variable>>: constant true])+        (Sets.member (var "v") (Coders.languageConstraintsTypeVariants $ var "constraints"))]+    $ Logic.and+        (Coders.languageConstraintsTypes (var "constraints") @@ var "base")+        (Logic.and+          (var "isSupportedVariant" @@ (ref Variants.typeVariantDef @@ var "base"))+          (match _Type Nothing [+            _Type_annotated>>: lambda "at" $ ref typeIsSupportedDef @@ var "constraints" @@ Core.annotatedTypeSubject (var "at"),+            _Type_application>>: lambda "app" $+              Logic.and+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.applicationTypeFunction (var "app"))+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.applicationTypeArgument (var "app")),+            _Type_forall>>: lambda "ft" $ ref typeIsSupportedDef @@ var "constraints" @@ Core.forallTypeBody (var "ft"),+            _Type_function>>: lambda "ft" $+              Logic.and+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.functionTypeDomain (var "ft"))+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.functionTypeCodomain (var "ft")),+            _Type_list>>: lambda "lt" $ ref typeIsSupportedDef @@ var "constraints" @@ var "lt",+            _Type_literal>>: lambda "at" $ ref literalTypeIsSupportedDef @@ var "constraints" @@ var "at",+            _Type_map>>: lambda "mt" $+              Logic.and+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.mapTypeKeys (var "mt"))+                (ref typeIsSupportedDef @@ var "constraints" @@ Core.mapTypeValues (var "mt")),+            _Type_optional>>: lambda "ot" $ ref typeIsSupportedDef @@ var "constraints" @@ var "ot",+            _Type_product>>: lambda "types" $+              andAll $ Lists.map (ref typeIsSupportedDef @@ var "constraints") (var "types"),+            _Type_record>>: lambda "rt" $+              andAll $ Lists.map+                (lambda "field" $ ref typeIsSupportedDef @@ var "constraints" @@ Core.fieldTypeType (var "field"))+                (Core.rowTypeFields $ var "rt"),+            _Type_set>>: lambda "st" $ ref typeIsSupportedDef @@ var "constraints" @@ var "st",+            _Type_sum>>: lambda "types" $+              andAll $ Lists.map (ref typeIsSupportedDef @@ var "constraints") (var "types"),+            _Type_union>>: lambda "rt" $+              andAll $ Lists.map+                (lambda "field" $ ref typeIsSupportedDef @@ var "constraints" @@ Core.fieldTypeType (var "field"))+                (Core.rowTypeFields $ var "rt"),+            _Type_unit>>: constant true,+            _Type_wrap>>: lambda "wt" $ ref typeIsSupportedDef @@ var "constraints" @@ Core.wrappedTypeObject (var "wt"),+            _Type_variable>>: constant true]+          @@ var "base"))+  where+    andAll = Lists.foldl (binaryFunction Logic.and) true++unidirectionalCoderDef :: TBinding ((a -> Flow s b) -> Coder s s a b)+unidirectionalCoderDef = define "unidirectionalCoder" $+  doc "Create a unidirectional coder" $+  lambda "m" $+    Compute.coder+      (var "m")+      (constant $ Flows.fail $ string "inbound mapping is unsupported")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/All.hs view
@@ -0,0 +1,85 @@+-- | All of Hydra's term-level kernel modules+module Hydra.Sources.Kernel.Terms.All where++import Hydra.Kernel++import qualified Hydra.Sources.Kernel.Terms.Adapt.Literals  as AdaptLiterals+import qualified Hydra.Sources.Kernel.Terms.Adapt.Modules   as AdaptModules+import qualified Hydra.Sources.Kernel.Terms.Adapt.Simple    as AdaptSimple+import qualified Hydra.Sources.Kernel.Terms.Adapt.Terms     as AdaptTerms+import qualified Hydra.Sources.Kernel.Terms.Adapt.Utils     as AdaptUtils+import qualified Hydra.Sources.Kernel.Terms.Annotations     as Annotations+import qualified Hydra.Sources.Kernel.Terms.Arity           as Arity+import qualified Hydra.Sources.Kernel.Terms.Constants       as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core     as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding        as Decoding+import qualified Hydra.Sources.Kernel.Terms.Describe.Core   as DescribeCore+import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Encode.Core     as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core    as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Mantle  as ExtractMantle+import qualified Hydra.Sources.Kernel.Terms.Formatting      as Formatting+import qualified Hydra.Sources.Kernel.Terms.Grammars        as Grammars+import qualified Hydra.Sources.Kernel.Terms.Inference       as Inference+import qualified Hydra.Sources.Kernel.Terms.Languages       as Languages+import qualified Hydra.Sources.Kernel.Terms.Lexical         as Lexical+import qualified Hydra.Sources.Kernel.Terms.Literals        as Literals+import qualified Hydra.Sources.Kernel.Terms.Monads          as Monads+import qualified Hydra.Sources.Kernel.Terms.Names           as Names+import qualified Hydra.Sources.Kernel.Terms.Reduction       as Reduction+import qualified Hydra.Sources.Kernel.Terms.Rewriting       as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas         as Schemas+import qualified Hydra.Sources.Kernel.Terms.Serialization   as Serialization+import qualified Hydra.Sources.Kernel.Terms.Show.Accessors  as ShowAccessors+import qualified Hydra.Sources.Kernel.Terms.Show.Core       as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph      as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle     as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing     as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting         as Sorting+import qualified Hydra.Sources.Kernel.Terms.Substitution    as Substitution+import qualified Hydra.Sources.Kernel.Terms.Tarjan          as Tarjan+import qualified Hydra.Sources.Kernel.Terms.Templates       as Templates+import qualified Hydra.Sources.Kernel.Terms.Unification     as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants        as Variants+++kernelTermsModules :: [Module]+kernelTermsModules = [+  AdaptLiterals.module_,+  AdaptModules.module_,+  AdaptSimple.module_,+  AdaptTerms.module_,+  AdaptUtils.module_,+  Annotations.module_,+  Arity.module_,+  Constants.module_,+  DecodeCore.module_,+  Decoding.module_,+  DescribeCore.module_,+  DescribeMantle.module_,+  EncodeCore.module_,+  ExtractCore.module_,+  ExtractMantle.module_,+  Formatting.module_,+  Grammars.module_,+  Inference.module_,+  Languages.module_,+  Lexical.module_,+  Literals.module_,+  Monads.module_,+  Names.module_,+  Reduction.module_,+  Rewriting.module_,+  Schemas.module_,+  Serialization.module_,+  ShowAccessors.module_,+  ShowCore.module_,+  ShowGraph.module_,+  ShowMantle.module_,+  ShowTyping.module_,+  Sorting.module_,+  Substitution.module_,+  Tarjan.module_,+  Templates.module_,+  Unification.module_,+  Variants.module_]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Annotations.hs view
@@ -0,0 +1,462 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Annotations where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Constants as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Decoding as Decoding+import qualified Hydra.Sources.Kernel.Terms.Encode.Core as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.annotations") elements+    [Decoding.module_, DecodeCore.module_, EncodeCore.module_, ExtractCore.module_, Lexical.module_, ShowCore.module_,+      Variants.module_, Monads.module_]+    kernelTypesModules $+    Just "Utilities for reading and writing type and term annotations"+  where+   elements = [+     el aggregateAnnotationsDef,+     el debugIfDef,+     el failOnFlagDef,+     el getDebugIdDef,+     el getAttrDef,+     el getAttrWithDefaultDef,+     el getCountDef,+     el getDescriptionDef,+     el getTermAnnotationDef,+     el getTermDescriptionDef,+     el getTypeDef,+     el getTypeAnnotationDef,+     el getTypeClassesDef,+     el getTypeDescriptionDef,+     el isNativeTypeDef,+     el hasDescriptionDef,+     el hasFlagDef,+     el hasTypeDescriptionDef,+     el nextCountDef,+     el normalizeTermAnnotationsDef,+     el normalizeTypeAnnotationsDef,+     el putAttrDef,+     el putCountDef,+     el resetCountDef,+     el setAnnotationDef,+     el setDescriptionDef,+     el setTermAnnotationDef,+     el setTermDescriptionDef,+     el setTypeDef,+     el setTypeAnnotationDef,+     el setTypeClassesDef,+     el setTypeDescriptionDef,+     el termAnnotationInternalDef,+     el typeAnnotationInternalDef,+     el typeElementDef,+     el whenFlagDef,+     el unshadowVariablesDef,+     el withDepthDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++aggregateAnnotationsDef :: TBinding ((x -> Maybe y) -> (y -> x) -> (y -> M.Map Name Term) -> x -> M.Map Name Term)+aggregateAnnotationsDef = define "aggregateAnnotations" $+  doc "Aggregate annotations from nested structures" $+  lambdas ["getValue", "getX", "getAnns", "t"] $ lets [+    "toPairs">: lambdas ["rest", "t"] $ Optionals.maybe (var "rest")+      (lambda "yy" $ var "toPairs"+        @@ Lists.cons (Maps.toList $ var "getAnns" @@ var "yy") (var "rest")+        @@ (var "getX" @@ var "yy"))+      (var "getValue" @@ var "t")] $+    Maps.fromList $ Lists.concat $ var "toPairs" @@ list [] @@ var "t"++debugIfDef :: TBinding (String -> String -> Flow s ())+debugIfDef = define "debugIf" $+  doc "Debug if the debug ID matches" $+  lambdas ["debugId", "message"] $ lets [+    "checkAndFail">: lambda "desc" $ Logic.ifElse+      (Equality.equal (var "desc") (just $ string "debugId"))+      (Flows.fail $ var "message")+      (produce unit)] $+    Flows.bind (ref getDebugIdDef) (var "checkAndFail")++failOnFlagDef :: TBinding (Name -> String -> Flow s ())+failOnFlagDef = define "failOnFlag" $+  doc "Fail if the given flag is set" $+  lambdas ["flag", "msg"] $ binds [+    "val">: ref hasFlagDef @@ var "flag"] $+    Logic.ifElse (var "val")+      (Flows.fail $ var "msg")+      (produce unit)++getAttrDef :: TBinding (Name -> Flow s (Maybe Term))+getAttrDef = define "getAttr" $+  doc "Get an attribute from the trace" $+  lambda "key" $ Compute.flow $+    lambdas ["s0", "t0"] $ Compute.flowState+      (just $ Maps.lookup (var "key") (Compute.traceOther $ var "t0"))+      (var "s0")+      (var "t0")++getAttrWithDefaultDef :: TBinding (Name -> Term -> Flow s Term)+getAttrWithDefaultDef = define "getAttrWithDefault" $+  doc "Get an attribute with a default value" $+  lambdas ["key", "def"] $ Flows.map+    (lambda "mval" $ Optionals.fromMaybe (var "def") (var "mval"))+    (ref getAttrDef @@ var "key")++getCountDef :: TBinding (Name -> Flow s Int)+getCountDef = define "getCount" $+  doc "Get a counter value" $+  lambda "key" $ ref Lexical.withEmptyGraphDef @@ (Flows.bind+    (ref getAttrWithDefaultDef @@ var "key" @@ (Core.int32 0))+    (ref ExtractCore.int32Def))++getDebugIdDef :: TBinding (Flow s (Maybe String))+getDebugIdDef = define "getDebugId" $+  doc "Get the debug ID from flow state" $+  ref Lexical.withEmptyGraphDef @@ (Flows.bind+    (ref getAttrDef @@ ref Constants.key_debugIdDef)+    (lambda "desc" $ Flows.mapOptional (ref ExtractCore.stringDef) (var "desc")))++getDescriptionDef :: TBinding (M.Map Name Term -> Flow Graph (Maybe String))+getDescriptionDef = define "getDescription" $+  doc "Get description from annotations map" $+  lambda "anns" $ Optionals.maybe+    (produce nothing)+    (lambda "term" $ Flows.map (unaryFunction just) $ ref ExtractCore.stringDef @@ var "term")+    (Maps.lookup (Core.nameLift key_description) (var "anns"))++getTermAnnotationDef :: TBinding (Name -> Term -> Maybe Term)+getTermAnnotationDef = define "getTermAnnotation" $+  doc "Get a term annotation" $+  lambdas ["key", "term"] $ Maps.lookup (var "key") (ref termAnnotationInternalDef @@ var "term")++getTermDescriptionDef :: TBinding (Term -> Flow Graph (Maybe String))+getTermDescriptionDef = define "getTermDescription" $+  doc "Get term description" $+  lambda "term" $ ref getDescriptionDef @@ (ref termAnnotationInternalDef @@ var "term")++getTypeDef :: TBinding (M.Map Name Term -> Flow Graph (Maybe Type))+getTypeDef = define "getType" $+  doc "Get type from annotations" $+  lambda "anns" $ Optionals.maybe+    (produce nothing)+    (lambda "dat" $ Flows.map (unaryFunction just) (ref DecodeCore.typeDef @@ var "dat"))+    (Maps.lookup (ref Constants.key_typeDef) (var "anns"))++getTypeAnnotationDef :: TBinding (Name -> Type -> Maybe Term)+getTypeAnnotationDef = define "getTypeAnnotation" $+  doc "Get a type annotation" $+  lambdas ["key", "typ"] $ Maps.lookup (var "key") (ref typeAnnotationInternalDef @@ var "typ")++getTypeClassesDef :: TBinding (Term -> Flow Graph (M.Map Name (S.Set TypeClass)))+getTypeClassesDef = define "getTypeClasses" $+  doc "Get type classes from term" $+  lambda "term" $ lets [+    "decodeClass">: lambda "term" $ lets [+      "byName">: Maps.fromList $ list [+        pair (Core.nameLift _TypeClass_equality) Graph.typeClassEquality,+        pair (Core.nameLift _TypeClass_ordering) Graph.typeClassOrdering]] $ binds [+      "fn">: ref ExtractCore.unitVariantDef @@ Core.nameLift _TypeClass @@ var "term"] $+      Optionals.maybe+        (ref Monads.unexpectedDef @@ string "type class" @@ (ref ShowCore.termDef @@ var "term"))+        (unaryFunction produce)+        (Maps.lookup (var "fn") (var "byName"))] $+    Optionals.maybe+      (produce Maps.empty)+      (lambda "term" $ ref ExtractCore.mapDef+        @@ (ref DecodeCore.nameDef)+        @@ (ref ExtractCore.setOfDef @@ var "decodeClass")+        @@ (var "term"))+      (ref getTermAnnotationDef @@ ref Constants.key_classesDef @@ var "term")++getTypeDescriptionDef :: TBinding (Type -> Flow Graph (Maybe String))+getTypeDescriptionDef = define "getTypeDescription" $+  doc "Get type description" $+  lambda "typ" $ ref getDescriptionDef @@ (ref typeAnnotationInternalDef @@ var "typ")++isNativeTypeDef :: TBinding (Binding -> Bool)+isNativeTypeDef = define "isNativeType" $+  doc ("For a typed term, decide whether a coder should encode it as a native type expression,"+    <> " or as a Hydra type expression.") $+  lambda "el" $ lets [+    "isFlaggedAsFirstClassType">: Optionals.fromMaybe false $+      Optionals.bind+        (ref getTermAnnotationDef @@ ref Constants.key_firstClassTypeDef @@ (Core.bindingTerm $ var "el"))+        (ref Decoding.booleanDef)] $+    Optionals.maybe false+      (lambda "ts" $ Logic.and+        (Equality.equal (var "ts") (Core.typeScheme (list []) (Core.typeVariable $ Core.nameLift _Type)))+        (Logic.not $ var "isFlaggedAsFirstClassType"))+      (Core.bindingType $ var "el")++hasDescriptionDef :: TBinding (M.Map Name Term -> Bool)+hasDescriptionDef = define "hasDescription" $+  doc "Check if annotations contain description" $+  lambda "anns" $ Optionals.isJust $ Maps.lookup (ref Constants.key_descriptionDef) (var "anns")++hasFlagDef :: TBinding (Name -> Flow s Bool)+hasFlagDef = define "hasFlag" $+  doc "Check if flag is set" $+  lambda "flag" $ ref Lexical.withEmptyGraphDef+    @@ (bind "term" (ref getAttrWithDefaultDef @@ var "flag" @@ Core.false) $+        ref ExtractCore.booleanDef @@ var "term")++hasTypeDescriptionDef :: TBinding (Type -> Bool)+hasTypeDescriptionDef = define "hasTypeDescription" $+  doc "Check if type has description" $+  lambda "typ" $ ref hasDescriptionDef @@ (ref typeAnnotationInternalDef @@ var "typ")++nextCountDef :: TBinding (Name -> Flow s Int)+nextCountDef = define "nextCount" $+  doc "Return a zero-indexed counter for the given key: 0, 1, 2, ..." $+  lambda "key" $ binds [+    "count">: ref getCountDef @@ var "key"] $+    Flows.map+      (constant $ var "count")+      (ref putCountDef @@ var "key" @@ Math.add (var "count") (int32 1))++-- TODO: move into hydra.rewriting+normalizeTermAnnotationsDef :: TBinding (Term -> Term)+normalizeTermAnnotationsDef = define "normalizeTermAnnotations" $+  doc "Normalize term annotations" $+  lambda "term" $ lets [+    "anns">: ref termAnnotationInternalDef @@ var "term",+    "stripped">: ref Rewriting.deannotateTermDef @@ var "term"] $+    Logic.ifElse (Maps.null $ var "anns")+      (var "stripped")+      (Core.termAnnotated $ Core.annotatedTerm (var "stripped") (var "anns"))++-- TODO: move into hydra.rewriting+normalizeTypeAnnotationsDef :: TBinding (Type -> Type)+normalizeTypeAnnotationsDef = define "normalizeTypeAnnotations" $+  doc "Normalize type annotations" $+  lambda "typ" $ lets [+    "anns">: ref typeAnnotationInternalDef @@ var "typ",+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"] $+    Logic.ifElse (Maps.null $ var "anns")+      (var "stripped")+      (Core.typeAnnotated $ Core.annotatedType (var "stripped") (var "anns"))++putAttrDef :: TBinding (Name -> Term -> Flow s ())+putAttrDef = define "putAttr" $+  doc "Set an attribute in the trace" $+  lambdas ["key", "val"] $ Compute.flow $ lambdas ["s0", "t0"] $+    Compute.flowState+      (just unit)+      (var "s0")+      (Compute.traceWithOther (var "t0") (Maps.insert (var "key") (var "val") (Compute.traceOther $ var "t0")))++putCountDef :: TBinding (Name -> Int -> Flow s ())+putCountDef = define "putCount" $+  doc "Set counter value" $+  lambdas ["key", "count"] $+    ref putAttrDef @@ var "key" @@ (Core.termLiteral $ Core.literalInteger $ Core.integerValueInt32 $ var "count")++resetCountDef :: TBinding (Name -> Flow s ())+resetCountDef = define "resetCount" $+  doc "Reset counter to zero" $+  lambda "key" $ ref putAttrDef @@ var "key" @@ TTerms.int32 0++setAnnotationDef :: TBinding (Name -> Maybe Term -> M.Map Name Term -> M.Map Name Term)+setAnnotationDef = define "setAnnotation" $+  doc "Set annotation in map" $+  lambdas ["key", "val", "m"] $ Maps.alter (constant $ var "val") (var "key") (var "m")++setDescriptionDef :: TBinding (Maybe String -> M.Map Name Term -> M.Map Name Term)+setDescriptionDef = define "setDescription" $+  doc "Set description in annotations" $+  lambda "d" $ ref setAnnotationDef+    @@ ref Constants.key_descriptionDef+    @@ Optionals.map (unaryFunction Core.termLiteral <.> unaryFunction Core.literalString) (var "d")++setTermAnnotationDef :: TBinding (Name -> Maybe Term -> Term -> Term)+setTermAnnotationDef = define "setTermAnnotation" $+  doc "Set term annotation" $+  lambdas ["key", "val", "term"] $ lets [+    "term'">: ref Rewriting.deannotateTermDef @@ var "term",+    "anns">: ref setAnnotationDef @@ var "key" @@ var "val" @@ (ref termAnnotationInternalDef @@ var "term")] $+    Logic.ifElse (Maps.null $ var "anns")+      (var "term'")+      (Core.termAnnotated $ Core.annotatedTerm (var "term'") (var "anns"))++setTermDescriptionDef :: TBinding (Maybe String -> Term -> Term)+setTermDescriptionDef = define "setTermDescription" $+  doc "Set term description" $+  lambda "d" $ ref setTermAnnotationDef+    @@ ref Constants.key_descriptionDef+    @@ Optionals.map (lambda "s" $ Core.termLiteral $ Core.literalString $ var "s") (var "d")++setTypeDef :: TBinding (Maybe Type -> M.Map Name Term -> M.Map Name Term)+setTypeDef = define "setType" $+  doc "Set type in annotations" $+  lambda "mt" $ ref setAnnotationDef @@ ref Constants.key_typeDef @@ Optionals.map (ref EncodeCore.typeDef) (var "mt")++setTypeAnnotationDef :: TBinding (Name -> Maybe Term -> Type -> Type)+setTypeAnnotationDef = define "setTypeAnnotation" $+  doc "Set type annotation" $+  lambdas ["key", "val", "typ"] $ lets [+    "typ'">: ref Rewriting.deannotateTypeDef @@ var "typ",+    "anns">: ref setAnnotationDef @@ var "key" @@ var "val" @@ (ref typeAnnotationInternalDef @@ var "typ")] $+    Logic.ifElse (Maps.null (var "anns"))+      (var "typ'")+      (Core.typeAnnotated $ Core.annotatedType (var "typ'") (var "anns"))++setTypeClassesDef :: TBinding (M.Map Name (S.Set TypeClass) -> Term -> Term)+setTypeClassesDef = define "setTypeClasses" $+  doc "Set type classes on term" $+  lambda "m" $ lets [+    "encodeClass">: lambda "tc" $ cases _TypeClass (var "tc") Nothing [+      _TypeClass_equality>>: constant $ TTerms.unitVariantPhantom _TypeClass _TypeClass_equality,+      _TypeClass_ordering>>: constant $ TTerms.unitVariantPhantom _TypeClass _TypeClass_ordering],+    "encodePair">: lambda "nameClasses" $ lets [+      "name">: first $ var "nameClasses",+      "classes">: second $ var "nameClasses"] $+      pair+        (ref EncodeCore.nameDef @@ var "name")+        (Core.termSet $ Sets.fromList $ Lists.map (var "encodeClass") $ Sets.toList $ var "classes"),+    "encoded">: Logic.ifElse (Maps.null $ var "m")+        nothing+        (just $ Core.termMap $ Maps.fromList $ Lists.map (var "encodePair") $ Maps.toList $ var "m")]+    $ ref setTermAnnotationDef @@ ref Constants.key_classesDef @@ var "encoded"++setTypeDescriptionDef :: TBinding (Maybe String -> Type -> Type)+setTypeDescriptionDef = define "setTypeDescription" $+  doc "Set type description" $+  lambda "d" $ ref setTypeAnnotationDef+    @@ ref Constants.key_descriptionDef+    @@ Optionals.map (unaryFunction Core.termLiteral <.> unaryFunction Core.literalString) (var "d")++termAnnotationInternalDef :: TBinding (Term -> M.Map Name Term)+termAnnotationInternalDef = define "termAnnotationInternal" $+  doc "Get internal term annotations" $+  lets [+    "getAnn">: lambda "t" $ cases _Term (var "t")+      (Just nothing) [+      _Term_annotated>>: lambda "a" $ just $ var "a"]] $+    ref aggregateAnnotationsDef @@ var "getAnn" @@ (unaryFunction Core.annotatedTermSubject) @@ (unaryFunction Core.annotatedTermAnnotation)++typeAnnotationInternalDef :: TBinding (Type -> M.Map Name Term)+typeAnnotationInternalDef = define "typeAnnotationInternal" $+  doc "Get internal type annotations" $ lets [+    "getAnn">: lambda "t" $ cases _Type (var "t")+      (Just nothing) [+      _Type_annotated>>: lambda "a" $ just $ var "a"]] $+    ref aggregateAnnotationsDef @@ var "getAnn" @@ (unaryFunction Core.annotatedTypeSubject) @@ (unaryFunction Core.annotatedTypeAnnotation)++-- TODO: deprecate+typeElementDef :: TBinding (Name -> Type -> Binding)+typeElementDef = define "typeElement" $+  doc "Create a type element with proper annotations" $+  lambdas ["name", "typ"] $ lets [+    "schemaTerm">: Core.termVariable (Core.nameLift _Type),+    "dataTerm">: ref normalizeTermAnnotationsDef @@ (Core.termAnnotated $ Core.annotatedTerm+      (ref EncodeCore.typeDef @@ var "typ")+      (Maps.fromList $ list [pair (ref Constants.key_typeDef) (var "schemaTerm")]))] $+    Core.binding (var "name") (var "dataTerm") (just $ Core.typeScheme (list []) (var "typ"))++whenFlagDef :: TBinding (Name -> Flow s a -> Flow s a -> Flow s a)+whenFlagDef = define "whenFlag" $+  doc "Execute different flows based on flag" $+  lambdas ["flag", "fthen", "felse"] $ binds [+    "b">: ref hasFlagDef @@ var "flag"] $+    Logic.ifElse (var "b") (var "fthen") (var "felse")++-- TODO: move into hydra.rewriting+unshadowVariablesDef :: TBinding (Term -> Term)+unshadowVariablesDef = define "unshadowVariables" $+  doc "Unshadow variables in term" $+  lambda "term" $ lets [+    "freshName">: Flows.map (lambda "n" $ Core.name $ Strings.cat2 (string "s") (Literals.showInt32 $ var "n")) $+      ref nextCountDef @@ Core.name (string "unshadow"),+    "rewrite">: lambdas ["recurse", "term"] $ lets [+      "handleOther">: var "recurse" @@ var "term"] $ binds [+      "state">: ref Monads.getStateDef] $ lets [+      "reserved">: first $ var "state",+      "subst">: second $ var "state"] $+      cases _Term (var "term")+        (Just $ var "handleOther") [+        _Term_variable>>: lambda "v" $ produce $ Core.termVariable $+          Optionals.fromMaybe (var "v") (Maps.lookup (var "v") (var "subst")),+        _Term_function>>: lambda "f" $+          cases _Function (var "f")+            (Just $ var "handleOther") [+            _Function_lambda>>: lambda "l" $ lets [+              "v">: Core.lambdaParameter $ var "l",+              "d">: Core.lambdaDomain $ var "l",+              "body">: Core.lambdaBody $ var "l"] $+              Logic.ifElse (Sets.member (var "v")(var "reserved"))+                ( bind "v'" (var "freshName") $+                  exec (ref Monads.putStateDef @@ pair+                    (Sets.insert (var "v'") (var "reserved"))+                    (Maps.insert (var "v") (var "v'") (var "subst"))) $+                  bind "body'" (var "recurse" @@ var "body") $+                  exec (ref Monads.putStateDef @@ var "state") $+                  produce $ Core.termFunction $ Core.functionLambda $ Core.lambda (var "v'") (var "d") (var "body'"))+                ( exec (ref Monads.putStateDef @@ pair (Sets.insert (var "v") (var "reserved")) (var "subst")) $+                  Flows.map+                    (lambda "body'" $ Core.termFunction $ Core.functionLambda $ Core.lambda (var "v") (var "d") (var "body'"))+                    (var "recurse" @@ var "body"))]]] $+    Optionals.fromJust $ Compute.flowStateValue $ Compute.unFlow+      (ref Rewriting.rewriteTermMDef @@ var "rewrite" @@ var "term")+      (pair Sets.empty Maps.empty)+      (ref Monads.emptyTraceDef)++withDepthDef :: TBinding (Name -> (Int -> Flow s a) -> Flow s a)+withDepthDef = define "withDepth" $+  doc ("Provide an one-indexed, integer-valued 'depth' to a flow, where the depth is the number of nested calls."+    <> " This is useful for generating variable names while avoiding conflicts between the variables of parents and children."+    <> " E.g. a variable in an outer case/match statement might be \"v1\", whereas the variable of another case/match statement"+    <> " inside of the first one becomes \"v2\". See also nextCount.") $+  lambdas ["key", "f"] $ binds [+    "count">: ref getCountDef @@ var "key"] $ lets [+    "inc">: Math.add (var "count") (int32 1)] $+    exec (ref putCountDef @@ var "key" @@ var "inc") $ binds [+    "r">: var "f" @@ var "inc"] $+    exec (ref putCountDef @@ var "key" @@ var "count") $+    produce $ var "r"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Arity.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Arity where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.arity") elements+    []+    kernelTypesModules $+    Just ("Functions dealing with arguments and arity.")+  where+    elements = [+      el functionArityDef,+      el primitiveArityDef,+      el termArityDef,+      el typeArityDef,+      el uncurryTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++functionArityDef :: TBinding (Function -> Int)+functionArityDef = define "functionArity" $+  match _Function Nothing [+    _Function_elimination>>: constant (int32 1),+    _Function_lambda>>: (lambda "i" $ Math.add (int32 1) (var "i")) <.> (ref termArityDef <.> unaryFunction Core.lambdaBody),+    _Function_primitive>>: constant $+      doc "TODO: This function needs to be monadic, so we can look up the primitive" (int32 42)]++primitiveArityDef :: TBinding (Primitive -> Int)+primitiveArityDef = define "primitiveArity" $+  doc "Find the arity (expected number of arguments) of a primitive constant or function" $+  (ref typeArityDef <.> unaryFunction Core.typeSchemeType <.> unaryFunction Graph.primitiveType)++termArityDef :: TBinding (Term -> Int)+termArityDef = define "termArity" $+  match _Term (Just $ int32 0) [+    _Term_application>>: (lambda "xapp" $ Math.sub (var "xapp") (int32 1)) <.> ref termArityDef <.> unaryFunction Core.applicationFunction,+    _Term_function>>: ref functionArityDef]+    -- Note: ignoring variables which might resolve to functions++typeArityDef :: TBinding (Type -> Int)+typeArityDef = define "typeArity" $+  match _Type (Just $ int32 0) [+    _Type_annotated>>: ref typeArityDef <.> unaryFunction Core.annotatedTypeSubject,+    _Type_application>>: ref typeArityDef <.> unaryFunction Core.applicationTypeFunction,+    _Type_forall>>: ref typeArityDef <.> unaryFunction Core.forallTypeBody,+    _Type_function>>: lambda "f" $+      Math.add (int32 1) (ref typeArityDef @@ (Core.functionTypeCodomain $ var "f"))]++uncurryTypeDef :: TBinding (Type -> [Type])+uncurryTypeDef = define "uncurryType" $+  doc "Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)" $+  lambda "t" ((match _Type (Just $ list [var "t"]) [+    _Type_annotated>>: ref uncurryTypeDef <.> unaryFunction Core.annotatedTypeSubject,+    _Type_application>>: ref uncurryTypeDef <.> unaryFunction Core.applicationTypeFunction,+    _Type_forall>>: ref uncurryTypeDef <.> unaryFunction Core.forallTypeBody,+    _Type_function>>: lambda "ft" $ Lists.cons+      (Core.functionTypeDomain $ var "ft")+      (ref uncurryTypeDef @@ (Core.functionTypeCodomain $ var "ft"))]) @@ var "t")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Constants.hs view
@@ -0,0 +1,110 @@+module Hydra.Sources.Kernel.Terms.Constants where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.constants") elements+    []+    kernelTypesModules $+    Just ("A module for tier-0 constants.")+  where+   elements = [+     el ignoredVariableDef,+     el key_classesDef,+     el key_debugIdDef,+     el key_deprecatedDef,+     el key_descriptionDef,+     el key_excludeDef,+     el key_firstClassTypeDef,+     el key_maxLengthDef,+     el key_minLengthDef,+     el key_preserveFieldNameDef,+     el key_typeDef,+     el maxInt32Def,+     el placeholderNameDef,+     el maxTraceDepthDef,+     el warningAutoGeneratedFileDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++annotationKeyDef :: String -> Maybe String -> TBinding Name+annotationKeyDef name mdesc = define ("key_" <> name) $ case mdesc of+    Nothing -> def+    Just comment -> doc comment def+  where+    def = wrap _Name $ string name++ignoredVariableDef :: TBinding String+ignoredVariableDef = define "ignoredVariable" $+  string "_"++key_classesDef = annotationKeyDef "classes" Nothing+key_debugIdDef = annotationKeyDef "debugId" Nothing+key_deprecatedDef = annotationKeyDef "deprecated" Nothing+key_descriptionDef = annotationKeyDef "description" Nothing+key_excludeDef = annotationKeyDef "exclude" Nothing+key_firstClassTypeDef = annotationKeyDef "firstClassType"+  $ Just "A flag which tells the language coders to encode a given encoded type as a term rather than a native type"+key_maxLengthDef = annotationKeyDef "maxLength" Nothing+key_minLengthDef = annotationKeyDef "minLength" Nothing+key_preserveFieldNameDef = annotationKeyDef "preserveFieldName" Nothing+key_typeDef = annotationKeyDef "type" Nothing++maxInt32Def :: TBinding Int+maxInt32Def = define "maxInt32" $+  doc "The maximum value of a 32-bit integer" $+  int32 maxBound++placeholderNameDef :: TBinding Name+placeholderNameDef = define "placeholderName" $+  doc "A placeholder name for row types as they are being constructed" $+  wrap _Name $ string "Placeholder"++maxTraceDepthDef :: TBinding Int+maxTraceDepthDef = define "maxTraceDepth" $+  doc ("A maximum depth for nested flows."+    <> " Currently, this is set very high because deep flows are common in type inference over the Hydra kernel.") $+  int32 4000++warningAutoGeneratedFileDef :: TBinding String+warningAutoGeneratedFileDef = define "warningAutoGeneratedFile" $+  string "Note: this is an automatically generated file. Do not edit."
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Decode/Core.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Decode.Core where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+++module_ :: Module+module_ = Module (Namespace "hydra.decode.core") elements+    [ExtractCore.module_, Monads.module_, Lexical.module_,+      Rewriting.module_, ShowCore.module_]+    kernelTypesModules $+    Just ("Decode hydra.core types from the hydra.core.Term type")+  where+   elements = [+     el applicationTypeDef,+     el fieldTypeDef,+     el fieldTypesDef,+     el floatTypeDef,+     el forallTypeDef,+     el functionTypeDef,+     el integerTypeDef,+     el literalTypeDef,+     el mapTypeDef,+     el nameDef,+     el rowTypeDef,+     el stringDef,+     el typeDef,+     el typeSchemeDef,+     el wrappedTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++applicationTypeDef :: TBinding (Term -> Flow Graph ApplicationType)+applicationTypeDef = define "applicationType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+    "function">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _ApplicationType_function @@ ref typeDef,+    "argument">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _ApplicationType_argument @@ ref typeDef] $+    produce $ Core.applicationType (var "function") (var "argument"))++fieldTypeDef :: TBinding (Term -> Flow Graph FieldType)+fieldTypeDef = define "fieldType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+    "name">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _FieldType_name @@ ref nameDef,+    "typ">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _FieldType_type @@ ref typeDef] $+    produce $ Core.fieldType (var "name") (var "typ"))++fieldTypesDef :: TBinding (Term -> Flow Graph [FieldType])+fieldTypesDef = define "fieldTypes" $+  lambda "term" $ lets [+    "stripped">: ref Rewriting.deannotateAndDetypeTermDef @@ var "term"]+    $ cases _Term (var "stripped")+        (Just $ ref Monads.unexpectedDef @@ string "list" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_list>>: lambda "els" $ Flows.mapList (ref fieldTypeDef) (var "els")]++floatTypeDef :: TBinding (Term -> Flow Graph FloatType)+floatTypeDef = define "floatType" $+  ref Lexical.matchEnumDef @@ Core.nameLift _FloatType @@ list [+    pair (Core.nameLift _FloatType_bigfloat) Core.floatTypeBigfloat,+    pair (Core.nameLift _FloatType_float32) Core.floatTypeFloat32,+    pair (Core.nameLift _FloatType_float64) Core.floatTypeFloat64]++forallTypeDef :: TBinding (Term -> Flow Graph ForallType)+forallTypeDef = define "forallType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+    "parameter">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _ForallType_parameter @@ ref nameDef,+    "body">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _ForallType_body @@ ref typeDef] $+    produce $ Core.forallType (var "parameter") (var "body"))++functionTypeDef :: TBinding (Term -> Flow Graph FunctionType)+functionTypeDef = define "functionType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+    "domain">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _FunctionType_domain @@ ref typeDef,+    "codomain">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _FunctionType_codomain @@ ref typeDef] $+    produce $ Core.functionType (var "domain") (var "codomain"))++integerTypeDef :: TBinding (Term -> Flow Graph IntegerType)+integerTypeDef = define "integerType" $+  ref Lexical.matchEnumDef @@ Core.nameLift _IntegerType @@ list [+    pair (Core.nameLift _IntegerType_bigint) Core.integerTypeBigint,+    pair (Core.nameLift _IntegerType_int8) Core.integerTypeInt8,+    pair (Core.nameLift _IntegerType_int16) Core.integerTypeInt16,+    pair (Core.nameLift _IntegerType_int32) Core.integerTypeInt32,+    pair (Core.nameLift _IntegerType_int64) Core.integerTypeInt64,+    pair (Core.nameLift _IntegerType_uint8) Core.integerTypeUint8,+    pair (Core.nameLift _IntegerType_uint16) Core.integerTypeUint16,+    pair (Core.nameLift _IntegerType_uint32) Core.integerTypeUint32,+    pair (Core.nameLift _IntegerType_uint64) Core.integerTypeUint64]++literalTypeDef :: TBinding (Term -> Flow Graph LiteralType)+literalTypeDef = define "literalType" $+  ref Lexical.matchUnionDef @@ Core.nameLift _LiteralType @@ list [+    ref Lexical.matchUnitFieldDef @@ Core.nameLift _LiteralType_binary @@ Core.literalTypeBinary,+    ref Lexical.matchUnitFieldDef @@ Core.nameLift _LiteralType_boolean @@ Core.literalTypeBoolean,+    pair+     (Core.nameLift _LiteralType_float)+     (lambda "ft" $ Flows.map (unaryFunction Core.literalTypeFloat) (ref floatTypeDef @@ var "ft")),+    pair+      (Core.nameLift _LiteralType_integer)+      (lambda "it" $ Flows.map (unaryFunction Core.literalTypeInteger) (ref integerTypeDef @@ var "it")),+    ref Lexical.matchUnitFieldDef @@ Core.nameLift _LiteralType_string @@ Core.literalTypeString]++mapTypeDef :: TBinding (Term -> Flow Graph MapType)+mapTypeDef = define "mapType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+   "keys">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _MapType_keys @@ ref typeDef,+   "values">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _MapType_values @@ ref typeDef] $+    produce $ Core.mapType (var "keys") (var "values"))++nameDef :: TBinding (Term -> Flow Graph Name)+nameDef = define "name" $+  lambda "term" $ Flows.map (unaryFunction Core.name) $+    Flows.bind (ref ExtractCore.wrapDef @@ Core.nameLift _Name @@ var "term") $+    ref ExtractCore.stringDef++rowTypeDef :: TBinding (Term -> Flow Graph RowType)+rowTypeDef = define "rowType" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+   "typeName">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _RowType_typeName @@ ref nameDef,+   "fields">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _RowType_fields @@ ref fieldTypesDef] $+   produce $ Core.rowType (var "typeName") (var "fields"))++stringDef :: TBinding (Term -> Flow Graph String)+stringDef = define "string" $+  lambda "term" $ ref ExtractCore.stringDef @@ (ref Rewriting.deannotateAndDetypeTermDef @@ var "term")++typeDef :: TBinding (Term -> Flow Graph Type)+typeDef = define "type" $+  lambda "dat" $ cases _Term (var "dat")+    (Just $ ref Lexical.matchUnionDef @@ Core.nameLift _Type @@ list [+      pair+        (Core.nameLift _Type_application)+        (lambda "at" $ Flows.map (unaryFunction Core.typeApplication) $ ref applicationTypeDef @@ var "at"),+      pair+        (Core.nameLift _Type_forall)+        (lambda "ft" $ Flows.map (unaryFunction Core.typeForall) $ ref forallTypeDef @@ var "ft"),+      pair+        (Core.nameLift _Type_function)+        (lambda "ft" $ Flows.map (unaryFunction Core.typeFunction) $ ref functionTypeDef @@ var "ft"),+      pair+        (Core.nameLift _Type_list)+        (lambda "et" $ Flows.map (unaryFunction Core.typeList) $ ref typeDef @@ var "et"),+      pair+        (Core.nameLift _Type_literal)+        (lambda "lt" $ Flows.map (unaryFunction Core.typeLiteral) $ ref literalTypeDef @@ var "lt"),+      pair+        (Core.nameLift _Type_map)+        (lambda "mt" $ Flows.map (unaryFunction Core.typeMap) $ ref mapTypeDef @@ var "mt"),+      pair+        (Core.nameLift _Type_optional)+        (lambda "et" $ Flows.map (unaryFunction Core.typeOptional) $ ref typeDef @@ var "et"),+      pair+        (Core.nameLift _Type_product)+        (lambda "types" $ Flows.map (unaryFunction Core.typeProduct) $ ref ExtractCore.listOfDef @@ ref typeDef @@ var "types"),+      pair+        (Core.nameLift _Type_record)+        (lambda "rt" $ Flows.map (unaryFunction Core.typeRecord) $ ref rowTypeDef @@ var "rt"),+      pair+        (Core.nameLift _Type_set)+        (lambda "et" $ Flows.map (unaryFunction Core.typeSet) $ ref typeDef @@ var "et"),+      pair+        (Core.nameLift _Type_sum)+        (lambda "types" $ Flows.map (unaryFunction Core.typeSum) $ ref ExtractCore.listOfDef @@ ref typeDef @@ var "types"),+      pair+        (Core.nameLift _Type_union)+        (lambda "rt" $ Flows.map (unaryFunction Core.typeUnion) $ ref rowTypeDef @@ var "rt"),+      pair+        (Core.nameLift _Type_unit)+        (constant $ Flows.pure Core.typeUnit),+      pair+        (Core.nameLift _Type_variable)+        (lambda "n" $ Flows.map (unaryFunction Core.typeVariable) $ ref nameDef @@ var "n"),+      pair+        (Core.nameLift _Type_wrap)+        (lambda "wt" $ Flows.map (unaryFunction Core.typeWrap) $ ref wrappedTypeDef @@ var "wt")] @@ var "dat") [+    _Term_annotated>>: lambda "annotatedTerm" $+      Flows.map+        (lambda "t" $ Core.typeAnnotated $ Core.annotatedType (var "t") (Core.annotatedTermAnnotation $ var "annotatedTerm"))+        (ref typeDef @@ (Core.annotatedTermSubject $ var "annotatedTerm"))]++typeSchemeDef :: TBinding (Term -> Flow Graph TypeScheme)+typeSchemeDef = define "typeScheme" $+  ref Lexical.matchRecordDef @@ (lambda "m" $ binds [+    "vars">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _TypeScheme_variables @@ (ref ExtractCore.listOfDef @@ ref nameDef),+    "body">: ref Lexical.getFieldDef @@ var "m" @@ Core.nameLift _TypeScheme_type @@ ref typeDef] $+    produce $ Core.typeScheme (var "vars") (var "body"))++wrappedTypeDef :: TBinding (Term -> Flow Graph WrappedType)+wrappedTypeDef = define "wrappedType" $+  lambda "term" $ binds [+    "fields">: ref ExtractCore.recordDef @@ Core.nameLift _WrappedType @@ var "term",+    "name">: ref ExtractCore.fieldDef @@ Core.nameLift _WrappedType_typeName @@ ref nameDef @@ var "fields",+    "obj">: ref ExtractCore.fieldDef @@ Core.nameLift _WrappedType_object @@ ref typeDef @@ var "fields"] $+    produce $ Core.wrappedType (var "name") (var "obj")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Decoding.hs view
@@ -0,0 +1,411 @@+module Hydra.Sources.Kernel.Terms.Decoding where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+++module_ :: Module+module_ = Module (Namespace "hydra.decoding") elements+    [Rewriting.module_]+    kernelTypesModules $+    Just "A module for decoding terms to native objects"+  where+    elements = [+      el bigfloatDef,+      el bigfloatValueDef,+      el bigintDef,+      el bigintValueDef,+      el binaryDef,+      el binaryLiteralDef,+      el booleanDef,+      el booleanLiteralDef,+      el caseFieldDef,+      el casesDef,+      el fieldDef,+      el float32Def,+      el float32ValueDef,+      el float64Def,+      el float64ValueDef,+      el floatLiteralDef,+      el int16Def,+      el int16ValueDef,+      el int32Def,+      el int32ValueDef,+      el int64Def,+      el int64ValueDef,+      el int8Def,+      el int8ValueDef,+      el integerLiteralDef,+      el lambdaDef,+      el letBindingDef,+      el letBindingWithKeyDef,+      el letTermDef,+      el listDef,+      el literalDef,+      el mapDef,+      el nameDef,+      el nominalDef,+      el optionalDef,+      el pairDef,+      el recordDef,+      el setDef,+      el stringDef,+      el stringLiteralDef,+      el uint16Def,+      el uint16ValueDef,+      el uint32Def,+      el uint32ValueDef,+      el uint64Def,+      el uint64ValueDef,+      el uint8Def,+      el uint8ValueDef,+      el unitDef,+      el unitVariantDef,+      el variableDef,+      el variantDef,+      el wrapDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++bigfloatDef :: TBinding (Term -> Maybe Float)+bigfloatDef = define "bigfloat" $+  compose3 (ref literalDef) (ref floatLiteralDef) (ref bigfloatValueDef)++bigfloatValueDef :: TBinding (FloatValue -> Maybe Float)+bigfloatValueDef = define "bigfloatValue" $+  matchVariant _FloatValue _FloatValue_bigfloat++bigintDef :: TBinding (Term -> Maybe Int)+bigintDef = define "bigint" $+  compose3 (ref literalDef) (ref integerLiteralDef) (ref bigintValueDef)++bigintValueDef :: TBinding (IntegerValue -> Maybe Int)+bigintValueDef = define "bigintValue" $+  matchVariant _IntegerValue _IntegerValue_bigint++binaryDef :: TBinding (Term -> Maybe String)+binaryDef = define "binary" $+  compose2 (ref literalDef) (ref binaryLiteralDef)++binaryLiteralDef :: TBinding (Literal -> Maybe String)+binaryLiteralDef = define "binaryLiteral" $+  matchVariant _Literal _Literal_binary++booleanDef :: TBinding (Term -> Maybe Bool)+booleanDef = define "boolean" $+  compose2 (ref literalDef) (ref booleanLiteralDef)++booleanLiteralDef :: TBinding (Literal -> Maybe Bool)+booleanLiteralDef = define "booleanLiteral" $+  matchVariant _Literal _Literal_boolean++casesDef :: TBinding (Name -> Term -> Maybe [Field])+casesDef = define "cases" $+  lets [+    "matchFunction">: matchTermVariant _Term_function,+    "matchElimination">: matchVariant _Function _Function_elimination,+    "matchUnion">: matchVariant _Elimination _Elimination_union]+    $ ref nominalDef+      @@ (unaryFunction Core.caseStatementTypeName)+      @@ (unaryFunction Core.caseStatementCases)+      @@ compose3 (var "matchFunction") (var "matchElimination") (var "matchUnion")++caseFieldDef :: TBinding (Name -> Name -> Term -> Y.Maybe Term)+caseFieldDef = define "caseField" $+ lambda "tname" $ lambda "fname" $+   compose2+     (ref casesDef @@ var "tname" )+     (ref fieldDef @@ var "fname")++fieldDef :: TBinding (Name -> [Field] -> Maybe Term)+fieldDef = define "field" $+  lambdas ["fname", "fields"] $ lets [+    "matches">: Lists.filter+      (lambda "f" $ Equality.equal (Core.fieldName $ var "f") $ var "fname")+      (var "fields")]+    $ Logic.ifElse (Equality.equal (int32 1) (Lists.length $ var "matches"))+      (just (Core.fieldTerm $ (Lists.head $ var "matches")))+      nothing++float32Def :: TBinding (Term -> Maybe Float)+float32Def = define "float32" $+  compose3+    (ref literalDef)+    (ref floatLiteralDef)+    (ref float32ValueDef)++float32ValueDef :: TBinding (FloatValue -> Maybe Float)+float32ValueDef = define "float32Value" $+  matchVariant _FloatValue _FloatValue_float32++float64Def :: TBinding (Term -> Maybe Float)+float64Def = define "float64" $+  compose3+    (ref literalDef)+    (ref floatLiteralDef)+    (ref float64ValueDef)++float64ValueDef :: TBinding (FloatValue -> Maybe Float)+float64ValueDef = define "float64Value" $+  matchVariant _FloatValue _FloatValue_float64++floatLiteralDef = define "floatLiteral" $+  matchVariant _Literal _Literal_float++int8Def :: TBinding (Term -> Maybe Int)+int8Def = define "int8" $+  compose3+    (ref literalDef)+    (ref integerLiteralDef)+    (ref int8ValueDef)++int8ValueDef :: TBinding (IntegerValue -> Maybe Int)+int8ValueDef = define "int8Value" $+  matchVariant _IntegerValue _IntegerValue_int8++int16Def :: TBinding (Term -> Maybe Int)+int16Def = define "int16" $+  compose3+    (ref literalDef)+    (ref integerLiteralDef)+    (ref int16ValueDef)++int16ValueDef :: TBinding (IntegerValue -> Maybe Int)+int16ValueDef = define "int16Value" $+  matchVariant _IntegerValue _IntegerValue_int16++int32Def :: TBinding (Term -> Maybe Int)+int32Def = define "int32" $+  compose3+    (ref literalDef)+    (ref integerLiteralDef)+    (ref int32ValueDef)++int32ValueDef :: TBinding (IntegerValue -> Maybe Int)+int32ValueDef = define "int32Value" $+  matchVariant _IntegerValue _IntegerValue_int32++int64Def :: TBinding (Term -> Maybe Int)+int64Def = define "int64" $+  compose3+    (ref literalDef)+    (ref integerLiteralDef)+    (ref int64ValueDef)++int64ValueDef :: TBinding (IntegerValue -> Maybe Int)+int64ValueDef = define "int64Value" $+  matchVariant _IntegerValue _IntegerValue_int64++integerLiteralDef :: TBinding (Literal -> Maybe IntegerValue)+integerLiteralDef = define "integerLiteral" $+  matchVariant _Literal _Literal_integer++lambdaDef :: TBinding (Term -> Maybe Lambda)+lambdaDef = define "lambda" $+  lets [+    "matchFunction">: matchTermVariant _Term_function,+    "matchLambda">: matchVariant _Function _Function_lambda]+    $ compose2 (var "matchFunction") (var "matchLambda")++letBindingDef :: TBinding (Name -> Term -> Maybe Binding)+letBindingDef = define "letBinding" $+  lambda "fname" $ lambda "term" $ Optionals.bind+    (Optionals.map+      (unaryFunction Core.letBindings)+      (ref letTermDef @@ var "term"))+    (ref letBindingWithKeyDef @@ var "fname")++letBindingWithKeyDef :: TBinding (Name -> [Binding] -> Maybe Binding)+letBindingWithKeyDef = define "letBindingWithKey" $+  lambda "fname" $ lambda "bindings" $ lets [+    "matches">: Lists.filter+      (lambda "b" $ Equality.equal (Core.bindingName $ var "b") $ var "fname")+      (var "bindings")]+    $ Logic.ifElse (Equality.equal (int32 1) (Lists.length $ var "matches"))+      (just (Lists.head $ var "matches"))+      nothing++letTermDef :: TBinding (Term -> Maybe Let)+letTermDef = define "letTerm" $+  matchTermVariant _Term_let++listDef :: TBinding (Term -> Maybe [Term])+listDef = define "list" $+  matchTermVariant _Term_list++literalDef :: TBinding (Term -> Maybe Literal)+literalDef = define "literal" $+  matchTermVariant _Term_literal++mapDef :: TBinding (Term -> Maybe (M.Map Term Term))+mapDef = define "map" $+  matchTermVariant _Term_map++nameDef :: TBinding (Term -> Maybe Name)+nameDef = define "name" $+  lambda "term" $ Optionals.map nm+    (Optionals.bind+      (ref wrapDef @@ Core.nameLift _Name @@ var "term")+      (ref stringDef))+  where+    nm :: TTerm (String -> Name)+    nm = TTerm $ Terms.lambda "s" $ TermWrap $ WrappedTerm _Name $ Terms.var "s"++nominalDef :: TBinding ((a -> Name) -> (a -> b) -> (c -> Maybe a) -> Name -> c -> Maybe b)+nominalDef = define "nominal" $+  lambda "getName" $ lambda "getB" $ lambda "getA" $ lambda "expected" $+    lets [+      "namesEqual">: lambda "n1" $ lambda "n2" $ Equality.equal (Core.unName $ var "n1") (Core.unName $ var "n2")] $+      compose2+        (var "getA")+        (lambda "a" $ (Logic.ifElse (var "namesEqual" @@ (var "getName" @@ var "a") @@ (var "expected")))+          (just (var "getB" @@ var "a"))+          nothing)++optionalDef :: TBinding (Term -> Maybe (Maybe Term))+optionalDef = define "optional" $+  matchTermVariant _Term_optional++pairDef :: TBinding (Term -> Maybe (Term, Term))+pairDef = define "pair" $+  lets [+    "matchProduct">: matchTermVariant _Term_product]+    $ compose2+      (var "matchProduct")+      (lambda "l" $ Logic.ifElse (Equality.equal (int32 2) (Lists.length $ var "l"))+        (just $ pair (Lists.at (int32 0) $ var "l") (Lists.at (int32 1) $ var "l"))+        nothing)++recordDef :: TBinding (Name -> Term -> Maybe [Field])+recordDef = define "record" $+  matchNominal _Term_record+    (unaryFunction Core.recordTypeName)+    (unaryFunction Core.recordFields)++setDef :: TBinding (Term -> Maybe (S.Set Term))+setDef = define "set" $+  matchTermVariant _Term_set++stringDef :: TBinding (Term -> Maybe String)+stringDef = define "string" $+  compose2 (ref literalDef) (ref stringLiteralDef)++stringLiteralDef :: TBinding (Literal -> Maybe String)+stringLiteralDef = define "stringLiteral" $+  matchVariant _Literal _Literal_string++uint8Def :: TBinding (Term -> Maybe Int)+uint8Def = define "uint8" $+  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint8ValueDef)++uint8ValueDef :: TBinding (IntegerValue -> Maybe Int)+uint8ValueDef = define "uint8Value" $+  matchVariant _IntegerValue _IntegerValue_uint8++uint16Def :: TBinding (Term -> Maybe Int)+uint16Def = define "uint16" $+  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint16ValueDef)++uint16ValueDef :: TBinding (IntegerValue -> Maybe Int)+uint16ValueDef = define "uint16Value" $+  matchVariant _IntegerValue _IntegerValue_uint16++uint32Def :: TBinding (Term -> Maybe Int)+uint32Def = define "uint32" $+  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint32ValueDef)++uint32ValueDef :: TBinding (IntegerValue -> Maybe Int)+uint32ValueDef = define "uint32Value" $+  matchVariant _IntegerValue _IntegerValue_uint32++uint64Def :: TBinding (Term -> Maybe Int)+uint64Def = define "uint64" $+  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint64ValueDef)++uint64ValueDef :: TBinding (IntegerValue -> Maybe Int)+uint64ValueDef = define "uint64Value" $+  matchVariant _IntegerValue _IntegerValue_uint64++unitDef :: TBinding (Term -> Maybe ())+unitDef = define "unit" $+  lambda "term" $ cases _Term (var "term") (Just nothing) [+    _Term_unit>>: constant $ just unit]++unitVariantDef :: TBinding (Name -> Term -> Maybe Name)+unitVariantDef = define "unitVariant" $+  lambda "tname" $ lambda "term" $ Optionals.map+    (unaryFunction Core.fieldName)+    (ref variantDef @@ var "tname" @@ var "term")++variableDef :: TBinding (Term -> Y.Maybe Name)+variableDef = define "variable" $+  matchTermVariant _Term_variable++variantDef :: TBinding (Name -> Term -> Maybe Field)+variantDef = define "variant" $+  matchNominal _Term_union+    (unaryFunction Core.injectionTypeName)+    (unaryFunction Core.injectionField)++wrapDef :: TBinding (Name -> Term -> Maybe Term)+wrapDef = define "wrap" $+  matchNominal _Term_wrap+    (unaryFunction Core.wrappedTermTypeName)+    (unaryFunction Core.wrappedTermObject)++--++compose2 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (a -> Maybe c)+compose2 = Optionals.compose++compose3 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (c -> Maybe d) -> TTerm (a -> Maybe d)+compose3 f g h = Optionals.compose (Optionals.compose f g) h++matchNominal :: Name -> TTerm (a -> Name) -> TTerm (a -> b) -> TTerm (Name -> Term -> Maybe b)+matchNominal fname getName getB = ref nominalDef @@ getName @@ getB @@ matchTermVariant fname++matchTermVariant :: Name -> TTerm (Term -> Maybe a)+matchTermVariant fname = matchVariant _Term fname <.> ref Rewriting.deannotateTermDef++matchVariant :: Name -> Name -> TTerm (a -> Maybe b)+matchVariant tname fname = match tname (Just nothing) [+  fname>>: lambda "matched_" $ Optionals.pure $ var "matched_"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Describe/Core.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Describe.Core where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Describe.Mantle as DescribeMantle+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.describe.core") elements+    [DescribeMantle.module_, Variants.module_]+    kernelTypesModules $+    Just "Natural-language descriptions for hydra.core types"+  where+   elements = [+     el floatTypeDef,+     el integerTypeDef,+     el literalTypeDef,+     el typeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++floatTypeDef :: TBinding (FloatType -> String)+floatTypeDef = define "floatType" $+  doc "Display a floating-point type as a string" $+  lambda "t" $ (ref DescribeMantle.precisionDef <.> ref Variants.floatTypePrecisionDef @@ var "t") ++ string " floating-point number"++integerTypeDef :: TBinding (IntegerType -> String)+integerTypeDef = define "integerType" $+  doc "Display an integer type as a string" $+  lambda "t" $ (ref DescribeMantle.precisionDef <.> ref Variants.integerTypePrecisionDef @@ var "t")+    ++ string " integer"++literalTypeDef :: TBinding (LiteralType -> String)+literalTypeDef = define "literalType" $+  doc "Display a literal type as a string" $+  match _LiteralType Nothing [+    _LiteralType_binary>>: constant $ string "binary string",+    _LiteralType_boolean>>: constant $ string "boolean value",+    _LiteralType_float>>: ref floatTypeDef,+    _LiteralType_integer>>: ref integerTypeDef,+    _LiteralType_string>>: constant $ string "character string"]++typeDef :: TBinding (Type -> String)+typeDef = define "type" $+  doc "Display a type as a string" $+  match _Type Nothing [+    _Type_annotated>>: lambda "a" $ string "annotated " ++ (ref typeDef @@+      (project _AnnotatedType _AnnotatedType_subject @@ var "a")),+    _Type_application>>: lambda "at" $ Strings.cat $ list [+      ref typeDef @@ (Core.applicationTypeFunction $ var "at"),+      string " applied to ",+      ref typeDef @@ (Core.applicationTypeArgument $ var "at")],+    _Type_literal>>: ref literalTypeDef,+    _Type_function>>: lambda "ft" $ string "function from "+      ++ (ref typeDef @@ (project _FunctionType _FunctionType_domain @@ var "ft"))+      ++ string " to "+      ++ (ref typeDef @@ (project _FunctionType _FunctionType_codomain @@ var "ft")),+    _Type_forall>>: lambda "fat" $ Strings.cat2 (string "polymorphic ") (ref typeDef @@ (Core.forallTypeBody $ var "fat")),+    _Type_list>>: lambda "t" $ string "list of " ++ (ref typeDef @@ var "t"),+    _Type_map>>: lambda "mt" $ string "map from "+      ++ (ref typeDef @@ (project _MapType _MapType_keys @@ var "mt"))+      ++ string " to "+      ++ (ref typeDef @@ (project _MapType _MapType_values  @@ var "mt")),+    _Type_optional>>: lambda "ot" $ string "optional " ++ (ref typeDef @@ var "ot"),+    _Type_product>>: constant $ string "tuple",+    _Type_record>>: constant $ string "record",+    _Type_set>>: lambda "st" $ string "set of " ++ (ref typeDef @@ var "st"),+    _Type_sum>>: constant $ string "variant tuple",+    _Type_union>>: constant $ string "union",+    _Type_unit>>: constant $ string "unit",+    _Type_variable>>: constant $ string "instance of a named type",+    _Type_wrap>>: lambda "n" $ string "wrapper for "+      ++ (ref typeDef @@ (project _WrappedType _WrappedType_object @@ var "n"))]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Describe/Mantle.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Describe.Mantle where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.describe.mantle") elements+    []+    kernelTypesModules $+    Just "Natural-language descriptions for hydra.mantle types"+  where+   elements = [+     el precisionDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++precisionDef :: TBinding (Precision -> String)+precisionDef = define "precision" $+  doc "Display numeric precision as a string" $+  match _Precision Nothing [+    _Precision_arbitrary>>: constant $ string "arbitrary-precision",+    _Precision_bits>>: lambda "bits" $ Literals.showInt32 (var "bits") ++ string "-bit"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Encode/Core.hs view
@@ -0,0 +1,507 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Encode.Core where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting++import qualified Hydra.Encode.Core as EncodeCore+++module_ :: Module+module_ = Module (Namespace "hydra.encode.core") elements+    [Rewriting.module_]+    kernelTypesModules $+    Just ("Mapping of hydra.core constructs in a host language like Haskell or Java "+      <> " to their native Hydra counterparts as terms. "+      <> " This includes an implementation of LambdaGraph's epsilon encoding (types to terms).")+  where+    elements = encodingElements <> extraElements+    encodingElements = [+      el annotatedTermDef,+      el annotatedTypeDef,+      el applicationDef,+      el applicationTypeDef,+      el caseStatementDef,+      el eliminationDef,+      el fieldDef,+      el fieldTypeDef,+      el floatTypeDef,+      el floatValueDef,+      el functionDef,+      el functionTypeDef,+      el injectionDef,+      el integerTypeDef,+      el integerValueDef,+      el lambdaDef,+      el forallTypeDef,+      el letDef,+      el letBindingDef,+      el literalDef,+      el literalTypeDef,+      el mapTypeDef,+      el nameDef,+      el projectionDef,+      el recordDef,+      el rowTypeDef,+      el sumDef,+      el termDef,+      el tupleProjectionDef,+      el typeDef,+      el typeLambdaDef,+      el typeSchemeDef,+      el typedTermDef,+      el wrappedTermDef,+      el wrappedTypeDef]+    -- TODO: move these into another module+    extraElements = [+      el isEncodedTypeDef,+      el isTypeDef,+      el isUnitTermDef,+      el isUnitTypeDef]++define :: String -> TTerm x -> TBinding x+define label = definitionInModule module_ (decapitalize label)++coreEncodingExtrasDefinition :: String -> TTerm a -> TBinding a+coreEncodingExtrasDefinition = definitionInModule module_++encodedBinary :: TTerm String -> TTerm Term+encodedBinary = encodedLiteral . Core.literalBinary++encodedBoolean :: TTerm Bool -> TTerm Term+encodedBoolean = encodedLiteral . Core.literalBoolean++encodedCase :: Name -> Name -> TTerm (a -> Term) -> Field+encodedCase tname fname enc = field fname $ lambda "v" $ encodedVariant tname fname (enc @@ var "v")++encodedField :: Name -> TTerm Term -> TTerm Term+encodedField fname term = encodedFieldRaw (encodedName fname) term++encodedFieldRaw :: TTerm Name -> TTerm Term -> TTerm Term+encodedFieldRaw (TTerm fname) (TTerm term) = TTerm $ Terms.record _Field [+  Field _Field_name fname,+  Field _Field_term term]++encodedFloatValue :: TTerm FloatValue -> TTerm Term+encodedFloatValue = encodedLiteral . Core.literalFloat++encodedInjection :: Name -> Name -> TTerm Term -> TTerm Term+encodedInjection tname fname term = TTerm $ Terms.record _Injection [+  field _Injection_typeName $ encodedName tname,+  field _Injection_field $ encodedField fname term]++encodedInt32 :: TTerm Int -> TTerm Term+encodedInt32 v = encodedIntegerValue $ variant _IntegerValue _IntegerValue_int32 v++encodedIntegerValue :: TTerm IntegerValue -> TTerm Term+encodedIntegerValue = encodedLiteral . Core.literalInteger++encodedList :: TTerm [a] -> TTerm Term+encodedList = variant _Term _Term_list++encodedLiteral :: TTerm Literal -> TTerm Term+encodedLiteral = variant _Term _Term_literal++encodedMap :: TTerm (M.Map k v) -> TTerm Term+encodedMap = variant _Term _Term_map++encodedName :: Name -> TTerm Name+encodedName = wrap _Name . string . unName++encodedWrappedTerm :: Name -> TTerm Term -> TTerm Term+encodedWrappedTerm name = encodedWrappedTermRaw (encodedName name)++encodedWrappedTermRaw :: TTerm Name -> TTerm Term -> TTerm Term+encodedWrappedTermRaw (TTerm name) (TTerm term) = TTerm $ Terms.variant _Term _Term_wrap $ Terms.record _WrappedTerm [+  Field _WrappedTerm_typeName name,+  Field _WrappedTerm_object term]++encodedOptional :: TTerm (Maybe a) -> TTerm Term+encodedOptional = variant _Term _Term_optional++encodedRecord :: Name -> [Field] -> TTerm Term+encodedRecord tname fields = TTerm $ Terms.variant _Term _Term_record $ Terms.record _Record [+    field _Record_typeName $ encodedName tname,+    field _Record_fields $ list (encField <$> fields)]+  where+    encField (Field fname term) = encodedField fname $ TTerm term++encodedSet :: TTerm (S.Set a) -> TTerm Term+encodedSet = variant _Term _Term_set++encodedString :: TTerm String -> TTerm Term+encodedString = encodedLiteral . variant _Literal _Literal_string++encodedUnion :: TTerm Term -> TTerm Term+encodedUnion = variant _Term _Term_union++encodedVariant :: Name -> Name -> TTerm Term -> TTerm Term+encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term++annotatedTermDef :: TBinding (AnnotatedTerm -> Term)+annotatedTermDef = define "AnnotatedTerm" $+  lambda "a" $ variant _Term _Term_annotated $ record _AnnotatedTerm [+    field _AnnotatedTerm_subject $ ref termDef @@ (Core.annotatedTermSubject $ var "a"),+    field _AnnotatedTerm_annotation $ Core.annotatedTermAnnotation $ var "a"]++annotatedTypeDef :: TBinding (AnnotatedType -> Term)+annotatedTypeDef = define "AnnotatedType" $+  lambda "at" $ variant _Term _Term_annotated $ record _AnnotatedTerm [+    field _AnnotatedTerm_subject $ ref typeDef @@ (Core.annotatedTypeSubject $ var "at"),+    field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation $ var "at"]++applicationDef :: TBinding (Application -> Term)+applicationDef = define "Application" $+  lambda "app" $ encodedRecord _Application [+    field _Application_function $ ref termDef @@ (Core.applicationFunction $ var "app"),+    field _Application_argument $ ref termDef @@ (Core.applicationArgument $ var "app")]++applicationTypeDef :: TBinding (ApplicationType -> Term)+applicationTypeDef = define "ApplicationType" $+  lambda "at" $ encodedRecord _ApplicationType [+    field _ApplicationType_function $ ref typeDef @@ (Core.applicationTypeFunction $ var "at"),+    field _ApplicationType_argument $ ref typeDef @@ (Core.applicationTypeArgument $ var "at")]++caseStatementDef :: TBinding (CaseStatement -> Term)+caseStatementDef = define "CaseStatement" $+  lambda "cs" $ encodedRecord _CaseStatement [+    field _CaseStatement_typeName $ ref nameDef @@ (Core.caseStatementTypeName $ var "cs"),+    field _CaseStatement_default $ encodedOptional+      (primitive _optionals_map @@ ref termDef @@ (Core.caseStatementDefault $ var "cs")),+    field _CaseStatement_cases $ encodedList+      (primitive _lists_map @@ ref fieldDef @@ (Core.caseStatementCases $ var "cs"))]++eliminationDef :: TBinding (Elimination -> Term)+eliminationDef = define "Elimination" $+    match _Elimination Nothing [+      ecase _Elimination_product tupleProjectionDef,+      ecase _Elimination_record projectionDef,+      ecase _Elimination_union caseStatementDef,+      ecase _Elimination_wrap nameDef]+  where+    ecase fname funname = encodedCase _Elimination fname (ref funname)++fieldDef :: TBinding (Field -> Term)+fieldDef = define "Field" $+  lambda "f" $ encodedRecord _Field [+    field _Field_name $ encodedWrappedTerm _Name $ encodedString $ (unwrap _Name @@ (Core.fieldName $ var "f")),+    field _Field_term $ ref termDef @@ (Core.fieldTerm $ var "f")]++fieldTypeDef :: TBinding (FieldType -> Term)+fieldTypeDef = define "FieldType" $+  lambda "ft" $ encodedRecord _FieldType [+    field _FieldType_name $ ref nameDef @@ (Core.fieldTypeName $ var "ft"),+    field _FieldType_type $ ref typeDef @@ (Core.fieldTypeType $ var "ft")]++floatTypeDef :: TBinding (FloatType -> Term)+floatTypeDef = define "FloatType" $+    match _FloatType Nothing (cs <$> [+      _FloatType_bigfloat,+      _FloatType_float32,+      _FloatType_float64])+  where+    cs fname = field fname $ constant $ TTerm $ EncodeCore.term $ unTTerm $ unitVariant _FloatType fname++floatValueDef :: TBinding (FloatValue -> Term)+floatValueDef = define "FloatValue" $+  match _FloatValue Nothing (varField <$> [+    _FloatValue_bigfloat,+    _FloatValue_float32,+    _FloatValue_float64])+  where+    varField fname = field fname $ lambda "v" $ encodedVariant _FloatValue fname $ encodedFloatValue $+      variant _FloatValue fname $ var "v"++functionDef :: TBinding (Function -> Term)+functionDef = define "Function" $+    match _Function Nothing [+      ecase _Function_elimination eliminationDef,+      ecase _Function_lambda lambdaDef,+      ecase _Function_primitive nameDef]+  where+    ecase fname funname = encodedCase _Function fname (ref funname)++functionTypeDef :: TBinding (FunctionType -> Term)+functionTypeDef = define "FunctionType" $+  lambda "ft" $ encodedRecord _FunctionType [+    field _FunctionType_domain $ ref typeDef @@ (Core.functionTypeDomain $ var "ft"),+    field _FunctionType_codomain $ ref typeDef @@ (Core.functionTypeCodomain $ var "ft")]++injectionDef :: TBinding (Injection -> Term)+injectionDef = define "Injection" $+  lambda "i" $ encodedRecord _Injection [+    field _Injection_typeName $ ref nameDef @@ (Core.injectionTypeName $ var "i"),+    field _Injection_field $ ref fieldDef @@ (Core.injectionField $ var "i")]++integerTypeDef :: TBinding (IntegerType -> Term)+integerTypeDef = define "IntegerType" $+    match _IntegerType Nothing (cs <$> [+      _IntegerType_bigint,+      _IntegerType_int8,+      _IntegerType_int16,+      _IntegerType_int32,+      _IntegerType_int64,+      _IntegerType_uint8,+      _IntegerType_uint16,+      _IntegerType_uint32,+      _IntegerType_uint64])+  where+    cs fname = field fname $ constant $ TTerm $ EncodeCore.term $ unTTerm $ unitVariant _IntegerType fname++integerValueDef :: TBinding (IntegerValue -> Term)+integerValueDef = define "IntegerValue" $+  match _IntegerValue Nothing (varField <$> [+    _IntegerValue_bigint,+    _IntegerValue_int8,+    _IntegerValue_int16,+    _IntegerValue_int32,+    _IntegerValue_int64,+    _IntegerValue_uint8,+    _IntegerValue_uint16,+    _IntegerValue_uint32,+    _IntegerValue_uint64])+  where+    varField fname = field fname $ lambda "v" $ encodedVariant _IntegerValue fname $ encodedIntegerValue $+      variant _IntegerValue fname $ var "v"++lambdaDef :: TBinding (Lambda -> Term)+lambdaDef = define "Lambda" $+  lambda "l" $ encodedRecord _Lambda [+    field _Lambda_parameter $ ref nameDef @@ (Core.lambdaParameter $ var "l"),+    field _Lambda_domain $ encodedOptional $ primitive _optionals_map @@ ref typeDef @@ (Core.lambdaDomain $ var "l"),+    field _Lambda_body $ ref termDef @@ (Core.lambdaBody $ var "l")]++forallTypeDef :: TBinding (ForallType -> Term)+forallTypeDef = define "ForallType" $+  lambda "lt" $ encodedRecord _ForallType [+    field _ForallType_parameter $ ref nameDef @@ (Core.forallTypeParameter $ var "lt"),+    field _ForallType_body $ ref typeDef @@ (Core.forallTypeBody $ var "lt")]++letDef :: TBinding (Let -> Term)+letDef = define "Let" $+  lambda "l" $ encodedRecord _Let [+    field _Let_bindings $ encodedList (primitive _lists_map @@ ref letBindingDef @@ (Core.letBindings $ var "l")),+    field _Let_environment $ ref termDef @@ (Core.letEnvironment $ var "l")]++letBindingDef :: TBinding (Binding -> Term)+letBindingDef = define "Binding" $+  lambda "b" $ encodedRecord _Binding [+    field _Binding_name $ ref nameDef @@ (Core.bindingName $ var "b"),+    field _Binding_term $ ref termDef @@ (Core.bindingTerm $ var "b"),+    field _Binding_type $ encodedOptional $ primitive _optionals_map @@ ref typeSchemeDef @@ (Core.bindingType $ var "b")]++literalDef :: TBinding (Literal -> Term)+literalDef = define "Literal" $+  match _Literal Nothing [+    varField _Literal_binary $ encodedBinary $ var "v",+    varField _Literal_boolean $ encodedBoolean $ var "v",+    varField _Literal_float (ref floatValueDef @@ var "v"),+    varField _Literal_integer (ref integerValueDef @@ var "v"),+    varField _Literal_string $ encodedString $ var "v"]+  where+    varField fname = field fname . lambda "v" . encodedVariant _Literal fname++literalTypeDef :: TBinding (LiteralType -> Term)+literalTypeDef = define "LiteralType" $+  match _LiteralType Nothing [+    csunit _LiteralType_binary,+    csunit _LiteralType_boolean,+    cs _LiteralType_float floatTypeDef,+    cs _LiteralType_integer integerTypeDef,+    csunit _LiteralType_string]+  where+    cs fname fun = field fname $ lambda "v" $ encodedVariant _LiteralType fname (ref fun @@ var "v")+    csunit fname = field fname $ constant $ TTerm $ EncodeCore.term $ unTTerm $ variant _LiteralType fname unit++mapTypeDef :: TBinding (MapType -> Term)+mapTypeDef = define "MapType" $+    lambda "mt" $ encodedRecord _MapType [+      field _MapType_keys $ ref typeDef @@ (Core.mapTypeKeys $ var "mt"),+      field _MapType_values $ ref typeDef @@ (Core.mapTypeValues $ var "mt")]++nameDef :: TBinding (Name -> Term)+nameDef = define "Name" $+  lambda "fn" $ encodedWrappedTerm _Name $ encodedString $ unwrap _Name @@ var "fn"++projectionDef :: TBinding (Projection -> Term)+projectionDef = define "Projection" $+  lambda "p" $ encodedRecord _Projection [+    field _Projection_typeName $ ref nameDef @@ (Core.projectionTypeName $ var "p"),+    field _Projection_field $ ref nameDef @@ (Core.projectionField $ var "p")]++recordDef :: TBinding (Record -> Term)+recordDef = define "Record" $+  lambda "r" $ encodedRecord _Record [+    field _Record_typeName $ ref nameDef @@ (Core.recordTypeName $ var "r"),+    field _Record_fields $ encodedList (primitive _lists_map @@ (ref fieldDef) @@ (Core.recordFields $ var "r"))]++rowTypeDef :: TBinding (RowType -> Term)+rowTypeDef = define "RowType" $+  lambda "rt" $ encodedRecord _RowType [+    field _RowType_typeName $ ref nameDef @@ (Core.rowTypeTypeName $ var "rt"),+    field _RowType_fields $ encodedList (primitive _lists_map @@ ref fieldTypeDef @@ (Core.rowTypeFields $ var "rt"))]++sumDef :: TBinding (Sum -> Term)+sumDef = define "Sum" $+  lambda "s" $ encodedRecord _Sum [+    field _Sum_index $ encodedInt32 $ Core.sumIndex $ var "s",+    field _Sum_size $ encodedInt32 $ Core.sumSize $ var "s",+    field _Sum_term $ ref termDef @@ (Core.sumTerm $ var "s")]++termDef :: TBinding (Term -> Term)+termDef = define "Term" $+  match _Term Nothing [+    ecase _Term_annotated (ref annotatedTermDef),+    ecase _Term_application (ref applicationDef),+    ecase _Term_function (ref functionDef),+    ecase _Term_let (ref letDef),+    ecase _Term_literal (ref literalDef),+    ecase2 _Term_list $ encodedList $ primitive _lists_map @@ (ref termDef) @@ var "v",+    ecase2 _Term_map $ encodedMap (primitive _maps_bimap @@ ref termDef @@ ref termDef @@ var "v"),+    ecase2 _Term_optional $ encodedOptional (primitive _optionals_map @@ ref termDef @@ var "v"),+    ecase2 _Term_product $ encodedList (primitive _lists_map @@ ref termDef @@ var "v"),+    ecase _Term_record (ref recordDef),+    ecase2 _Term_set $ encodedSet $ primitive _sets_map @@ (ref termDef) @@ var "v",+    ecase _Term_sum (ref sumDef),+    ecase _Term_typeLambda $ ref typeLambdaDef,+    ecase _Term_typeApplication $ ref typedTermDef,+    ecase _Term_union (ref injectionDef),+    ecase _Term_unit $ constant Core.termUnit,+    ecase _Term_variable $ ref nameDef,+    ecase _Term_wrap $ ref wrappedTermDef]+  where+    ecase = encodedCase _Term+    ecase2 fname = field fname . lambda "v" . encodedVariant _Term fname++tupleProjectionDef :: TBinding (TupleProjection -> Term)+tupleProjectionDef = define "TupleProjection" $+  lets [+    "encodeTypes">: lambda "types" $ encodedList $ primitive _lists_map @@ ref typeDef @@ var "types"] $+    lambda "tp" $ encodedRecord _TupleProjection [+      field _TupleProjection_arity $ encodedInt32 $ Core.tupleProjectionArity $ var "tp",+      field _TupleProjection_index $ encodedInt32 $ Core.tupleProjectionIndex $ var "tp",+      field _TupleProjection_domain $ encodedOptional $ primitive _optionals_map @@ var "encodeTypes" @@ (Core.tupleProjectionDomain $ var "tp")]++typeDef :: TBinding (Type -> Term)+typeDef = define "Type" $+  match _Type Nothing [+    field _Type_annotated $ lambda "v" $ variant _Term _Term_annotated $ record _AnnotatedTerm [+      field _AnnotatedTerm_subject $ ref typeDef @@ (Core.annotatedTypeSubject $ var "v"),+      field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation $ var "v"],+    csref _Type_application applicationTypeDef,+    csref _Type_function functionTypeDef,+    csref _Type_forall forallTypeDef,+    csref _Type_list typeDef,+    csref _Type_literal literalTypeDef,+    csref _Type_map mapTypeDef,+    csref _Type_optional typeDef,+    cs _Type_product $ encodedList $ primitive _lists_map @@ ref typeDef @@ var "v",+    csref _Type_record rowTypeDef,+    csref _Type_set typeDef,+    cs _Type_sum $ encodedList $ primitive _lists_map @@ ref typeDef @@ var "v",+    csref _Type_union rowTypeDef,+    field _Type_unit $ constant $ encodedVariant _Type _Type_unit Core.termUnit,+    csref _Type_variable nameDef,+    csref _Type_wrap wrappedTypeDef]+  where+    cs fname term = field fname $ lambda "v" $ encodedVariant _Type fname term+    csref fname fun = cs fname (ref fun @@ var "v")++typeLambdaDef :: TBinding (TypeLambda -> Term)+typeLambdaDef = define "TypeLambda" $+  lambda "l" $ encodedRecord _TypeLambda [+    field _TypeLambda_parameter $ ref nameDef @@ (project _TypeLambda _TypeLambda_parameter @@ var "l"),+    field _TypeLambda_body $ ref termDef @@ (project _TypeLambda _TypeLambda_body @@ var "l")]++typeSchemeDef :: TBinding (TypeScheme -> Term)+typeSchemeDef = define "TypeScheme" $+  lambda "ts" $ encodedRecord _TypeScheme [+    field _TypeScheme_variables $ encodedList (primitive _lists_map @@ ref nameDef @@ (Core.typeSchemeVariables $ var "ts")),+    field _TypeScheme_type $ ref typeDef @@ (Core.typeSchemeType $ var "ts")]++typedTermDef :: TBinding (TypedTerm -> Term)+typedTermDef = define "TypedTerm" $+  lambda "tt" $ encodedRecord _TypedTerm [+    field _TypedTerm_term $ ref termDef @@ (project _TypedTerm _TypedTerm_term @@ var "tt"),+    field _TypedTerm_type $ ref typeDef @@ (project _TypedTerm _TypedTerm_type @@ var "tt")]++wrappedTermDef :: TBinding (WrappedTerm -> Term)+wrappedTermDef = define "WrappedTerm" $+  lambda "n" $ encodedRecord _WrappedTerm [+    field _WrappedTerm_typeName $ ref nameDef @@ (Core.wrappedTermTypeName $ var "n"),+    field _WrappedTerm_object $ ref termDef @@ (Core.wrappedTermObject $ var "n")]++wrappedTypeDef :: TBinding (WrappedType -> Term)+wrappedTypeDef = define "WrappedType" $+  lambda "nt" $ encodedRecord _WrappedType [+    field _WrappedType_typeName $ ref nameDef @@ (Core.wrappedTypeTypeName $ var "nt"),+    field _WrappedType_object $ ref typeDef @@ (Core.wrappedTypeObject $ var "nt")]++-- TODO: move these into another module++isEncodedTypeDef :: TBinding (Term -> Bool)+isEncodedTypeDef = coreEncodingExtrasDefinition "isEncodedType" $+  doc "Determines whether a given term is an encoded type" $+  lambda "t" $ cases _Term (ref Rewriting.deannotateTermDef @@ var "t") (Just false) [+    _Term_application>>: lambda "a" $+      ref isEncodedTypeDef @@ (Core.applicationFunction $ var "a"),+    _Term_union>>: lambda "i" $+      Equality.equal (string $ unName _Type) (Core.unName $ (Core.injectionTypeName $ var "i"))]++isTypeDef :: TBinding (Type -> Bool)+isTypeDef = coreEncodingExtrasDefinition "isType" $+  lambda "t" $ cases _Type (ref Rewriting.deannotateTypeDef @@ var "t") (Just false) [+    _Type_application>>: lambda "a" $+      ref isTypeDef @@ (Core.applicationTypeFunction $ var "a"),+    _Type_forall>>: lambda "l" $+      ref isTypeDef @@ (Core.forallTypeBody $ var "l"),+    _Type_union>>: lambda "rt" $+      Equality.equal (string $ unName _Type) (Core.unName $ (Core.rowTypeTypeName $ var "rt")),+    _Type_variable>>: lambda "v" $ Equality.equal (var "v") (Core.nameLift _Type)]++isUnitTermDef :: TBinding (Term -> Bool)+isUnitTermDef = coreEncodingExtrasDefinition "isUnitTerm" $+  match _Term (Just false) [_Term_unit>>: constant true]++isUnitTypeDef :: TBinding (Type -> Bool)+isUnitTypeDef = coreEncodingExtrasDefinition "isUnitType" $+  match _Type (Just false) [_Type_unit>>: constant true]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Extract/Core.hs view
@@ -0,0 +1,666 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Extract.Core where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+++module_ :: Module+module_ = Module (Namespace "hydra.extract.core") elements+    [Monads.module_, Lexical.module_, Rewriting.module_, ShowCore.module_]+    kernelTypesModules $+    Just ("A DSL for decoding and validating Hydra terms at runtime. This module provides functions to extract typed values from Hydra terms with appropriate error handling.")+  where+   elements = [+     el bigfloatDef,+     el bigfloatValueDef,+     el bigintDef,+     el bigintValueDef,+     el binaryDef,+     el binaryLiteralDef,+     el booleanDef,+     el booleanLiteralDef,+     el caseFieldDef,+     el casesDef,+     el fieldDef,+     el float32Def,+     el float32ValueDef,+     el float64Def,+     el float64ValueDef,+     el floatLiteralDef,+     el floatValueDef,+     el functionTypeDef,+     el injectionDef,+     el int16Def,+     el int16ValueDef,+     el int32Def,+     el int32ValueDef,+     el int64Def,+     el int64ValueDef,+     el int8Def,+     el int8ValueDef,+     el integerLiteralDef,+     el integerValueDef,+     el lambdaBodyDef,+     el lambdaDef,+     el letBindingDef,+     el letTermDef,+     el listDef,+     el listHeadDef,+     el listOfDef,+     el listTypeDef,+     el literalDef,+     el mapDef,+     el mapTypeDef,+     el nArgsDef,+     el optionalDef,+     el optionalTypeDef,+     el pairDef,+     el productTypeDef,+     el recordDef,+     el recordTypeDef,+     el setDef,+     el setOfDef,+     el setTypeDef,+     el stringDef,+     el stringLiteralDef,+     el sumTypeDef,+     el termRecordDef,+     el uint16Def,+     el uint16ValueDef,+     el uint32Def,+     el uint32ValueDef,+     el uint64Def,+     el uint64ValueDef,+     el uint8Def,+     el uint8ValueDef,+     el unionTypeDef,+     el unitDef,+     el unitVariantDef,+     el variantDef,+     el wrapDef,+     el wrappedTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++bigfloatDef :: TBinding (Term -> Flow Graph Double)+bigfloatDef = define "bigfloat" $+  doc "Extract an arbitrary-precision floating-point value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref floatLiteralDef @@ var "l") $ lambda "f" $+      ref bigfloatValueDef @@ var "f"++bigfloatValueDef :: TBinding (FloatValue -> Flow Graph Double)+bigfloatValueDef = define "bigfloatValue" $+  doc "Extract a bigfloat value from a FloatValue" $+  lambda "v" $ cases _FloatValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "bigfloat" @@ (ref ShowCore.floatValueDef @@ var "v")) [+    _FloatValue_bigfloat>>: lambda "f" $ Flows.pure $ var "f"]++bigintDef :: TBinding (Term -> Flow Graph Integer)+bigintDef = define "bigint" $+  doc "Extract an arbitrary-precision integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref bigintValueDef @@ var "i"++bigintValueDef :: TBinding (IntegerValue -> Flow Graph Integer)+bigintValueDef = define "bigintValue" $+  doc "Extract a bigint value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "bigint" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_bigint>>: lambda "i" $ Flows.pure $ var "i"]++binaryDef :: TBinding (Term -> Flow Graph String)+binaryDef = define "binary" $+  doc "Extract a binary data value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ ref binaryLiteralDef++binaryLiteralDef :: TBinding (Literal -> Flow Graph String)+binaryLiteralDef = define "binaryLiteral" $+  doc "Extract a binary literal from a Literal value" $+  lambda "v" $ cases _Literal (var "v") (Just $ ref Monads.unexpectedDef @@ string "binary" @@ (ref ShowCore.literalDef @@ var "v")) [+    _Literal_binary>>: lambda "b" $ Flows.pure $ var "b"]++booleanDef :: TBinding (Term -> Flow Graph Bool)+booleanDef = define "boolean" $+  doc "Extract a boolean value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ ref booleanLiteralDef++booleanLiteralDef :: TBinding (Literal -> Flow Graph Bool)+booleanLiteralDef = define "booleanLiteral" $+  doc "Extract a boolean literal from a Literal value" $+  lambda "v" $ cases _Literal (var "v") (Just $ ref Monads.unexpectedDef @@ string "boolean" @@ (ref ShowCore.literalDef @@ var "v")) [+    _Literal_boolean>>: lambda "b" $ Flows.pure $ var "b"]++-- TODO: nonstandard; move me+caseFieldDef :: TBinding (Name -> String -> Term -> Flow Graph Field)+caseFieldDef = define "caseField" $+  doc "Extract a specific case handler from a case statement term" $+  lambdas ["name", "n", "term"] $ lets [+    "fieldName">: Core.name $ var "n"] $ binds [+    "cs">: ref casesDef @@ var "name" @@ var "term"] $ lets [+    "matching">: Lists.filter+      (lambda "f" $ Core.equalName_ (Core.fieldName $ var "f") (var "fieldName"))+      (Core.caseStatementCases $ var "cs")] $+    Logic.ifElse (Lists.null $ var "matching")+      (Flows.fail $ string "not enough cases")+      (Flows.pure $ Lists.head $ var "matching")++-- TODO: nonstandard; move me+casesDef :: TBinding (Name -> Term -> Flow Graph CaseStatement)+casesDef = define "cases" $+  doc "Extract case statement from a term" $+  lambdas ["name", "term0"] $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "case statement" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_function>>: lambda "function" $ cases _Function (var "function") (Just $ ref Monads.unexpectedDef @@ string "case statement" @@ (ref ShowCore.termDef @@ var "term")) [+        _Function_elimination>>: lambda "elimination" $ cases _Elimination (var "elimination") (Just $ ref Monads.unexpectedDef @@ string "case statement" @@ (ref ShowCore.termDef @@ var "term")) [+          _Elimination_union>>: lambda "cs" $+            Logic.ifElse (Core.equalName_ (Core.caseStatementTypeName $ var "cs") (var "name"))+              (Flows.pure $ var "cs")+              (ref Monads.unexpectedDef @@ ("case statement for type " ++ (Core.unName $ var "name")) @@ (ref ShowCore.termDef @@ var "term"))]]]++-- TODO: nonstandard; move me+fieldDef :: TBinding (Name -> (Term -> Flow Graph x) -> [Field] -> Flow Graph x)+fieldDef = define "field" $+  doc "Extract a field value from a list of fields" $+  lambdas ["fname", "mapping", "fields"] $ lets [+    "matchingFields">: Lists.filter+      (lambda "f" $ Core.equalName_ (Core.fieldName $ var "f") (var "fname"))+      (var "fields")]+    $ Logic.ifElse (Lists.null $ var "matchingFields")+      (Flows.fail $ "field " ++ (Core.unName $ var "fname") ++ " not found")+      (Logic.ifElse (Equality.equal (Lists.length $ var "matchingFields") $ int32 1)+        (Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ (Core.fieldTerm $ Lists.head $ var "matchingFields")) $ var "mapping")+        (Flows.fail $ "multiple fields named " ++ (Core.unName $ var "fname")))++float32Def :: TBinding (Term -> Flow Graph Float)+float32Def = define "float32" $+  doc "Extract a 32-bit floating-point value from a term" $+  lambda "t" $ binds [+    "l">: ref literalDef @@ var "t",+    "f">: ref floatLiteralDef @@ var "l"] $+    ref float32ValueDef @@ var "f"++float32ValueDef :: TBinding (FloatValue -> Flow Graph Float)+float32ValueDef = define "float32Value" $+  doc "Extract a float32 value from a FloatValue" $+  lambda "v" $ cases _FloatValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "float32" @@ (ref ShowCore.floatValueDef @@ var "v")) [+    _FloatValue_float32>>: lambda "f" $ Flows.pure $ var "f"]++float64Def :: TBinding (Term -> Flow Graph Double)+float64Def = define "float64" $+  doc "Extract a 64-bit floating-point value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref floatLiteralDef @@ var "l") $ lambda "f" $+      ref float64ValueDef @@ var "f"++float64ValueDef :: TBinding (FloatValue -> Flow Graph Double)+float64ValueDef = define "float64Value" $+  doc "Extract a float64 value from a FloatValue" $+  lambda "v" $ cases _FloatValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "float64" @@ (ref ShowCore.floatValueDef @@ var "v")) [+    _FloatValue_float64>>: lambda "f" $ Flows.pure $ var "f"]++floatLiteralDef :: TBinding (Literal -> Flow Graph FloatValue)+floatLiteralDef = define "floatLiteral" $+  doc "Extract a floating-point literal from a Literal value" $+  lambda "lit" $ cases _Literal (var "lit") (Just $ ref Monads.unexpectedDef @@ string "floating-point value" @@ (ref ShowCore.literalDef @@ var "lit")) [+    _Literal_float>>: lambda "v" $ Flows.pure $ var "v"]++floatValueDef :: TBinding (Term -> Flow Graph FloatValue)+floatValueDef = define "floatValue" $+  doc "Extract a float value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") (ref floatLiteralDef)++functionTypeDef :: TBinding (Type -> Flow s FunctionType)+functionTypeDef = define "functionType" $+  doc "Extract a function type from a type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "function type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_function>>: lambda "ft" $ Flows.pure $ var "ft"]++-- TODO: nonstandard; move me+injectionDef :: TBinding (Name -> Term -> Flow Graph Field)+injectionDef = define "injection" $+  doc "Extract a field from a union term" $+  lambdas ["expected", "term0"] $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term")+      (Just $ ref Monads.unexpectedDef @@ string "injection" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_union>>: lambda "injection" $+        Logic.ifElse (Core.equalName_ (Core.injectionTypeName $ var "injection") (var "expected"))+          (Flows.pure $ Core.injectionField $ var "injection")+          (ref Monads.unexpectedDef @@ ("injection of type " ++ (Core.unName $ var "expected")) @@ (Core.unName $ Core.injectionTypeName $ var "injection"))]++int16Def :: TBinding (Term -> Flow Graph I.Int16)+int16Def = define "int16" $+  doc "Extract a 16-bit signed integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref int16ValueDef @@ var "i"++int16ValueDef :: TBinding (IntegerValue -> Flow Graph I.Int16)+int16ValueDef = define "int16Value" $+  doc "Extract an int16 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "int16" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_int16>>: lambda "i" $ Flows.pure $ var "i"]++int32Def :: TBinding (Term -> Flow Graph Int)+int32Def = define "int32" $+  doc "Extract a 32-bit signed integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref int32ValueDef @@ var "i"++int32ValueDef :: TBinding (IntegerValue -> Flow Graph Int)+int32ValueDef = define "int32Value" $+  doc "Extract an int32 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "int32" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_int32>>: lambda "i" $ Flows.pure $ var "i"]++int64Def :: TBinding (Term -> Flow Graph I.Int64)+int64Def = define "int64" $+  doc "Extract a 64-bit signed integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref int64ValueDef @@ var "i"++int64ValueDef :: TBinding (IntegerValue -> Flow Graph I.Int64)+int64ValueDef = define "int64Value" $+  doc "Extract an int64 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "int64" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_int64>>: lambda "i" $ Flows.pure $ var "i"]++int8Def :: TBinding (Term -> Flow Graph I.Int8)+int8Def = define "int8" $+  doc "Extract an 8-bit signed integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref int8ValueDef @@ var "i"++int8ValueDef :: TBinding (IntegerValue -> Flow Graph I.Int8)+int8ValueDef = define "int8Value" $+  doc "Extract an int8 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "int8" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_int8>>: lambda "i" $ Flows.pure $ var "i"]++integerLiteralDef :: TBinding (Literal -> Flow Graph IntegerValue)+integerLiteralDef = define "integerLiteral" $+  doc "Extract an integer literal from a Literal value" $+  lambda "lit" $ cases _Literal (var "lit") (Just $ ref Monads.unexpectedDef @@ string "integer value" @@ (ref ShowCore.literalDef @@ var "lit")) [+    _Literal_integer>>: lambda "v" $ Flows.pure $ var "v"]++integerValueDef :: TBinding (Term -> Flow Graph IntegerValue)+integerValueDef = define "integerValue" $+  doc "Extract an integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") (ref integerLiteralDef)++lambdaBodyDef :: TBinding (Term -> Flow Graph Term)+lambdaBodyDef = define "lambdaBody" $+  doc "Extract the body of a lambda term" $+  lambda "term" $ Flows.map (unaryFunction Core.lambdaBody) $ ref lambdaDef @@ var "term"++lambdaDef :: TBinding (Term -> Flow Graph Lambda)+lambdaDef = define "lambda" $+  doc "Extract a lambda from a term" $+  lambda "term0" $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "lambda" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_function>>: lambda "function" $ cases _Function (var "function") (Just $ ref Monads.unexpectedDef @@ string "lambda" @@ (ref ShowCore.termDef @@ var "term")) [+        _Function_lambda>>: lambda "l" $ Flows.pure $ var "l"]]++-- TODO: nonstandard; move me+letBindingDef :: TBinding (String -> Term -> Flow Graph Term)+letBindingDef = define "letBinding" $+  doc "Extract a binding with the given name from a let term" $+  lambdas ["n", "term"] $ lets [+    "name">: Core.name $ var "n"]+    $ Flows.bind (ref letTermDef @@ var "term") $+      lambda "letExpr" $ lets [+        "matchingBindings">: Lists.filter+          (lambda "b" $ Core.equalName_ (Core.bindingName $ var "b") (var "name"))+          (Core.letBindings $ var "letExpr")]+        $ Logic.ifElse (Lists.null $ var "matchingBindings")+          (Flows.fail $ "no such binding: " ++ var "n")+          (Logic.ifElse (Equality.equal (Lists.length $ var "matchingBindings") $ int32 1)+            (Flows.pure $ Core.bindingTerm $ Lists.head $ var "matchingBindings")+            (Flows.fail $ "multiple bindings named " ++ var "n"))++letTermDef :: TBinding (Term -> Flow Graph Let)+letTermDef = define "letTerm" $+  doc "Extract a let expression from a term" $+  lambda "term0" $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "let term" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_let>>: lambda "lt" $ Flows.pure $ var "lt"]++listDef :: TBinding (Term -> Flow Graph [Term])+listDef = define "list" $+  doc "Extract a list of terms from a term" $+  "term" ~>+  "stripped" <<~ ref Lexical.stripAndDereferenceTermDef @@ var "term" $+   cases _Term (var "stripped")+     (Just $ ref Monads.unexpectedDef @@ string "list" @@ (ref ShowCore.termDef @@ var "stripped")) [+     _Term_list>>: "l" ~> produce $ var "l"]++listHeadDef :: TBinding (Term -> Flow Graph Term)+listHeadDef = define "listHead" $+  doc "Extract the first element of a list term" $+  lambda "term" $ Flows.bind (ref listDef @@ var "term") $+    lambda "l" $ Logic.ifElse (Lists.null $ var "l")+      (Flows.fail $ string "empty list")+      (Flows.pure $ Lists.head $ var "l")++listOfDef :: TBinding ((Term -> Flow Graph x) -> Term -> Flow Graph [x])+listOfDef = define "listOf" $+  doc "Extract a list of values from a term, mapping a function over each element" $+  "f" ~> "term" ~>+  "els" <<~ ref listDef @@ var "term" $+  Flows.mapList (var "f") (var "els")++listTypeDef :: TBinding (Type -> Flow s Type)+listTypeDef = define "listType" $+  doc "Extract the element type from a list type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "list type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_list>>: lambda "t" $ Flows.pure $ var "t"]++literalDef :: TBinding (Term -> Flow Graph Literal)+literalDef = define "literal" $+  doc "Extract a literal value from a term" $+  lambda "term0" $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "literal" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_literal>>: lambda "lit" $ Flows.pure $ var "lit"]++mapDef :: TBinding ((Term -> Flow Graph k) -> (Term -> Flow Graph v) -> Term -> Flow Graph (M.Map k v))+mapDef = define "map" $+  doc "Extract a map of key-value pairs from a term, mapping functions over each key and value" $+  lambdas ["fk", "fv", "term0"] $ lets [+    "pair">: lambda "kvPair" $ lets [+      "kterm">: first $ var "kvPair",+      "vterm">: second $ var "kvPair"]+      $ Flows.bind (var "fk" @@ var "kterm") $+        lambda "kval" $ Flows.bind (var "fv" @@ var "vterm") $+          lambda "vval" $ Flows.pure $ pair (var "kval") (var "vval")]+    $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+      lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "map" @@ (ref ShowCore.termDef @@ var "term")) [+        _Term_map>>: lambda "m" $ Flows.map (unaryFunction Maps.fromList) $ Flows.mapList (var "pair") $ Maps.toList $ var "m"]++mapTypeDef :: TBinding (Type -> Flow s MapType)+mapTypeDef = define "mapType" $+  doc "Extract the key and value types from a map type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "map type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_map>>: lambda "mt" $ Flows.pure $ var "mt"]++-- TODO: nonstandard; move me+nArgsDef :: TBinding (Name -> Int -> [Term] -> Flow s ())+nArgsDef = define "nArgs" $+  doc "Ensure a function has the expected number of arguments" $+  lambdas ["name", "n", "args"] $+    Logic.ifElse (Equality.equal (Lists.length $ var "args") (var "n"))+      (Flows.pure unit)+      (ref Monads.unexpectedDef @@ (Strings.concat [+        Literals.showInt32 $ var "n",+        " arguments to primitive ",+        Literals.showString (Core.unName $ var "name")]) @@ (Literals.showInt32 (Lists.length $ var "args")))++optionalDef :: TBinding ((Term -> Flow Graph x) -> Term -> Flow Graph (Maybe x))+optionalDef = define "optional" $+  doc "Extract an optional value from a term, applying a function to the value if present" $+  lambdas ["f", "term0"] $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "optional value" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_optional>>: lambda "mt" $ Optionals.maybe+        (Flows.pure nothing)+        (lambda "t" $ Flows.map (unaryFunction just) $ var "f" @@ var "t")+        (var "mt")]++optionalTypeDef :: TBinding (Type -> Flow s Type)+optionalTypeDef = define "optionalType" $+  doc "Extract the base type from an optional type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "optional type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_optional>>: lambda "t" $ Flows.pure $ var "t"]++pairDef :: TBinding ((Term -> Flow Graph k) -> (Term -> Flow Graph v) -> Term -> Flow Graph (k, v))+pairDef = define "pair" $+  doc "Extract a pair of values from a term, applying functions to each component" $+  lambdas ["kf", "vf", "term0"] $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ string "product" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_product>>: lambda "terms" $+        Logic.ifElse (Equality.equal (Lists.length $ var "terms") $ int32 2)+          (Flows.bind (var "kf" @@ (Lists.head $ var "terms")) $+            lambda "kVal" $ Flows.bind (var "vf" @@ (Lists.head $ Lists.tail $ var "terms")) $+              lambda "vVal" $ Flows.pure $ pair (var "kVal") (var "vVal"))+          (ref Monads.unexpectedDef @@ string "pair" @@ (ref ShowCore.termDef @@ var "term"))]++productTypeDef :: TBinding (Type -> Flow s [Type])+productTypeDef = define "productType" $+  doc "Extract the component types from a product type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "product type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_product>>: lambda "types" $ Flows.pure $ var "types"]++-- TODO: nonstandard; move me+recordDef :: TBinding (Name -> Term -> Flow Graph [Field])+recordDef = define "record" $+  doc "Extract a record's fields from a term" $+  lambdas ["expected", "term0"] $ binds [+    "record">: ref termRecordDef @@ var "term0"] $+    Logic.ifElse (Equality.equal (Core.recordTypeName $ var "record") (var "expected"))+      (Flows.pure $ Core.recordFields $ var "record")+      (ref Monads.unexpectedDef @@ ("record of type " ++ (Core.unName $ var "expected")) @@ (Core.unName $ Core.recordTypeName $ var "record"))++-- TODO: nonstandard; move me+recordTypeDef :: TBinding (Name -> Type -> Flow s [FieldType])+recordTypeDef = define "recordType" $+  doc "Extract the field types from a record type" $+  lambdas ["ename", "typ"] $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "record type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_record>>: lambda "rowType" $+        Logic.ifElse (Core.equalName_ (Core.rowTypeTypeName $ var "rowType") (var "ename"))+          (Flows.pure $ Core.rowTypeFields $ var "rowType")+          (ref Monads.unexpectedDef @@ ("record of type " ++ (Core.unName $ var "ename")) @@ ("record of type " ++ (Core.unName $ Core.rowTypeTypeName $ var "rowType")))]++setDef :: TBinding (Term -> Flow Graph (S.Set Term))+setDef = define "set" $+  doc "Extract a set of terms from a term" $+  "term" ~>+  "stripped" <<~ ref Lexical.stripAndDereferenceTermDef @@ var "term" $+  cases _Term (var "stripped")+    (Just $ ref Monads.unexpectedDef @@ string "set" @@ (ref ShowCore.termDef @@ var "stripped")) [+    _Term_set>>: "s" ~> produce $ var "s"]++setOfDef :: TBinding ((Term -> Flow Graph x) -> Term -> Flow Graph (S.Set x))+setOfDef = define "setOf" $+  doc "Extract a set of values from a term, mapping a function over each element" $+  "f" ~> "term" ~>+  "els" <<~ ref setDef @@ var "term" $+  Flows.mapSet (var "f") (var "els")++setTypeDef :: TBinding (Type -> Flow s Type)+setTypeDef = define "setType" $+  doc "Extract the element type from a set type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "set type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_set>>: lambda "t" $ Flows.pure $ var "t"]++stringDef :: TBinding (Term -> Flow Graph String)+stringDef = define "string" $+  doc "Extract a string value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ ref stringLiteralDef++stringLiteralDef :: TBinding (Literal -> Flow Graph String)+stringLiteralDef = define "stringLiteral" $+  doc "Extract a string literal from a Literal value" $+  lambda "v" $ cases _Literal (var "v") (Just $ ref Monads.unexpectedDef @@ string "string" @@ (ref ShowCore.literalDef @@ var "v")) [+    _Literal_string>>: lambda "s" $ Flows.pure $ var "s"]++sumTypeDef :: TBinding (Type -> Flow s [Type])+sumTypeDef = define "sumType" $+  doc "Extract the component types from a sum type" $+  lambda "typ" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "sum type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_sum>>: lambda "types" $ Flows.pure $ var "types"]++termRecordDef :: TBinding (Term -> Flow Graph Record)+termRecordDef = define "termRecord" $+  doc "Extract a record from a term" $+  lambdas ["term0"] $ binds [+    "term">: ref Lexical.stripAndDereferenceTermDef @@ var "term0"] $+    cases _Term (var "term")+      (Just $ ref Monads.unexpectedDef @@ string "record" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_record>>: lambda "record" $ produce $ var "record"]++uint16Def :: TBinding (Term -> Flow Graph Int)+uint16Def = define "uint16" $+  doc "Extract a 16-bit unsigned integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref uint16ValueDef @@ var "i"++uint16ValueDef :: TBinding (IntegerValue -> Flow Graph Int)+uint16ValueDef = define "uint16Value" $+  doc "Extract a uint16 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "uint16" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_uint16>>: lambda "i" $ Flows.pure $ var "i"]++uint32Def :: TBinding (Term -> Flow Graph I.Int64)+uint32Def = define "uint32" $+  doc "Extract a 32-bit unsigned integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref uint32ValueDef @@ var "i"++uint32ValueDef :: TBinding (IntegerValue -> Flow Graph I.Int64)+uint32ValueDef = define "uint32Value" $+  doc "Extract a uint32 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "uint32" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_uint32>>: lambda "i" $ Flows.pure $ var "i"]++uint64Def :: TBinding (Term -> Flow Graph Integer)+uint64Def = define "uint64" $+  doc "Extract a 64-bit unsigned integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref uint64ValueDef @@ var "i"++uint64ValueDef :: TBinding (IntegerValue -> Flow Graph Integer)+uint64ValueDef = define "uint64Value" $+  doc "Extract a uint64 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "uint64" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_uint64>>: lambda "i" $ Flows.pure $ var "i"]++uint8Def :: TBinding (Term -> Flow Graph I.Int16)+uint8Def = define "uint8" $+  doc "Extract an 8-bit unsigned integer value from a term" $+  lambda "t" $ Flows.bind (ref literalDef @@ var "t") $ lambda "l" $+    Flows.bind (ref integerLiteralDef @@ var "l") $ lambda "i" $+      ref uint8ValueDef @@ var "i"++uint8ValueDef :: TBinding (IntegerValue -> Flow Graph I.Int16)+uint8ValueDef = define "uint8Value" $+  doc "Extract a uint8 value from an IntegerValue" $+  lambda "v" $ cases _IntegerValue (var "v") (Just $ ref Monads.unexpectedDef @@ string "uint8" @@ (ref ShowCore.integerValueDef @@ var "v")) [+    _IntegerValue_uint8>>: lambda "i" $ Flows.pure $ var "i"]++-- TODO: nonstandard; move me+unionTypeDef :: TBinding (Name -> Type -> Flow s [FieldType])+unionTypeDef = define "unionType" $+  doc "Extract the field types from a union type" $+  lambdas ["ename", "typ"] $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "union type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_union>>: lambda "rowType" $+        Logic.ifElse (Equality.equal (Core.rowTypeTypeName $ var "rowType") (var "ename"))+          (Flows.pure $ Core.rowTypeFields $ var "rowType")+          (ref Monads.unexpectedDef @@ ("union of type " ++ (Core.unName $ var "ename")) @@ ("union of type " ++ (Core.unName $ Core.rowTypeTypeName $ var "rowType")))]++unitDef :: TBinding (Term -> Flow Graph ())+unitDef = define "unit" $+  doc "Extract a unit value from a term" $+  lambda "term" $ cases _Term (var "term")+    (Just $ ref Monads.unexpectedDef @@ string "unit" @@ (ref ShowCore.termDef @@ var "term")) [+    _Term_unit>>: constant $ Flows.pure unit]++unitVariantDef :: TBinding (Name -> Term -> Flow Graph Name)+unitVariantDef = define "unitVariant" $+  doc "Extract a unit variant (a variant with an empty record value) from a union term" $+  lambdas ["tname", "term"] $+    bind "field" (ref variantDef @@ var "tname" @@ var "term") $+    bind "ignored" (ref unitDef @@ (Core.fieldTerm $ var "field")) $+    Flows.pure $ Core.fieldName $ var "field"++variantDef :: TBinding (Name -> Term -> Flow Graph Field)+variantDef = define "variant" $+  doc "Extract a field from a union term (alias for injection)" $+  ref injectionDef++-- TODO: nonstandard; move me+wrapDef :: TBinding (Name -> Term -> Flow Graph Term)+wrapDef = define "wrap" $+  doc "Extract the wrapped value from a wrapped term" $+  lambdas ["expected", "term0"] $ Flows.bind (ref Lexical.stripAndDereferenceTermDef @@ var "term0") $+    lambda "term" $ cases _Term (var "term") (Just $ ref Monads.unexpectedDef @@ ("wrap(" ++ (Core.unName $ var "expected") ++ ")") @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_wrap>>: lambda "wrappedTerm" $+        Logic.ifElse (Core.equalName_ (Core.wrappedTermTypeName $ var "wrappedTerm") (var "expected"))+          (Flows.pure $ Core.wrappedTermObject $ var "wrappedTerm")+          (ref Monads.unexpectedDef @@ ("wrapper of type " ++ (Core.unName $ var "expected")) @@ (Core.unName $ Core.wrappedTermTypeName $ var "wrappedTerm"))]++-- TODO: nonstandard; move me+wrappedTypeDef :: TBinding (Name -> Type -> Flow s Type)+wrappedTypeDef = define "wrappedType" $+  doc "Extract the wrapped type from a wrapper type" $+  lambdas ["ename", "typ"] $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "typ"]+    $ cases _Type (var "stripped") (Just $ ref Monads.unexpectedDef @@ string "wrapped type" @@ (ref ShowCore.typeDef @@ var "typ")) [+      _Type_wrap>>: lambda "wrappedType" $+        Logic.ifElse (Core.equalName_ (Core.wrappedTypeTypeName $ var "wrappedType") (var "ename"))+          (Flows.pure $ Core.wrappedTypeObject $ var "wrappedType")+          (ref Monads.unexpectedDef @@ ("wrapped type " ++ (Core.unName $ var "ename")) @@ ("wrapped type " ++ (Core.unName $ Core.wrappedTypeTypeName $ var "wrappedType")))]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Extract/Mantle.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Extract.Mantle where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+++module_ :: Module+module_ = Module (Namespace "hydra.extract.mantle") elements+    [ExtractCore.module_, Monads.module_]+    kernelTypesModules $+    Just ("A DSL for decoding and validating Hydra terms at runtime. This module provides functions to extract typed values from Hydra terms with appropriate error handling.")+  where+   elements = [+     el comparisonDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++comparisonDef :: TBinding (Term -> Flow Graph Comparison)+comparisonDef = define "comparison" $+  doc "Extract a comparison from a term" $+  lambda "term" $+    Flows.bind (ref ExtractCore.unitVariantDef @@ Core.nameLift _Comparison @@ var "term") $+      lambda "fname" $+        Logic.ifElse (Equality.equal (Core.unName $ var "fname") (string $ unName _Comparison_equalTo))+          (Flows.pure Graph.comparisonEqualTo)+          (Logic.ifElse (Equality.equal (Core.unName $ var "fname") (string $ unName _Comparison_lessThan))+            (Flows.pure Graph.comparisonLessThan)+            (Logic.ifElse (Equality.equal (Core.unName $ var "fname") (string $ unName _Comparison_greaterThan))+              (Flows.pure Graph.comparisonGreaterThan)+              (ref Monads.unexpectedDef @@ string "comparison" @@ Core.unName (var "fname"))))
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Formatting.hs view
@@ -0,0 +1,243 @@+module Hydra.Sources.Kernel.Terms.Formatting where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.formatting") elements+    []+    kernelTypesModules $+    Just "String formatting types and functions."+  where+    elements = [+      el capitalizeDef,+      el convertCaseDef,+      el convertCaseCamelToLowerSnakeDef,+      el convertCaseCamelToUpperSnakeDef,+      el convertCasePascalToUpperSnakeDef,+      el decapitalizeDef,+      el escapeWithUnderscoreDef,+      el indentLinesDef,+      el javaStyleCommentDef,+      el mapFirstLetterDef,+      el nonAlnumToUnderscoresDef,+      el sanitizeWithUnderscoresDef,+      el showListDef,+      el stripLeadingAndTrailingWhitespaceDef,+      el withCharacterAliasesDef,+      el wrapLineDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++capitalizeDef :: TBinding (String -> String)+capitalizeDef = define "capitalize" $+  doc "Capitalize the first letter of a string" $+  ref mapFirstLetterDef @@ primitive _strings_toUpper++convertCaseDef :: TBinding (CaseConvention -> CaseConvention -> String -> String)+convertCaseDef = define "convertCase" $+  doc "Convert a string from one case convention to another" $+  lambdas ["from", "to", "original"] $ lets [+    "parts">: lets [+      "byCaps">: lets [+        "splitOnUppercase">: lambda "acc" $ lambda "c" $ Lists.concat2+          (Logic.ifElse (Chars.isUpper $ var "c") emptyParts (list []))+          (Lists.cons (Lists.cons (var "c") (Lists.head $ var "acc")) (Lists.tail $ var "acc"))]+        $ Lists.map (primitive _strings_fromList) $ Lists.foldl (var "splitOnUppercase") emptyParts+          $ Lists.reverse $ Strings.toList (ref decapitalizeDef @@ var "original"),+      "byUnderscores">: Strings.splitOn (string "_") $ var "original"]+      $ (match _CaseConvention Nothing [+        _CaseConvention_camel>>: constant $ var "byCaps",+        _CaseConvention_pascal>>: constant $ var "byCaps",+        _CaseConvention_lowerSnake>>: constant $ var "byUnderscores",+        _CaseConvention_upperSnake>>: constant $ var "byUnderscores"]) @@ var "from"]+    $ (match _CaseConvention Nothing [+      _CaseConvention_camel>>: constant $ ref decapitalizeDef @@ (Strings.cat (Lists.map (ref capitalizeDef <.> primitive _strings_toLower) $ var "parts")),+      _CaseConvention_pascal>>: constant $ Strings.cat (Lists.map (ref capitalizeDef <.> primitive _strings_toLower) $ var "parts"),+      _CaseConvention_lowerSnake>>: constant $ Strings.intercalate (string "_") (Lists.map (primitive _strings_toLower) $ var "parts"),+      _CaseConvention_upperSnake>>: constant $ Strings.intercalate (string "_") (Lists.map (primitive _strings_toUpper) $ var "parts")+      ]) @@ var "to"+  where+    emptyParts = list [list []]++convertCaseCamelToLowerSnakeDef :: TBinding (String -> String)+convertCaseCamelToLowerSnakeDef = define "convertCaseCamelToLowerSnake" $+  doc "Convert a string from camel case to lower snake case" $+  ref convertCaseDef @@ Mantle.caseConventionCamel @@ Mantle.caseConventionLowerSnake++convertCaseCamelToUpperSnakeDef :: TBinding (String -> String)+convertCaseCamelToUpperSnakeDef = define "convertCaseCamelToUpperSnake" $+  doc "Convert a string from camel case to upper snake case" $+  ref convertCaseDef @@ Mantle.caseConventionCamel @@ Mantle.caseConventionUpperSnake++convertCasePascalToUpperSnakeDef :: TBinding (String -> String)+convertCasePascalToUpperSnakeDef = define "convertCasePascalToUpperSnake" $+  doc "Convert a string from pascal case to upper snake case" $+  ref convertCaseDef @@ Mantle.caseConventionPascal @@ Mantle.caseConventionUpperSnake++decapitalizeDef :: TBinding (String -> String)+decapitalizeDef = define "decapitalize" $+  doc "Decapitalize the first letter of a string" $+  ref mapFirstLetterDef @@ primitive _strings_toLower++escapeWithUnderscoreDef :: TBinding (S.Set String -> String -> String)+escapeWithUnderscoreDef = define "escapeWithUnderscore" $+  lambdas ["reserved", "s"] $+    Logic.ifElse (Sets.member (var "s") (var "reserved"))+      (var "s" ++ string "_")+      (var "s")++indentLinesDef :: TBinding (String -> String)+indentLinesDef = define "indentLines" $+  lambda "s" $ lets [+    "indent">: lambda "l" $ string "    " ++ var "l"]+    $ Strings.unlines $ Lists.map (var "indent") $ Strings.lines $ var "s"++javaStyleCommentDef :: TBinding (String -> String)+javaStyleCommentDef = define "javaStyleComment" $+  lambda "s" $ string "/**\n" ++ string " * " ++ var "s" ++ string "\n */"++-- TODO: simplify this helper+mapFirstLetterDef :: TBinding ((String -> String) -> String -> String)+mapFirstLetterDef = define "mapFirstLetter" $+  doc "A helper which maps the first letter of a string to another string" $+  "mapping" ~> "s" ~>+  "list" <~ Strings.toList (var "s") $+  "firstLetter" <~ var "mapping" @@ (Strings.fromList (Lists.pure (Lists.head $ var "list"))) $+  Logic.ifElse+    (Strings.null $ var "s")+    (var "s")+    (Strings.cat2 (var "firstLetter") (Strings.fromList (Lists.tail $ var "list")))++nonAlnumToUnderscoresDef :: TBinding (String -> String)+nonAlnumToUnderscoresDef = define "nonAlnumToUnderscores" $+  "input" ~>+  "isAlnum" <~ ("c" ~> Logic.or+    (Logic.and (Equality.gte (var "c") (char 'A')) (Equality.lte (var "c") (char 'Z')))+    (Logic.or+      (Logic.and (Equality.gte (var "c") (char 'a')) (Equality.lte (var "c") (char 'z')))+      (Logic.and (Equality.gte (var "c") (char '0')) (Equality.lte (var "c") (char '9'))))) $+  "replace" <~ ("p" ~> "c" ~>+    "s" <~ first (var "p") $+    "b" <~ second (var "p") $+    Logic.ifElse (var "isAlnum" @@ var "c")+      (pair (Lists.cons (var "c") (var "s")) (boolean False))+      (Logic.ifElse (var "b")+        (pair (var "s") (boolean True))+        (pair (Lists.cons (char '_') (var "s")) (boolean True)))) $+  "result" <~ Lists.foldl (var "replace") (pair (list []) (boolean False)) (Strings.toList $ var "input") $+  Strings.fromList $ Lists.reverse $ first $ var "result"++sanitizeWithUnderscoresDef :: TBinding (S.Set String -> String -> String)+sanitizeWithUnderscoresDef = define "sanitizeWithUnderscores" $+  "reserved" ~> "s" ~> ref escapeWithUnderscoreDef @@ var "reserved" @@ (ref nonAlnumToUnderscoresDef @@ var "s")++showListDef :: TBinding ((a -> String) -> [a] -> String)+showListDef = define "showList" $+  "f" ~> "els" ~> Strings.cat $ list [+    string "[",+    Strings.intercalate (string ", ") $ Lists.map (var "f") $ var "els",+    string "]"]++stripLeadingAndTrailingWhitespaceDef :: TBinding (String -> String)+stripLeadingAndTrailingWhitespaceDef = define "stripLeadingAndTrailingWhitespace" $+  "s" ~> Strings.fromList $ Lists.dropWhile (unaryFunction Chars.isSpace) $ Lists.reverse $+    Lists.dropWhile (unaryFunction Chars.isSpace) $ Lists.reverse $ Strings.toList $ var "s"++withCharacterAliasesDef :: TBinding (String -> String)+withCharacterAliasesDef = define "withCharacterAliases" $+  lambda "original" $ lets [+    -- Taken from: https://cs.stanford.edu/people/miles/iso8859.html+    "aliases">: Maps.fromList $ list [+      pair (int32 32) (string "sp"),+      pair (int32 33) (string "excl"),+      pair (int32 34) (string "quot"),+      pair (int32 35) (string "num"),+      pair (int32 36) (string "dollar"),+      pair (int32 37) (string "percnt"),+      pair (int32 38) (string "amp"),+      pair (int32 39) (string "apos"),+      pair (int32 40) (string "lpar"),+      pair (int32 41) (string "rpar"),+      pair (int32 42) (string "ast"),+      pair (int32 43) (string "plus"),+      pair (int32 44) (string "comma"),+      pair (int32 45) (string "minus"),+      pair (int32 46) (string "period"),+      pair (int32 47) (string "sol"),+      pair (int32 58) (string "colon"),+      pair (int32 59) (string "semi"),+      pair (int32 60) (string "lt"),+      pair (int32 61) (string "equals"),+      pair (int32 62) (string "gt"),+      pair (int32 63) (string "quest"),+      pair (int32 64) (string "commat"),+      pair (int32 91) (string "lsqb"),+      pair (int32 92) (string "bsol"),+      pair (int32 93) (string "rsqb"),+      pair (int32 94) (string "circ"),+      pair (int32 95) (string "lowbar"),+      pair (int32 96) (string "grave"),+      pair (int32 123) (string "lcub"),+      pair (int32 124) (string "verbar"),+      pair (int32 125) (string "rcub"),+      pair (int32 126) (string "tilde")],+    "alias">: lambda "c" $ Optionals.fromMaybe+      (Lists.pure $ var "c")+      (Optionals.map (unaryFunction Strings.toList) $ Maps.lookup (var "c") (var "aliases"))]+    $ Strings.fromList $ Lists.filter (unaryFunction Chars.isAlphaNum) $ Lists.concat $+      Lists.map (var "alias") $ Strings.toList $ var "original"++wrapLineDef :: TBinding (Int -> String -> String)+wrapLineDef = define "wrapLine" $+  doc "A simple soft line wrap which is suitable for code comments" $+  lambdas ["maxlen", "input"] $ lets [+    "helper">: lambdas ["prev", "rem"] $ lets [+      "trunc">: Lists.take (var "maxlen") (var "rem"),+      "spanResult">: Lists.span (lambda "c" $ Logic.and (Logic.not $ Equality.equal (var "c") (char ' ')) (Logic.not $ Equality.equal (var "c") (char '\t'))) (Lists.reverse $ var "trunc"),+      "prefix">: Lists.reverse $ second $ var "spanResult",+      "suffix">: Lists.reverse $ first $ var "spanResult"]+      $ Logic.ifElse (Equality.lte (Lists.length $ var "rem") (var "maxlen"))+        (Lists.reverse $ Lists.cons (var "rem") (var "prev"))+        (Logic.ifElse (Lists.null $ var "prefix")+          (var "helper" @@ (Lists.cons (var "trunc") (var "prev")) @@ (Lists.drop (var "maxlen") (var "rem")))+          (var "helper" @@ (Lists.cons (Lists.init $ var "prefix") (var "prev")) @@ (Lists.concat2 (var "suffix") ((Lists.drop (var "maxlen") (var "rem"))))))]+    $ Strings.fromList $ Lists.intercalate (list [char '\n']) $ var "helper" @@ (list []) @@ (Strings.toList $ var "input")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Grammars.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Grammars where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Constants as Constants+import qualified Hydra.Sources.Kernel.Terms.Formatting as Formatting+import qualified Hydra.Sources.Kernel.Terms.Names as Names++import Hydra.Grammar as G+++module_ :: Module+module_ = Module (Namespace "hydra.grammars") elements+    [Annotations.module_, Formatting.module_, Names.module_]+    kernelTypesModules $+    Just ("A utility for converting a BNF grammar to a Hydra module.")+  where+   elements = [+     el childNameDef,+     el findNamesDef,+     el grammarToModuleDef,+     el isComplexDef,+     el isNontrivialDef,+     el makeElementsDef,+     el rawNameDef,+     el simplifyDef,+     el toNameDef,+     el wrapTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++childNameDef :: TBinding (String -> String -> String)+childNameDef = define "childName" $+  doc "Generate child name" $+  lambda "lname" $ lambda "n" $+    Strings.cat $ list [var "lname", string "_", ref Formatting.capitalizeDef @@ var "n"]++findNamesDef :: TBinding ([G.Pattern] -> [String])+findNamesDef = define "findNames" $+  doc "Find unique names for patterns" $+  lambda "pats" $ lets [+    "nextName">: lambda "acc" $ lambda "pat" $ lets [+      "names">: first $ var "acc",+      "nameMap">: second $ var "acc",+      "rn">: ref rawNameDef @@ var "pat",+      "nameAndIndex">: Optionals.maybe+        (pair (var "rn") (int32 1))+        (lambda "i" $ pair (Strings.cat2 (var "rn") (Literals.showInt32 $ Math.add (var "i") (int32 1))) (Math.add (var "i") (int32 1)))+        (Maps.lookup (var "rn") (var "nameMap")),+      "nn">: first $ var "nameAndIndex",+      "ni">: second $ var "nameAndIndex"]+      $ pair+        (Lists.cons (var "nn") (var "names"))+        (Maps.insert (var "rn") (var "ni") (var "nameMap"))]+    $ Lists.reverse $ first $ Lists.foldl (var "nextName") (pair (list []) Maps.empty) (var "pats")++grammarToModuleDef :: TBinding (Namespace -> G.Grammar -> Maybe String -> Module)+grammarToModuleDef = define "grammarToModule" $+  doc "Convert a BNF grammar to a Hydra module" $+  lambda "ns" $ lambda "grammar" $ lambda "desc" $ lets [+    "prodPairs">: Lists.map+      (lambda "prod" $ pair+        (Grammar.unSymbol $ Grammar.productionSymbol $ var "prod")+        (Grammar.productionPattern $ var "prod"))+      (Grammar.unGrammar $ var "grammar"),+    "capitalizedNames">: Lists.map (lambda "pair" $ ref Formatting.capitalizeDef @@ (first $ var "pair")) (var "prodPairs"),+    "patterns">: Lists.map (lambda "pair" $ second $ var "pair") (var "prodPairs"),+    "elementPairs">: Lists.concat $ Lists.zipWith+      (ref makeElementsDef @@ false @@ var "ns")+      (var "capitalizedNames")+      (var "patterns"),+    "elements">: Lists.map+      (lambda "pair" $ lets [+        "lname">: first $ var "pair",+        "typ">: ref wrapTypeDef @@ (second $ var "pair")]+        $ ref Annotations.typeElementDef @@ (ref toNameDef @@ var "ns" @@ var "lname") @@ var "typ")+      (var "elementPairs")]+    $ Module.module_ (var "ns") (var "elements") (list []) (list []) (var "desc")++isComplexDef :: TBinding (G.Pattern -> Bool)+isComplexDef = define "isComplex" $+  doc "Check if pattern is complex" $+  lambda "pat" $ match G._Pattern (Just false) [+    _Pattern_labeled>>: lambda "lp" $ ref isComplexDef @@ (Grammar.labeledPatternPattern $ var "lp"),+    _Pattern_sequence>>: lambda "pats" $ ref isNontrivialDef @@ true @@ var "pats",+    _Pattern_alternatives>>: lambda "pats" $ ref isNontrivialDef @@ false @@ var "pats"]+  @@ var "pat"++isNontrivialDef :: TBinding (Bool -> [G.Pattern] -> Bool)+isNontrivialDef = define "isNontrivial" $+  doc "Check if patterns are nontrivial" $+  lambda "isRecord" $ lambda "pats" $ lets [+    "minPats">: ref simplifyDef @@ var "isRecord" @@ var "pats"]+    $ Logic.ifElse (Equality.equal (Lists.length $ var "minPats") (int32 1))+        (match G._Pattern (Just false) [+          _Pattern_labeled>>: constant true] @@ Lists.head (var "minPats"))+        true++makeElementsDef :: TBinding (Bool -> Namespace -> String -> G.Pattern -> [(String, Type)])+makeElementsDef = define "makeElements" $+  doc "Create elements from pattern" $+  lambda "omitTrivial" $ lambda "ns" $ lambda "lname" $ lambda "pat" $ lets [+    "trivial">: Logic.ifElse (var "omitTrivial") (list []) (list [pair (var "lname") TTypes.unit]),++    "forRecordOrUnion">: lambda "isRecord" $ lambda "construct" $ lambda "pats" $ lets [+      "minPats">: ref simplifyDef @@ var "isRecord" @@ var "pats",+      "fieldNames">: ref findNamesDef @@ var "minPats",+      "toField">: lambda "n" $ lambda "p" $ var "descend" @@ var "n" @@+        (lambda "pairs" $ pair (Core.fieldType (Core.name $ var "n") (second $ Lists.head $ var "pairs")) (Lists.tail $ var "pairs")) @@+        var "p",+      "fieldPairs">: Lists.zipWith (var "toField") (var "fieldNames") (var "minPats"),+      "fields">: Lists.map (unaryFunction first) (var "fieldPairs"),+      "els">: Lists.concat $ Lists.map (unaryFunction second) (var "fieldPairs")]+      $ Logic.ifElse (ref isNontrivialDef @@ var "isRecord" @@ var "pats")+          (Lists.cons (pair (var "lname") (var "construct" @@ var "fields")) (var "els"))+          (var "forPat" @@ (Lists.head $ var "minPats")),++    "mod">: lambda "n" $ lambda "f" $ lambda "p" $ var "descend" @@ var "n" @@+      (lambda "pairs" $ Lists.cons (pair (var "lname") (var "f" @@ (second $ Lists.head $ var "pairs"))) (Lists.tail $ var "pairs")) @@+      var "p",++    "descend">: lambda "n" $ lambda "f" $ lambda "p" $ lets [+      "cpairs">: ref makeElementsDef @@ false @@ var "ns" @@ (ref childNameDef @@ var "lname" @@ var "n") @@ var "p"]+      $ var "f" @@ Logic.ifElse (ref isComplexDef @@ var "p")+          (Lists.cons (pair (var "lname") (Core.typeVariable $ ref toNameDef @@ var "ns" @@ (first $ Lists.head $ var "cpairs"))) (var "cpairs"))+          (Logic.ifElse (Lists.null $ var "cpairs")+            (list [pair (var "lname") TTypes.unit])+            (Lists.cons (pair (var "lname") (second $ Lists.head $ var "cpairs")) (Lists.tail $ var "cpairs"))),++    "forPat">: lambda "pat" $ match G._Pattern Nothing [+      _Pattern_alternatives>>: lambda "pats" $ var "forRecordOrUnion" @@ false @@+        (lambda "fields" $ Core.typeUnion $ Core.rowType (ref Constants.placeholderNameDef) (var "fields")) @@ var "pats",+      _Pattern_constant>>: constant $ var "trivial",+      _Pattern_ignored>>: constant $ list [],+      _Pattern_labeled>>: lambda "lp" $ var "forPat" @@ Grammar.labeledPatternPattern (var "lp"),+      _Pattern_nil>>: constant $ var "trivial",+      _Pattern_nonterminal>>: lambda "s" $ list [pair (var "lname") $ Core.typeVariable $+        ref toNameDef @@ var "ns" @@ Grammar.unSymbol (var "s")],+      _Pattern_option>>: lambda "p" $ var "mod" @@ string "Option" @@ (unaryFunction TTypes.optional) @@ var "p",+      _Pattern_plus>>: lambda "p" $ var "mod" @@ string "Elmt" @@ (unaryFunction TTypes.list) @@ var "p",+      _Pattern_regex>>: constant $ list [pair (var "lname") TTypes.string],+      _Pattern_sequence>>: lambda "pats" $ var "forRecordOrUnion" @@ true @@+        (lambda "fields" $ Core.typeRecord $ Core.rowType (ref Constants.placeholderNameDef) (var "fields")) @@ var "pats",+      _Pattern_star>>: lambda "p" $ var "mod" @@ string "Elmt" @@ (unaryFunction TTypes.list) @@ var "p"]+    @@ var "pat"]+    $ var "forPat" @@ var "pat"++rawNameDef :: TBinding (G.Pattern -> String)+rawNameDef = define "rawName" $+  doc "Get raw name from pattern" $+  lambda "pat" $ match G._Pattern Nothing [+    _Pattern_alternatives>>: constant $ string "alts",+    _Pattern_constant>>: lambda "c" $ ref Formatting.capitalizeDef @@ (ref Formatting.withCharacterAliasesDef @@ (Grammar.unConstant $ var "c")),+    _Pattern_ignored>>: constant $ string "ignored",+    _Pattern_labeled>>: lambda "lp" $ Grammar.unLabel $ Grammar.labeledPatternLabel $ var "lp",+    _Pattern_nil>>: constant $ string "none",+    _Pattern_nonterminal>>: lambda "s" $ ref Formatting.capitalizeDef @@ (Grammar.unSymbol $ var "s"),+    _Pattern_option>>: lambda "p" $ ref Formatting.capitalizeDef @@ (ref rawNameDef @@ var "p"),+    _Pattern_plus>>: lambda "p" $ Strings.cat2 (string "listOf") (ref Formatting.capitalizeDef @@ (ref rawNameDef @@ var "p")),+    _Pattern_regex>>: constant $ string "regex",+    _Pattern_sequence>>: constant $ string "sequence",+    _Pattern_star>>: lambda "p" $ Strings.cat2 (string "listOf") (ref Formatting.capitalizeDef @@ (ref rawNameDef @@ var "p"))]+  @@ var "pat"++simplifyDef :: TBinding (Bool -> [G.Pattern] -> [G.Pattern])+simplifyDef = define "simplify" $+  doc "Remove trivial patterns from records" $+  lambda "isRecord" $ lambda "pats" $ lets [+    "isConstant">: lambda "p" $ match G._Pattern (Just false) [+      G._Pattern_constant>>: constant true] @@ var "p"]+    $ Logic.ifElse (var "isRecord")+        (Lists.filter (lambda "p" $ Logic.not $ var "isConstant" @@ var "p") (var "pats"))+        (var "pats")++toNameDef :: TBinding (Namespace -> String -> Name)+toNameDef = define "toName" $+  doc "Convert local name to qualified name" $+  lambda "ns" $ lambda "local" $+    ref Names.unqualifyNameDef @@ (Module.qualifiedName (just $ var "ns") (var "local"))++wrapTypeDef :: TBinding (Type -> Type)+wrapTypeDef = define "wrapType" $+  doc "Wrap a type in a placeholder name, unless it is already a wrapper, record, or union type" $+  lambda "t" $ cases _Type (var "t") (Just $ Core.typeWrap $ Core.wrappedType (Core.nameLift placeholderName) $ var "t") [+    _Type_record>>: constant $ var "t",+    _Type_union>>: constant $ var "t",+    _Type_wrap>>: constant $ var "t"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Inference.hs view
@@ -0,0 +1,1506 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Inference where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Formatting as Formatting+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas as Schemas+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Show.Graph as ShowGraph+import qualified Hydra.Sources.Kernel.Terms.Show.Mantle as ShowMantle+import qualified Hydra.Sources.Kernel.Terms.Show.Typing as ShowTyping+import qualified Hydra.Sources.Kernel.Terms.Sorting as Sorting+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Substitution as Substitution+import qualified Hydra.Sources.Kernel.Terms.Unification as Unification+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.inference") elements+    [Annotations.module_, Lexical.module_, Schemas.module_, Unification.module_,+      ShowCore.module_, ShowGraph.module_, ShowMantle.module_, ShowTyping.module_]+    kernelTypesModules $+    Just "Type inference following Algorithm W, extended for nominal terms and types"+  where+    elements = [+      el bindConstraintsDef,+      el checkSameTypeDef,+      el checkTypeDef,+      el checkTypeVariablesDef,+      el debugInferenceDef,+      el emptyInferenceContextDef,+      el extendContextDef,+      el forInferredTermDef,+      el freeVariablesInContextDef,+      el freshNameDef,+      el freshNamesDef,+      el freshVariableTypeDef,+      el generalizeDef,+      el graphToInferenceContextDef,+      el inferGraphTypesDef,+      el inferInGraphContextDef,+      el inferManyDef,+      el inferTypeOfAnnotatedTermDef,+      el inferTypeOfApplicationDef,+      el inferTypeOfCaseStatementDef,+      el inferTypeOfCollectionDef,+      el inferTypeOfDef,+      el inferTypeOfEliminationDef,+      el inferTypeOfFunctionDef,+      el inferTypeOfInjectionDef,+      el inferTypeOfLambdaDef,+      el inferTypeOfLetNormalizedDef,+      el inferTypeOfLetDef,+      el inferTypeOfListDef,+      el inferTypeOfLiteralDef,+      el inferTypeOfMapDef,+      el inferTypeOfOptionalDef,+      el inferTypeOfPrimitiveDef,+      el inferTypeOfProductDef,+      el inferTypeOfProjectionDef,+      el inferTypeOfRecordDef,+      el inferTypeOfSetDef,+      el inferTypeOfSumDef,+      el inferTypeOfTermDef,+      el inferTypeOfTupleProjectionDef,+      el inferTypeOfTypeLambdaDef,+      el inferTypeOfTypeApplicationDef,+      el inferTypeOfUnwrapDef,+      el inferTypeOfVariableDef,+      el inferTypeOfWrappedTermDef,+      el inferTypesOfTemporaryBindingsDef,+      el initialTypeContextDef,+      el instantiateTypeSchemeDef,+      el isUnboundDef,+      el key_vcountDef,+      el mapConstraintsDef,+      el nominalApplicationDef,+      el normalTypeVariableDef,+      el requireSchemaTypeDef,+      el showInferenceResultDef,+      el toFContextDef,+      el typeOfDef,+      el typeOfInternalDef,+      el typeOfNominalDef,+      el typeOfUnitDef,+      el yieldDef,+      el yieldCheckedDef,+      el yieldDebugDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++--++bindConstraintsDef :: TBinding (InferenceContext -> (TypeSubst -> Flow s a) -> [TypeConstraint] -> Flow s a)+bindConstraintsDef = define "bindConstraints" $+  doc "Bind type constraints and continue with substitution" $+  "cx" ~> "f" ~> "constraints" ~>+  Flows.bind (ref Unification.unifyTypeConstraintsDef @@ Typing.inferenceContextSchemaTypes (var "cx") @@ var "constraints") (var "f")++checkSameTypeDef :: TBinding (String -> [Type] -> Flow s Type)+checkSameTypeDef = define "checkSameType" $+  doc "Ensure all types in a list are equal and return the common type" $+  "desc" ~> "types" ~>+  "h" <~ Lists.head (var "types") $+  "allEqual" <~ Lists.foldl+    ("b" ~> "t" ~> Logic.and (var "b") (Equality.equal (var "t") (var "h")))+    true+    (var "types") $+  Logic.ifElse (var "allEqual")+    (Flows.pure $ var "h")+    (Flows.fail $ Strings.cat $ list [+      string "unequal types ",+      (ref Formatting.showListDef @@ ref ShowCore.typeDef @@ var "types"),+      string " in ",+      var "desc"])++checkTypeDef :: TBinding (S.Set Name -> InferenceContext -> Type -> Term -> Flow s ())+checkTypeDef = define "checkType" $+  doc "Check that a term has the expected type" $+  "k" ~> "g" ~> "t" ~> "e" ~>+  Logic.ifElse (ref debugInferenceDef)+    ("t0" <<~ ref typeOfInternalDef @@ var "g" @@ var "k" @@ (ref toFContextDef @@ var "g") @@ list [] @@ var "e" $+      Logic.ifElse (Equality.equal (var "t0") (var "t"))+        (Flows.pure unit)+        (Flows.fail $ Strings.cat $ list [+          string "type checking failed: expected ",+          ref ShowCore.typeDef @@ var "t",+          string " but found ",+          ref ShowCore.typeDef @@ var "t0"]))+    (Flows.pure unit)++-- W: wfTy+checkTypeVariablesDef :: TBinding (InferenceContext -> S.Set Name -> Type -> Flow s ())+checkTypeVariablesDef = define "checkTypeVariables" $+  doc "Check that all type variables in a type are bound" $+  "cx" ~> "tyvars" ~> "typ" ~>+  trace (Strings.cat $ list [+    string "checking variables of: ",+    ref ShowCore.typeDef @@ var "typ"]) $+  cases _Type (var "typ")+    (Just $+      "result" <<~ Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "tyvars")+        (ref Rewriting.subtypesDef @@ var "typ") $+      Flows.pure unit) [+    _Type_forall>>: "ft" ~> ref checkTypeVariablesDef+      @@ var "cx"+      @@ (Sets.insert (Core.forallTypeParameter $ var "ft") (var "tyvars"))+      @@ (Core.forallTypeBody $ var "ft"),+    _Type_variable>>: "v" ~> Logic.ifElse (Sets.member (var "v") (var "tyvars"))+      (Flows.pure unit)+      (Logic.ifElse (Maps.member (var "v") (Typing.inferenceContextSchemaTypes (var "cx")))+        (Flows.pure unit)+        (Flows.fail $ Strings.cat $ list [+          string "unbound type variable \"",+          Core.unName $ var "v",+          string "\" in ",+          ref ShowCore.typeDef @@ var "typ"]))]++debugInferenceDef :: TBinding Bool+debugInferenceDef = define "debugInference" $+  doc "Disable type checking by default, for better performance" $+  true++emptyInferenceContextDef :: TBinding InferenceContext+emptyInferenceContextDef = define "emptyInferenceContext" $+  doc "An empty inference context" $+  Typing.inferenceContext+    (Phantoms.map M.empty)+    (Phantoms.map M.empty)+    (Phantoms.map M.empty)+    false++extendContextDef :: TBinding ([(Name, TypeScheme)] -> InferenceContext -> InferenceContext)+extendContextDef = define "extendContext" $+  doc "Add (term variable, type scheme) pairs to the typing environment" $+  "pairs" ~> "cx" ~>+  Typing.inferenceContextWithDataTypes (var "cx") $ Maps.union+    (Maps.fromList $ var "pairs")+    (Typing.inferenceContextDataTypes $ var "cx")++forInferredTermDef :: TBinding (InferenceContext -> Term -> String -> (InferenceResult -> a) -> Flow s a)+forInferredTermDef = define "forInferredTerm" $+  doc "Infer a term's type and map over the result" $+  "cx" ~> "term" ~> "desc" ~> "f" ~>+  Flows.map (var "f") $ ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ var "desc"++freeVariablesInContextDef :: TBinding (InferenceContext -> S.Set Name)+freeVariablesInContextDef = define "freeVariablesInContext" $+  doc "Get all free variables in an inference context" $+  "cx" ~>+    Lists.foldl (binaryFunction Sets.union) Sets.empty $+      Lists.map (ref Rewriting.freeVariablesInTypeSchemeSimpleDef) $+        Maps.elems $ Typing.inferenceContextDataTypes $ var "cx"++freshNameDef :: TBinding (Flow s Name)+freshNameDef = define "freshName" $+  doc "Generate a fresh type variable name" $+  Flows.map (ref normalTypeVariableDef) (ref Annotations.nextCountDef @@ ref key_vcountDef)++freshNamesDef :: TBinding (Int -> Flow s [Name])+freshNamesDef = define "freshNames" $+  doc "Generate multiple fresh type variable names" $+  "n" ~> Flows.sequence $ Lists.replicate (var "n") (ref freshNameDef)++freshVariableTypeDef :: TBinding (Flow s Type)+freshVariableTypeDef = define "freshVariableType" $+  doc "Generate a fresh type variable" $+  Flows.map (unaryFunction Core.typeVariable) (ref freshNameDef)++generalizeDef :: TBinding (InferenceContext -> Type -> TypeScheme)+generalizeDef = define "generalize" $+  doc "Generalize a type to a type scheme" $+  "cx" ~> "typ" ~>+  "vars" <~ Lists.nub (Lists.filter (ref isUnboundDef @@ var "cx") $+     ref Rewriting.freeVariablesInTypeOrderedDef @@ var "typ") $+   Core.typeScheme (var "vars") (var "typ")++graphToInferenceContextDef :: TBinding (Graph -> Flow s InferenceContext)+graphToInferenceContextDef = define "graphToInferenceContext" $+  doc "Convert a graph to an inference context" $+  "g0" ~>+  "schema" <~ Optionals.fromMaybe (var "g0") (Graph.graphSchema $ var "g0") $+  "primTypes" <~ Maps.fromList (Lists.map+    ("p" ~> pair (Graph.primitiveName $ var "p") (Graph.primitiveType $ var "p"))+    (Maps.elems $ Graph.graphPrimitives $ var "g0")) $+  "varTypes" <~ Maps.empty $+  "schemaTypes" <<~ ref Schemas.schemaGraphToTypingEnvironmentDef @@ var "schema" $+  produce $ Typing.inferenceContext (var "schemaTypes") (var "primTypes") (var "varTypes") false+--  Flows.fail ("schema types: " ++ (Strings.intercalate ", " $ Lists.map (unaryFunction Core.unName) $ Maps.keys $ var "schemaTypes")+--    ++ (", schema: " ++ (ref ShowGraph.graphDef @@ var "schema")))++inferGraphTypesDef :: TBinding (Graph -> Flow s Graph)+inferGraphTypesDef = define "inferGraphTypes" $+  doc "Infer types for all elements in a graph" $+  "g0" ~>+  "fromLetTerm" <~ ("l" ~>+    "bindings" <~ Core.letBindings (var "l") $+    "env" <~ Core.letEnvironment (var "l") $+    "fromBinding" <~ ("b" ~> pair+      (Core.bindingName $ var "b")+      (var "b")) $+    Graph.graph+      (Maps.fromList $ Lists.map (var "fromBinding") (var "bindings"))+      (Maps.empty)+      (Maps.empty)+      (var "env")+      (Graph.graphPrimitives $ var "g0")+      (Graph.graphSchema $ var "g0")) $+  "toLetTerm" <~ ("g" ~>+    "toBinding" <~ ("el" ~> Core.binding+      (Core.bindingName $ var "el")+      (Core.bindingTerm $ var "el")+      nothing) $+    Core.termLet $ Core.let_+      (Lists.map (var "toBinding") $ Maps.elems $ Graph.graphElements $ var "g")+      (Graph.graphBody $ var "g")) $+  trace "graph inference" $+  "cx" <<~ ref graphToInferenceContextDef @@ var "g0" $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ (var "toLetTerm" @@ var "g0") @@ string "graph term" $+  "term" <~ Typing.inferenceResultTerm (var "result") $+  "ts" <~ Typing.inferenceResultType (var "result") $+  cases _Term (ref Rewriting.normalizeTypeVariablesInTermDef @@ var "term")+    Nothing [+    _Term_let>>: "l" ~> Flows.pure $ var "fromLetTerm" @@ var "l",+    _Term_variable>>: constant $ Flows.fail $ string "Expected inferred graph as let term"]++-- Note: this operation is expensive, as it creates a new typing environment for each individual term+inferInGraphContextDef :: TBinding (Term -> Flow Graph InferenceResult)+inferInGraphContextDef = define "inferInGraphContext" $+  doc "Infer the type of a term in graph context" $+  "term" ~>+  "g" <<~ ref Monads.getStateDef $+  "cx" <<~ ref graphToInferenceContextDef @@ var "g" $+  ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ string "single term"++inferManyDef :: TBinding (InferenceContext -> [(Term, String)] -> Flow s ([Term], [Type], TypeSubst))+inferManyDef = define "inferMany" $+  doc "Infer types for multiple terms" $+  "cx" ~> "pairs" ~>+  Logic.ifElse (Lists.null $ var "pairs")+    (Flows.pure $ pair (list []) $ pair (list []) (ref Substitution.idTypeSubstDef))+    ("e" <~ first (Lists.head $ var "pairs") $+     "desc" <~ second (Lists.head $ var "pairs") $+     "tl" <~ Lists.tail (var "pairs") $+     "result1" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "e" @@ var "desc" $+     "e1" <~ Typing.inferenceResultTerm (var "result1") $+     "t1" <~ Typing.inferenceResultType (var "result1") $+     "s1" <~ Typing.inferenceResultSubst (var "result1") $+     "result2" <<~ ref inferManyDef @@ (ref Substitution.substInContextDef @@ var "s1" @@ var "cx") @@ var "tl" $+     "e2" <~ first (var "result2") $+     "t2" <~ first (second $ var "result2") $+     "s2" <~ second (second $ var "result2") $+     produce $ pair+       (Lists.cons (ref Substitution.substTypesInTermDef @@ var "s2" @@ var "e1") (var "e2"))+       (pair+         (Lists.cons (ref Substitution.substInTypeDef @@ var "s2" @@ var "t1") (var "t2"))+         (ref Substitution.composeTypeSubstDef @@ var "s1" @@ var "s2")))++inferTypeOfDef :: TBinding (InferenceContext -> Term -> Flow s (Term, TypeScheme))+inferTypeOfDef = define "inferTypeOf" $+  doc "Infer the type of a term and return a type scheme" $+  "cx" ~> "term" ~>+  -- Top-level let term which allows us to easily extract an inferred type scheme+  "letTerm" <~ Core.termLet (Core.let_+    (list [Core.binding (Core.name $ string "ignoredVariableName") (var "term") nothing])+    (TTerms.string "ignoredEnvironment")) $+  "unifyAndSubst" <~ ("result" ~>+    "subst" <~ Typing.inferenceResultSubst (var "result") $+    "letResult" <<~ ref Lexical.withEmptyGraphDef @@+      (ref ExtractCore.letTermDef @@+        (ref Rewriting.normalizeTypeVariablesInTermDef @@+          Typing.inferenceResultTerm (var "result"))) $+    "bindings" <~ Core.letBindings (var "letResult") $+    Logic.ifElse (Equality.equal (int32 1) (Lists.length $ var "bindings"))+      ("binding" <~ Lists.head (var "bindings") $+       "term1" <~ Core.bindingTerm (var "binding") $+       "mts" <~ Core.bindingType (var "binding") $+       Optionals.maybe+         (Flows.fail $ string "Expected a type scheme")+         ("ts" ~> Flows.pure $ pair (var "term1") (var "ts"))+         (var "mts"))+      (Flows.fail $ Strings.cat $ list [+        string "Expected a single binding with a type scheme, but got: ",+        Literals.showInt32 $ Lists.length $ var "bindings",+        string " bindings"])) $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "letTerm" @@ string "infer type of term" $+  var "unifyAndSubst" @@ var "result"++inferTypeOfAnnotatedTermDef :: TBinding (InferenceContext -> AnnotatedTerm -> Flow s InferenceResult)+inferTypeOfAnnotatedTermDef = define "inferTypeOfAnnotatedTerm" $+  doc "Infer the type of an annotated term" $+  "cx" ~> "at" ~>+  "term" <~ Core.annotatedTermSubject (var "at") $+  "ann" <~ Core.annotatedTermAnnotation (var "at") $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ string "annotated term" $+  "iterm" <~ Typing.inferenceResultTerm (var "result") $+  "itype" <~ Typing.inferenceResultType (var "result") $+  "isubst" <~ Typing.inferenceResultSubst (var "result") $+  produce $ Typing.inferenceResult+    (Core.termAnnotated $ Core.annotatedTerm (var "iterm") (var "ann"))+    (var "itype")+    (var "isubst")++inferTypeOfApplicationDef :: TBinding (InferenceContext -> Application -> Flow s InferenceResult)+inferTypeOfApplicationDef = define "inferTypeOfApplication" $+  doc "Infer the type of a function application" $+  "cx" ~> "app" ~>+  "e0" <~ Core.applicationFunction (var "app") $+  "e1" <~ Core.applicationArgument (var "app") $+  "lhsResult" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "e0" @@ string "lhs" $+  "a" <~ Typing.inferenceResultTerm (var "lhsResult") $+  "t0" <~ Typing.inferenceResultType (var "lhsResult") $+  "s0" <~ Typing.inferenceResultSubst (var "lhsResult") $+  "rhsResult" <<~ ref inferTypeOfTermDef+    @@ (ref Substitution.substInContextDef @@ var "s0" @@ var "cx")+    @@ var "e1"+    @@ string "rhs" $+  "b" <~ Typing.inferenceResultTerm (var "rhsResult") $+  "t1" <~ Typing.inferenceResultType (var "rhsResult") $+  "s1" <~ Typing.inferenceResultSubst (var "rhsResult") $+  "v" <<~ ref freshNameDef $+  "s2" <<~ ref Unification.unifyTypesDef+    @@ (Typing.inferenceContextSchemaTypes $ var "cx")+    @@ (ref Substitution.substInTypeDef @@ var "s1" @@ var "t0")+    @@ (Core.typeFunction $ Core.functionType (var "t1") (Core.typeVariable $ var "v"))+    @@ string "application lhs" $+  "rExpr" <~ Core.termApplication (Core.application+    (ref Substitution.substTypesInTermDef @@ (ref Substitution.composeTypeSubstDef @@ var "s1" @@ var "s2") @@ var "a")+    (ref Substitution.substTypesInTermDef @@ var "s2" @@ var "b")) $+  "rType" <~ ref Substitution.substInTypeDef @@ var "s2" @@ Core.typeVariable (var "v") $+  "rSubst" <~ ref Substitution.composeTypeSubstListDef @@ list [var "s0", var "s1", var "s2"] $+  produce $ Typing.inferenceResult (var "rExpr") (var "rType") (var "rSubst")++inferTypeOfCaseStatementDef :: TBinding (InferenceContext -> CaseStatement -> Flow s InferenceResult)+inferTypeOfCaseStatementDef = define "inferTypeOfCaseStatement" $+  doc "Infer the type of a case statement" $+  "cx" ~> "caseStmt" ~>+  "tname" <~ Core.caseStatementTypeName (var "caseStmt") $+  "dflt" <~ Core.caseStatementDefault (var "caseStmt") $+  "cases" <~ Core.caseStatementCases (var "caseStmt") $+  "fnames" <~ Lists.map (unaryFunction Core.fieldName) (var "cases") $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "sfields" <<~ ref ExtractCore.unionTypeDef @@ var "tname" @@ var "stype" $+  "dfltResult" <<~ Flows.mapOptional ("t" ~> ref inferTypeOfTermDef @@ var "cx" @@ var "t" @@+    (Strings.cat $ list [string "case ", Core.unName $ var "tname", string ".<default>"])) (var "dflt") $+  "caseResults" <<~ ref inferManyDef @@ var "cx" @@ Lists.map+    ("f" ~> pair (Core.fieldTerm $ var "f")+      (Strings.cat $ list [string "case ", Core.unName $ var "tname", string ".", Core.unName $ Core.fieldName $ var "f"]))+    (var "cases") $+  "iterms" <~ first (var "caseResults") $+  "itypes" <~ first (second $ var "caseResults") $+  "isubst" <~ second (second $ var "caseResults") $+  "codv" <<~ ref freshNameDef $+  "cod" <~ Core.typeVariable (var "codv") $+  "caseMap" <~ Maps.fromList (Lists.map+    ("ft" ~> pair (Core.fieldTypeName $ var "ft") (Core.fieldTypeType $ var "ft"))+    (var "sfields")) $+  "dfltConstraints" <~ ref Monads.optionalToListDef @@ (Optionals.map+    ("r" ~> Typing.typeConstraint (var "cod") (Typing.inferenceResultType $ var "r") (string "match default"))+    (var "dfltResult")) $+  "caseConstraints" <~ Optionals.cat (Lists.zipWith+    ("fname" ~> "itype" ~> Optionals.map+      ("ftype" ~> Typing.typeConstraint+        (var "itype")+        (Core.typeFunction $ Core.functionType (var "ftype") (var "cod"))+        (string "case type"))+      (Maps.lookup (var "fname") (var "caseMap")))+    (var "fnames") (var "itypes")) $+  ref mapConstraintsDef+    @@ var "cx"+    @@ ("subst" ~> ref yieldDef+      @@ (Lists.foldl+        ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable (var "v")))+        (Core.termFunction $ Core.functionElimination $ Core.eliminationUnion $+          Core.caseStatement (var "tname") (Optionals.map (unaryFunction Typing.inferenceResultTerm) $ var "dfltResult") $+          Lists.zipWith ("n" ~> "t" ~> Core.field (var "n") (var "t")) (var "fnames") (var "iterms"))+        (var "svars"))+      @@ (Core.typeFunction $ Core.functionType+          (ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "svars"))+          (var "cod"))+      @@ (ref Substitution.composeTypeSubstListDef+        @@ (Lists.concat $ list [+          ref Monads.optionalToListDef @@ (Optionals.map (unaryFunction Typing.inferenceResultSubst) (var "dfltResult")),+          list [var "isubst", var "subst"]])))+    @@ (Lists.concat $ list [var "dfltConstraints", var "caseConstraints"])++inferTypeOfCollectionDef :: TBinding (InferenceContext -> (Type -> Type) -> ([Term] -> Term) -> String -> [Term] -> Flow s InferenceResult)+inferTypeOfCollectionDef = define "inferTypeOfCollection" $+  doc "Infer the type of a collection" $+  "cx" ~> "typCons" ~> "trmCons" ~> "desc" ~> "els" ~>+  "var" <<~ ref freshNameDef $+  Logic.ifElse (Lists.null $ var "els")+    -- Special case: empty collection requires a type application term+    (Flows.pure $ ref yieldDef+      @@ (Core.termTypeApplication $ Core.typedTerm (var "trmCons" @@ list []) (Core.typeVariable $ var "var"))+      @@ (var "typCons" @@ (Core.typeVariable $ var "var"))+      @@ (ref Substitution.idTypeSubstDef)) $+  -- General case: non-empty collection+  "results" <<~ ref inferManyDef @@ var "cx" @@+    (Lists.zip (var "els") $ Lists.map ("i" ~> Strings.cat $ list [string "#", Literals.showInt32 $ var "i"]) $+      Math.range (int32 1) (Math.add (Lists.length $ var "els") (int32 1))) $+  "terms" <~ first (var "results") $+  "types" <~ first (second $ var "results") $+  "subst1" <~ second (second $ var "results") $+  "constraints" <~ Lists.map ("t" ~> Typing.typeConstraint (Core.typeVariable $ var "var") (var "t") (var "desc")) (var "types") $+  ref mapConstraintsDef @@ var "cx" @@+    ("subst2" ~>+      "iterm" <~ var "trmCons" @@ var "terms" $+      "itype" <~ var "typCons" @@ (Core.typeVariable $ var "var") $+      "isubst" <~ ref Substitution.composeTypeSubstDef @@ var "subst1" @@ var "subst2" $+      ref yieldDef @@ var "iterm" @@ var "itype" @@ var "isubst") @@+    var "constraints"++inferTypeOfEliminationDef :: TBinding (InferenceContext -> Elimination -> Flow s InferenceResult)+inferTypeOfEliminationDef = define "inferTypeOfElimination" $+  doc "Infer the type of an elimination" $+  "cx" ~> "elm" ~>+  cases _Elimination (var "elm") Nothing [+    _Elimination_product>>: "tp" ~> ref inferTypeOfTupleProjectionDef @@ var "cx" @@ var "tp",+    _Elimination_record>>: "p" ~> ref inferTypeOfProjectionDef @@ var "cx" @@ var "p",+    _Elimination_union>>: "c" ~> ref inferTypeOfCaseStatementDef @@ var "cx" @@ var "c",+    _Elimination_wrap>>: "tname" ~> ref inferTypeOfUnwrapDef @@ var "cx" @@ var "tname"]++inferTypeOfFunctionDef :: TBinding (InferenceContext -> Function -> Flow s InferenceResult)+inferTypeOfFunctionDef = define "inferTypeOfFunction" $+  doc "Infer the type of a function" $+  "cx" ~> "f" ~>+  cases _Function (var "f") Nothing [+    _Function_elimination>>: "elm" ~> ref inferTypeOfEliminationDef @@ var "cx" @@ var "elm",+    _Function_lambda>>: "l" ~> ref inferTypeOfLambdaDef @@ var "cx" @@ var "l",+    _Function_primitive>>: "name" ~> ref inferTypeOfPrimitiveDef @@ var "cx" @@ var "name"]++inferTypeOfInjectionDef :: TBinding (InferenceContext -> Injection -> Flow s InferenceResult)+inferTypeOfInjectionDef = define "inferTypeOfInjection" $+  doc "Infer the type of a union injection" $+  "cx" ~> "injection" ~>+  "tname" <~ Core.injectionTypeName (var "injection") $+  "field" <~ Core.injectionField (var "injection") $+  "fname" <~ Core.fieldName (var "field") $+  "term" <~ Core.fieldTerm (var "field") $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ string "injected term" $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "iterm" <~ Typing.inferenceResultTerm (var "result") $+  "ityp" <~ Typing.inferenceResultType (var "result") $+  "isubst" <~ Typing.inferenceResultSubst (var "result") $+  "sfields" <<~ ref ExtractCore.unionTypeDef @@ var "tname" @@ var "stype" $+  "ftyp" <<~ ref Schemas.findFieldTypeDef @@ var "fname" @@ var "sfields" $+  ref mapConstraintsDef @@ var "cx" @@+    ("subst" ~> ref yieldDef+      @@ (Lists.foldl+        ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable (var "v")))+        (Core.termUnion $ Core.injection (var "tname") $ Core.field (var "fname") (var "iterm"))+        (var "svars"))+      @@ (ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "svars"))+      @@ (ref Substitution.composeTypeSubstDef @@ var "isubst" @@ var "subst")) @@+    list [Typing.typeConstraint (var "ftyp") (var "ityp") (string "schema type of injected field")]++inferTypeOfLambdaDef :: TBinding (InferenceContext -> Lambda -> Flow s InferenceResult)+inferTypeOfLambdaDef = define "inferTypeOfLambda" $+  doc "Infer the type of a lambda function" $+  "cx" ~> "lambda" ~>+  "var" <~ Core.lambdaParameter (var "lambda") $+  "body" <~ Core.lambdaBody (var "lambda") $+  "vdom" <<~ ref freshNameDef $+  "dom" <~ Core.typeVariable (var "vdom") $+  "cx2" <~ (ref extendContextDef @@ list [pair (var "var") (Core.typeScheme (list []) (var "dom"))] @@ var "cx") $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx2" @@ var "body" @@ string "lambda body" $+  "iterm" <~ Typing.inferenceResultTerm (var "result") $+  "icod" <~ Typing.inferenceResultType (var "result") $+  "isubst" <~ Typing.inferenceResultSubst (var "result") $+  "rdom" <~ ref Substitution.substInTypeDef @@ var "isubst" @@ var "dom" $+  "rterm" <~ Core.termFunction (Core.functionLambda $ Core.lambda (var "var") (just $ var "rdom") (var "iterm")) $+  "rtype" <~ Core.typeFunction (Core.functionType (var "rdom") (var "icod")) $+  "vars" <~ (Sets.unions $ list [+    ref Rewriting.freeVariablesInTypeDef @@ var "rdom",+    ref Rewriting.freeVariablesInTypeDef @@ var "icod",+    ref freeVariablesInContextDef @@ (ref Substitution.substInContextDef @@ var "isubst" @@ var "cx2")]) $+  "cx3" <~ ref Substitution.substInContextDef @@ var "isubst" @@ var "cx" $+  produce $ Typing.inferenceResult (var "rterm") (var "rtype") (var "isubst")++-- | Normalize a let term before inferring its type.+inferTypeOfLetDef :: TBinding (InferenceContext -> Let -> Flow s InferenceResult)+inferTypeOfLetDef = define "inferTypeOfLet" $+  doc "Normalize a let term before inferring its type" $+  "cx" ~> "let0" ~>+  "bindings0" <~ Core.letBindings (var "let0") $+  "env0" <~ Core.letEnvironment (var "let0") $+  "names" <~ Lists.map (unaryFunction Core.bindingName) (var "bindings0") $+  "nameSet" <~ Sets.fromList (var "names") $+  "toPair" <~ ("binding" ~>+    "name" <~ Core.bindingName (var "binding") $+    "term" <~ Core.bindingTerm (var "binding") $+    pair (var "name") $ Lists.filter ("n" ~> Sets.member (var "n") (var "nameSet")) $+      Sets.toList $ ref Rewriting.freeVariablesInTermDef @@ var "term") $+  "adjList" <~ Lists.map (var "toPair") (var "bindings0") $+  "groups" <~ ref Sorting.topologicalSortComponentsDef @@ var "adjList" $+  "bindingMap" <~ Maps.fromList (Lists.zip (var "names") (var "bindings0")) $+  "createLet" <~ ("e" ~> "group" ~> Core.termLet $ Core.let_+    (Optionals.cat $ Lists.map ("n" ~> Maps.lookup (var "n") (var "bindingMap")) (var "group"))+    (var "e")) $+  -- Note: this rewritten let term will yield success in all cases of dependencies among letrec bindings *except*+  --       in cases of polymorphic recursion. In those cases, type hints will be needed (#162).+  "rewrittenLet" <~ Lists.foldl (var "createLet") (var "env0") (Lists.reverse $ var "groups") $+  "restoreLet" <~ ("iterm" ~>+    "helper" <~ ("level" ~> "bins" ~> "term" ~>+      Logic.ifElse (Equality.equal (var "level") (int32 0))+        (pair (var "bins") (var "term"))+        (cases _Term (var "term") Nothing [+          _Term_let>>: "l" ~>+            "bs" <~ Core.letBindings (var "l") $+            "e" <~ Core.letEnvironment (var "l") $+            var "helper" @@+              (Math.sub (var "level") (int32 1)) @@+              (Lists.concat $ list [var "bs", var "bins"]) @@+              (var "e")])) $+    "result" <~ var "helper" @@ (Lists.length $ var "groups") @@ list [] @@ var "iterm" $+    "bindingList" <~ first (var "result") $+    "e" <~ second (var "result") $+    "bindingMap2" <~ Maps.fromList (Lists.map ("b" ~> pair (Core.bindingName $ var "b") (var "b")) (var "bindingList")) $+    Core.termLet $ Core.let_+      (Optionals.cat $ Lists.map ("n" ~> Maps.lookup (var "n") (var "bindingMap2")) (var "names"))+      (var "e")) $+  "rewriteResult" <~ ("result" ~>+    "iterm" <~ Typing.inferenceResultTerm (var "result") $+    "itype" <~ Typing.inferenceResultType (var "result") $+    "isubst" <~ Typing.inferenceResultSubst (var "result") $+    Typing.inferenceResult (var "restoreLet" @@ var "iterm") (var "itype") (var "isubst")) $+  Flows.map (var "rewriteResult") $+    cases _Term (var "rewrittenLet")+      (Just $ ref inferTypeOfTermDef @@ var "cx" @@ var "rewrittenLet" @@ string "empty let term") [+      _Term_let>>: "l" ~> ref inferTypeOfLetNormalizedDef @@ var "cx" @@ var "l"]++inferTypeOfLetNormalizedDef :: TBinding (InferenceContext -> Let -> Flow s InferenceResult)+inferTypeOfLetNormalizedDef = define "inferTypeOfLetNormalized" $+  doc "Infer the type of a let (letrec) term which is already in a normal form" $+  "cx0" ~> "letTerm" ~>+  "bins0" <~ Core.letBindings (var "letTerm") $+  "env0" <~ Core.letEnvironment (var "letTerm") $+  "bnames" <~ Lists.map (unaryFunction Core.bindingName) (var "bins0") $+  "bvars" <<~ ref freshNamesDef @@ (Lists.length $ var "bins0") $+  "tbins0" <~ Lists.map (unaryFunction Core.typeVariable) (var "bvars") $+  "cx1" <~ (ref extendContextDef+    @@ (Lists.zip (var "bnames") $ Lists.map ("t" ~> Core.typeScheme (list []) (var "t")) (var "tbins0"))+    @@ (var "cx0")) $+  "inferredResult" <<~ ref inferTypesOfTemporaryBindingsDef @@ var "cx1" @@ var "bins0" $+  "bterms1" <~ first (var "inferredResult") $+  "tbins1" <~ first (second $ var "inferredResult") $+  "s1" <~ second (second $ var "inferredResult") $+  "s2" <<~ ref Unification.unifyTypeListsDef @@+    (Typing.inferenceContextSchemaTypes $ var "cx0") @@+    (Lists.map (ref Substitution.substInTypeDef @@ var "s1") (var "tbins0")) @@+    (var "tbins1") @@+    (string "temporary type bindings") $+  "g2" <~ (ref Substitution.substInContextDef @@+    (ref Substitution.composeTypeSubstDef @@ var "s1" @@ var "s2") @@+    (var "cx0")) $+  "tsbins1" <~ (Lists.zip (var "bnames") $+    Lists.map ("t" ~> ref generalizeDef @@ var "g2" @@+      (ref Substitution.substInTypeDef @@ var "s2" @@ var "t")) (var "tbins1")) $+  "envResult" <<~ ref inferTypeOfTermDef @@+    (ref extendContextDef @@ var "tsbins1" @@ var "g2") @@+    (var "env0") @@+    (string "let environment") $+  "env1" <~ Typing.inferenceResultTerm (var "envResult") $+  "tenv" <~ Typing.inferenceResultType (var "envResult") $+  "senv" <~ Typing.inferenceResultSubst (var "envResult") $+  "st1" <~ (Typing.termSubst (Maps.fromList $+    Lists.map+      ("pair" ~>+        "name" <~ first (var "pair") $+        "ts" <~ second (var "pair") $+        pair+          (var "name") $+          (Lists.foldl+            ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable $ var "v"))+            (Core.termVariable $ var "name")+            (Lists.reverse $ Core.typeSchemeVariables $ var "ts")))+      (var "tsbins1"))) $+  "createBinding" <~ ("bindingPair" ~>+    "nameTsPair" <~ first (var "bindingPair") $+    "term" <~ second (var "bindingPair") $+    "name" <~ first (var "nameTsPair") $+    "ts" <~ second (var "nameTsPair") $+    "typeAbstractedTerm" <~ Lists.foldl+      ("b" ~> "v" ~> Core.termTypeLambda $ Core.typeLambda (var "v") (var "b"))+      (ref Substitution.substituteInTermDef @@ var "st1" @@ var "term")+      (Lists.reverse $ Core.typeSchemeVariables $ var "ts") $+    Core.binding (var "name")+      (ref Substitution.substTypesInTermDef @@+        (ref Substitution.composeTypeSubstDef @@ var "senv" @@ var "s2") @@+        (var "typeAbstractedTerm"))+      (just $ ref Substitution.substInTypeSchemeDef @@ var "senv" @@ var "ts")) $+  "bins1" <~ (Lists.map (var "createBinding") $+    Lists.zip (var "tsbins1") (var "bterms1")) $+  "ret" <~ (Typing.inferenceResult+    (Core.termLet $ Core.let_ (var "bins1") (var "env1"))+    (var "tenv")+    (ref Substitution.composeTypeSubstListDef @@ list [var "s1", var "s2", var "senv"])) $+  produce $ var "ret"++inferTypeOfListDef :: TBinding (InferenceContext -> [Term] -> Flow s InferenceResult)+inferTypeOfListDef = define "inferTypeOfList" $+  doc "Infer the type of a list" $+  "cx" ~> ref inferTypeOfCollectionDef+    @@ var "cx"+    @@ (unaryFunction Core.typeList)+    @@ (unaryFunction Core.termList)+    @@ string "list element"++inferTypeOfLiteralDef :: TBinding (InferenceContext -> Literal -> Flow s InferenceResult)+inferTypeOfLiteralDef = define "inferTypeOfLiteral" $+  doc "Infer the type of a literal" $+  "_" ~> "lit" ~>+  produce $ Typing.inferenceResult+    (Core.termLiteral $ var "lit")+    (Core.typeLiteral $ ref Variants.literalTypeDef @@ var "lit")+    (ref Substitution.idTypeSubstDef)++inferTypeOfMapDef :: TBinding (InferenceContext -> M.Map Term Term -> Flow s InferenceResult)+inferTypeOfMapDef = define "inferTypeOfMap" $+  doc "Infer the type of a map" $+  "cx" ~> "m" ~>+  "kvar" <<~ ref freshNameDef $+  "vvar" <<~ ref freshNameDef $+  Logic.ifElse (Maps.null $ var "m")+    -- Special case: empty collection requires a type application term+    (Flows.pure $ ref yieldDef+      @@ (Core.termTypeApplication $ Core.typedTerm (Core.termTypeApplication $ Core.typedTerm+           (Core.termMap Maps.empty) (Core.typeVariable $ var "vvar")) (Core.typeVariable $ var "kvar"))+      @@ (Core.typeMap $ Core.mapType (Core.typeVariable $ var "kvar") (Core.typeVariable $ var "vvar"))+      @@ ref Substitution.idTypeSubstDef) $+    "kresults" <<~ ref inferManyDef @@ var "cx" @@+      (Lists.map ("k" ~> pair (var "k") (string "map key")) $ Maps.keys $ var "m") $+    "kterms" <~ first (var "kresults") $+    "ktypes" <~ first (second $ var "kresults") $+    "ksubst" <~ second (second $ var "kresults") $+    "vresults" <<~ ref inferManyDef+      @@ var "cx"+      @@ (Lists.map ("v" ~> pair (var "v") (string "map value")) $ Maps.elems $ var "m") $+    "vterms" <~ first (var "vresults") $+    "vtypes" <~ first (second $ var "vresults") $+    "vsubst" <~ second (second $ var "vresults") $+    "kcons" <~ Lists.map ("t" ~> Typing.typeConstraint (Core.typeVariable $ var "kvar") (var "t") (string "map key")) (var "ktypes") $+    "vcons" <~ Lists.map ("t" ~> Typing.typeConstraint (Core.typeVariable $ var "vvar") (var "t") (string "map value")) (var "vtypes") $+    ref mapConstraintsDef @@ var "cx" @@+      ("subst" ~> ref yieldDef+        @@ (Core.termMap $ Maps.fromList $ Lists.zip (var "kterms") (var "vterms"))+        @@ (Core.typeMap $ Core.mapType (Core.typeVariable $ var "kvar") (Core.typeVariable $ var "vvar"))+        @@ (ref Substitution.composeTypeSubstListDef @@ list [var "ksubst", var "vsubst", var "subst"])) @@+      (Lists.concat $ list [var "kcons", var "vcons"])++inferTypeOfOptionalDef :: TBinding (InferenceContext -> Maybe Term -> Flow s InferenceResult)+inferTypeOfOptionalDef = define "inferTypeOfOptional" $+  doc "Infer the type of an optional" $+  "cx" ~> "m" ~>+  "trmCons" <~ ("terms" ~> Logic.ifElse (Lists.null $ var "terms")+    (Core.termOptional nothing)+    (Core.termOptional $ just $ Lists.head $ var "terms")) $+  ref inferTypeOfCollectionDef+    @@ var "cx"+    @@ (unaryFunction Core.typeOptional)+    @@ var "trmCons"+    @@ string "optional element"+    @@ (Optionals.maybe (list []) (unaryFunction Lists.singleton) $ var "m")++inferTypeOfPrimitiveDef :: TBinding (InferenceContext -> Name -> Flow s InferenceResult)+inferTypeOfPrimitiveDef = define "inferTypeOfPrimitive" $+  doc "Infer the type of a primitive function" $+  "cx" ~> "name" ~>+  Optionals.maybe+    (Flows.fail $ Strings.cat2 (string "No such primitive: ") (Core.unName $ var "name"))+    ( "scheme" ~>+      "ts" <<~ ref instantiateTypeSchemeDef @@ var "scheme" $+      "vars" <~ Core.typeSchemeVariables (var "ts") $+      "itype" <~ Core.typeSchemeType (var "ts") $+      "iterm" <~ Lists.foldl+        ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable $ var "v"))+        (Core.termFunction $ Core.functionPrimitive $ var "name")+        -- Note: the order of variables is confirmed to be correct.+        -- E.g. ∀[k,v].map<k, v>) instantiates to (∀[t1,t2].map<t1, t2>),+        -- and the inferred term is then hydra.lib.maps.empty!⟨t1⟩⟨t2⟩, i.e. (hydra.lib.maps.empty!⟨t1⟩)⟨t2⟩+        (var "vars") $+      ref yieldCheckedDef @@ var "cx" @@ var "vars" @@ var "iterm" @@ var "itype" @@ ref Substitution.idTypeSubstDef)+    (Maps.lookup (var "name") (Typing.inferenceContextPrimitiveTypes $ var "cx"))++inferTypeOfProductDef :: TBinding (InferenceContext -> [Term] -> Flow s InferenceResult)+inferTypeOfProductDef = define "inferTypeOfProduct" $+  doc "Infer the type of a product (tuple)" $+  "cx" ~> "els" ~>+  Flows.map+    ( "results" ~>+      "iterms" <~ first (var "results") $+      "itypes" <~ first (second $ var "results") $+      "isubst" <~ second (second $ var "results") $+      ref yieldDef @@ (Core.termProduct $ var "iterms") @@ (Core.typeProduct $ var "itypes") @@ var "isubst")+    (ref inferManyDef @@ var "cx" @@ (Lists.map ("e" ~> pair (var "e") (string "tuple element")) $ var "els"))++inferTypeOfProjectionDef :: TBinding (InferenceContext -> Projection -> Flow s InferenceResult)+inferTypeOfProjectionDef = define "inferTypeOfProjection" $+  doc "Infer the type of a record projection" $+  "cx" ~> "proj" ~>+  "tname" <~ Core.projectionTypeName (var "proj") $+  "fname" <~ Core.projectionField (var "proj") $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "sfields" <<~ ref ExtractCore.recordTypeDef @@ var "tname" @@ var "stype" $+  "ftyp" <<~ ref Schemas.findFieldTypeDef @@ var "fname" @@ var "sfields" $+  Flows.pure $ ref yieldDef+    @@ (Lists.foldl+      ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable (var "v")))+      (Core.termFunction $ Core.functionElimination $ Core.eliminationRecord $ Core.projection (var "tname") (var "fname"))+      (var "svars"))+    @@ (Core.typeFunction $ Core.functionType+      (ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "svars"))+      (var "ftyp"))+    @@ ref Substitution.idTypeSubstDef++inferTypeOfRecordDef :: TBinding (InferenceContext -> Record -> Flow s InferenceResult)+inferTypeOfRecordDef = define "inferTypeOfRecord" $+  doc "Infer the type of a record" $+  "cx" ~> "record" ~>+  "tname" <~ Core.recordTypeName (var "record") $+  "fields" <~ Core.recordFields (var "record") $+  "fnames" <~ Lists.map (unaryFunction Core.fieldName) (var "fields") $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "results" <<~ ref inferManyDef @@ var "cx" @@ Lists.map+    ("f" ~> pair+      (Core.fieldTerm $ var "f")+      (Strings.cat2 (string "field ") (Core.unName $ Core.fieldName $ var "f")))+    (var "fields") $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "iterms" <~ first (var "results") $+  "itypes" <~ first (second $ var "results") $+  "isubst" <~ second (second $ var "results") $+  "ityp" <~ Core.typeRecord (Core.rowType (var "tname") $+      Lists.zipWith ("n" ~> "t" ~> Core.fieldType (var "n") (var "t")) (var "fnames") (var "itypes")) $+  ref mapConstraintsDef @@ var "cx" @@+    ( "subst" ~> ref yieldDef+      @@ (Lists.foldl+        ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable (var "v")))+        (Core.termRecord $ Core.record (var "tname") $ Lists.zipWith+                ("n" ~> "t" ~> Core.field (var "n") (var "t"))+                (var "fnames")+                (var "iterms"))+        (var "svars"))+      @@ (ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "svars"))+      @@ (ref Substitution.composeTypeSubstDef @@ var "isubst" @@ var "subst")) @@+    list [Typing.typeConstraint (var "stype") (var "ityp") (string "schema type of record")]++inferTypeOfSetDef :: TBinding (InferenceContext -> S.Set Term -> Flow s InferenceResult)+inferTypeOfSetDef = define "inferTypeOfSet" $+  doc "Infer the type of a set" $+  "cx" ~>+  "s" ~>+  ref inferTypeOfCollectionDef+    @@ var "cx"+    @@ (unaryFunction Core.typeSet)+    @@ ("terms" ~> Core.termSet $ Sets.fromList $ var "terms")+    @@ string "set element"+    @@ (Sets.toList $ var "s")++inferTypeOfSumDef :: TBinding (InferenceContext -> Sum -> Flow s InferenceResult)+inferTypeOfSumDef = define "inferTypeOfSum" $+  doc "Infer the type of a sum type" $+  "cx" ~>+  "sum" ~>+  "i" <~ Core.sumIndex (var "sum") $+  "s" <~ Core.sumSize (var "sum") $+  "term" <~ Core.sumTerm (var "sum") $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ string "sum term" $+  "iterm" <~ Typing.inferenceResultTerm (var "result") $+  "ityp" <~ Typing.inferenceResultType (var "result") $+  "isubst" <~ Typing.inferenceResultSubst (var "result") $+  "varOrTerm" <~ ("t" ~> "j" ~> Logic.ifElse (Equality.equal (var "i") (var "j"))+    (Flows.pure $ Mantle.eitherLeft $ var "t")+    (Flows.map (unaryFunction Mantle.eitherRight) $ ref freshNameDef)) $+  "vars" <<~ Flows.mapList (var "varOrTerm" @@ var "ityp") (Math.range (int32 0) (Math.sub (var "s") (int32 1))) $+  "toType" <~ ("e" ~> cases _Either (var "e")+    Nothing [+    _Either_left>>: "t" ~> var "t",+    _Either_right>>: "v" ~> Core.typeVariable $ var "v"]) $+  produce $ ref yieldDef+    @@ Core.termSum (Core.sum (var "i") (var "s") (var "iterm"))+    @@ Core.typeSum (Lists.map (var "toType") (var "vars"))+    @@ var "isubst"++inferTypeOfTermDef :: TBinding (InferenceContext -> Term -> String -> Flow s InferenceResult)+inferTypeOfTermDef = define "inferTypeOfTerm" $+  doc "Infer the type of a given term" $+  "cx" ~> "term" ~> "desc" ~>+  trace (var "desc") $+  cases _Term (var "term") Nothing [+    _Term_annotated>>: "a" ~> ref inferTypeOfAnnotatedTermDef @@ var "cx" @@ var "a",+    _Term_application>>: "a" ~> ref inferTypeOfApplicationDef @@ var "cx" @@ var "a",+    _Term_function>>: "f" ~> ref inferTypeOfFunctionDef @@ var "cx" @@ var "f",+    _Term_let>>: "l" ~> ref inferTypeOfLetDef @@ var "cx" @@ var "l",+    _Term_list>>: "els" ~> ref inferTypeOfListDef @@ var "cx" @@ var "els",+    _Term_literal>>: "l" ~> ref inferTypeOfLiteralDef @@ var "cx" @@ var "l",+    _Term_map>>: "m" ~> ref inferTypeOfMapDef @@ var "cx" @@ var "m",+    _Term_optional>>: "m" ~> ref inferTypeOfOptionalDef @@ var "cx" @@ var "m",+    _Term_product>>: "els" ~> ref inferTypeOfProductDef @@ var "cx" @@ var "els",+    _Term_record>>: "r" ~> ref inferTypeOfRecordDef @@ var "cx" @@ var "r",+    _Term_set>>: "s" ~> ref inferTypeOfSetDef @@ var "cx" @@ var "s",+    _Term_sum>>: "s" ~> ref inferTypeOfSumDef @@ var "cx" @@ var "s",+    _Term_typeLambda>>: "ta" ~> ref inferTypeOfTypeLambdaDef @@ var "cx" @@ var "ta",+    _Term_typeApplication>>: "tt" ~> ref inferTypeOfTypeApplicationDef @@ var "cx" @@ var "tt",+    _Term_union>>: "i" ~> ref inferTypeOfInjectionDef @@ var "cx" @@ var "i",+    _Term_unit>>: constant $ Flows.pure $ ref typeOfUnitDef,+    _Term_variable>>: "name" ~> ref inferTypeOfVariableDef @@ var "cx" @@ var "name",+    _Term_wrap>>: "w" ~> ref inferTypeOfWrappedTermDef @@ var "cx" @@ var "w"]++inferTypeOfTupleProjectionDef :: TBinding (InferenceContext -> TupleProjection -> Flow s InferenceResult)+inferTypeOfTupleProjectionDef = define "inferTypeOfTupleProjection" $+  doc "Infer the type of a tuple projection" $+  "cx" ~> "tp" ~>+  "arity" <~ Core.tupleProjectionArity (var "tp") $+  "idx" <~ Core.tupleProjectionIndex (var "tp") $+  "vars" <<~ ref freshNamesDef @@ var "arity" $+  "types" <~ Lists.map (unaryFunction Core.typeVariable) (var "vars") $+  "cod" <~ Lists.at (var "idx") (var "types") $+  Flows.pure $ ref yieldDef+    @@ (Core.termFunction $ Core.functionElimination $ Core.eliminationProduct $+        Core.tupleProjection (var "arity") (var "idx") (just $ var "types"))+    @@ (Core.typeFunction $ Core.functionType (Core.typeProduct $ var "types") (var "cod"))+    @@ (ref Substitution.idTypeSubstDef)++inferTypeOfTypeLambdaDef :: TBinding (InferenceContext -> TypeLambda -> Flow s InferenceResult)+inferTypeOfTypeLambdaDef = define "inferTypeOfTypeLambda" $+  doc "Infer the type of a type abstraction" $+  "cx" ~> "ta" ~>+  ref inferTypeOfTermDef @@ var "cx" @@ (Core.typeLambdaBody $ var "ta") @@ string "type abstraction"++inferTypeOfTypeApplicationDef :: TBinding (InferenceContext -> TypedTerm -> Flow s InferenceResult)+inferTypeOfTypeApplicationDef = define "inferTypeOfTypeApplication" $+  doc "Infer the type of a type application" $+  "cx" ~> "tt" ~>+  ref inferTypeOfTermDef @@ var "cx" @@ (Core.typedTermTerm $ var "tt") @@ string "type application term"++inferTypeOfUnwrapDef :: TBinding (InferenceContext -> Name -> Flow s InferenceResult)+inferTypeOfUnwrapDef = define "inferTypeOfUnwrap" $+  doc "Infer the type of an unwrap operation" $+  "cx" ~> "tname" ~>+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "wtyp" <<~ ref ExtractCore.wrappedTypeDef @@ var "tname" @@ var "stype" $+  Flows.pure $ ref yieldDef+    @@ (Lists.foldl+      ("t" ~> "v" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typeVariable (var "v")))+      (Core.termFunction $ Core.functionElimination $ Core.eliminationWrap $ var "tname")+      (var "svars"))+    @@ (Core.typeFunction $ Core.functionType+      (ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "svars"))+      (var "wtyp"))+    @@ ref Substitution.idTypeSubstDef++inferTypeOfVariableDef :: TBinding (InferenceContext -> Name -> Flow s InferenceResult)+inferTypeOfVariableDef = define "inferTypeOfVariable" $+  doc "Infer the type of a variable" $+  "cx" ~> "name" ~>+  Optionals.maybe+    (Flows.fail $ Strings.cat2 (string "Variable not bound to type: ") (Core.unName $ var "name"))+    ( "scheme" ~>+      "ts" <<~ ref instantiateTypeSchemeDef @@ var "scheme" $+      "vars" <~ Core.typeSchemeVariables (var "ts") $+      "itype" <~ Core.typeSchemeType (var "ts") $+      "iterm" <~ Lists.foldl ("t" ~> "ty" ~> Core.termTypeApplication $ Core.typedTerm (var "t") (var "ty"))+        (Core.termVariable $ var "name") (Lists.map (unaryFunction Core.typeVariable) $ var "vars") $+      produce $ Typing.inferenceResult (var "iterm") (var "itype") (ref Substitution.idTypeSubstDef))+    (Maps.lookup (var "name") (Typing.inferenceContextDataTypes $ var "cx"))++inferTypeOfWrappedTermDef :: TBinding (InferenceContext -> WrappedTerm -> Flow s InferenceResult)+inferTypeOfWrappedTermDef = define "inferTypeOfWrappedTerm" $+  doc "Infer the type of a wrapped term" $+  "cx" ~> "wt" ~>+  "tname" <~ Core.wrappedTermTypeName (var "wt") $+  "term" <~ Core.wrappedTermObject (var "wt") $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "result" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "term" @@ string "wrapped term" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "iterm" <~ Typing.inferenceResultTerm (var "result") $+  "ityp" <~ Typing.inferenceResultType (var "result") $+  "isubst" <~ Typing.inferenceResultSubst (var "result") $+  "freshVars" <<~ ref freshNamesDef @@ Lists.length (var "svars") $+  "subst" <~ Typing.typeSubst (Maps.fromList $ Lists.zip (var "svars") (Lists.map (unaryFunction Core.typeVariable) $ var "freshVars")) $+  "stypInst" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "stype" $+  "nominalInst" <~ ref nominalApplicationDef @@ var "tname" @@ Lists.map (unaryFunction Core.typeVariable) (var "freshVars") $+  "expected" <~ Core.typeWrap (Core.wrappedType (var "tname") (var "ityp")) $+  "freeVars" <~ Sets.toList (Sets.unions $ list [+    ref Rewriting.freeVariablesInTypeDef @@ var "ityp",+    ref Rewriting.freeVariablesInTermDef @@ var "iterm",+    Sets.fromList (var "freshVars")]) $+  ref bindConstraintsDef @@ var "cx" @@+    ("subst2" ~> ref yieldCheckedDef @@ var "cx" @@ var "freeVars" @@+      (Core.termWrap $ Core.wrappedTerm (var "tname") (var "iterm")) @@+      var "nominalInst" @@+      (ref Substitution.composeTypeSubstDef @@ var "isubst" @@ var "subst2")) @@+    list [Typing.typeConstraint (var "stypInst") (var "expected") (string "schema type of wrapper")]++inferTypesOfTemporaryBindingsDef :: TBinding (InferenceContext -> [Binding] -> Flow s ([Term], ([Type], TypeSubst)))+inferTypesOfTemporaryBindingsDef = define "inferTypesOfTemporaryBindings" $+  doc "Infer types for temporary let bindings" $+  "cx" ~> "bins" ~>+  Logic.ifElse (Lists.null $ var "bins")+    (Flows.pure $ pair (list []) (pair (list []) (ref Substitution.idTypeSubstDef))) $+  "binding" <~ Lists.head (var "bins") $+  "k" <~ Core.bindingName (var "binding") $+  "v" <~ Core.bindingTerm (var "binding") $+  "tl" <~ Lists.tail (var "bins") $+  "result1" <<~ ref inferTypeOfTermDef @@ var "cx" @@ var "v" @@+    (Strings.cat $ list [+      string "temporary let binding '",+      Core.unName $ var "k",+      string "'"]) $+  "j" <~ Typing.inferenceResultTerm (var "result1") $+  "u_prime" <~ Typing.inferenceResultType (var "result1") $+  "u" <~ Typing.inferenceResultSubst (var "result1") $+  "result2" <<~ ref inferTypesOfTemporaryBindingsDef @@+    (ref Substitution.substInContextDef @@ var "u" @@ var "cx") @@+    var "tl" $+  "h" <~ first (var "result2") $+  "r_prime" <~ first (second $ var "result2") $+  "r" <~ second (second $ var "result2") $+  Flows.pure $ pair+    (Lists.cons (ref Substitution.substTypesInTermDef @@ var "r" @@ var "j") (var "h"))+    (pair+      (Lists.cons (ref Substitution.substInTypeDef @@ var "r" @@ var "u_prime") (var "r_prime"))+      (ref Substitution.composeTypeSubstDef @@ var "u" @@ var "r"))++initialTypeContextDef :: TBinding (Graph -> Flow s TypeContext)+initialTypeContextDef = define "initialTypeContext" $+  doc "Create an initial type context from a graph" $+  "g" ~>+  "toPair" <~ ("pair" ~>+    "name" <~ first (var "pair") $+    "el"  <~ second (var "pair") $+    optCases (Core.bindingType $ var "el")+      (Flows.fail $ "untyped element: " ++ Core.unName (var "name"))+      ("ts" ~> produce $ pair (var "name") (ref Schemas.typeSchemeToFTypeDef @@ var "ts"))) $+  "ix" <<~ ref graphToInferenceContextDef @@ var "g" $+  "types" <<~ Flows.map+    (unaryFunction Maps.fromList)+    (Flows.mapList (var "toPair") (Maps.toList $ Graph.graphElements $ var "g")) $+  produce $ Typing.typeContext (var "types") Sets.empty (var "ix")++-- W: inst+instantiateTypeSchemeDef :: TBinding (TypeScheme -> Flow s TypeScheme)+instantiateTypeSchemeDef = define "instantiateTypeScheme" $+  doc "Instantiate a type scheme with fresh variables" $+  "scheme" ~>+  "oldVars" <~ Core.typeSchemeVariables (var "scheme") $+  "newVars" <<~ ref freshNamesDef @@ Lists.length (var "oldVars") $+  "subst" <~ Typing.typeSubst (Maps.fromList $ Lists.zip (var "oldVars") (Lists.map (unaryFunction Core.typeVariable) $ var "newVars")) $+  produce $ Core.typeScheme (var "newVars") $+    ref Substitution.substInTypeDef @@ var "subst" @@ Core.typeSchemeType (var "scheme")++isUnboundDef :: TBinding (InferenceContext -> Name -> Bool)+isUnboundDef = define "isUnbound" $+  doc "Check if a variable is unbound in context" $+  "cx" ~> "v" ~>+  Logic.and+    (Logic.not $ Sets.member (var "v") $ ref freeVariablesInContextDef @@ var "cx")+    (Logic.not $ Maps.member (var "v") $ Typing.inferenceContextSchemaTypes $ var "cx")++key_vcountDef :: TBinding Name+key_vcountDef = define "key_vcount" $+  doc "Key for inference type variable count" $+  Core.name $ string "inferenceTypeVariableCount"++mapConstraintsDef :: TBinding (InferenceContext -> (TypeSubst -> a) -> [TypeConstraint] -> Flow s a)+mapConstraintsDef = define "mapConstraints" $+  doc "Map over type constraints after unification" $+  "cx" ~> "f" ~> "constraints" ~>+  Flows.map (var "f") $+    ref Unification.unifyTypeConstraintsDef @@ (Typing.inferenceContextSchemaTypes $ var "cx") @@ var "constraints"++nominalApplicationDef :: TBinding (Name -> [Type] -> Type)+nominalApplicationDef = define "nominalApplication" $+  doc "Apply type arguments to a nominal type" $+  "tname" ~> "args" ~>+  Lists.foldl+    ("t" ~> "a" ~> Core.typeApplication $ Core.applicationType (var "t") (var "a"))+    (Core.typeVariable $ var "tname")+    (var "args")++normalTypeVariableDef :: TBinding (Int -> Name)+normalTypeVariableDef = define "normalTypeVariable" $+  doc "Type variable naming convention follows Haskell: t0, t1, etc." $+  "i" ~> Core.name (Strings.cat2 (string "t") (Literals.showInt32 $ var "i"))++requireSchemaTypeDef :: TBinding (InferenceContext -> Name -> Flow s TypeScheme)+requireSchemaTypeDef = define "requireSchemaType" $+  doc "Require a schema type from the context" $+  "cx" ~> "tname" ~>+  Optionals.maybe+    (Flows.fail $ Strings.cat2 (string "No such schema type: ") (Core.unName $ var "tname"))+    ("ts" ~> ref instantiateTypeSchemeDef @@ (ref Rewriting.deannotateTypeSchemeRecursiveDef @@ var "ts"))+    (Maps.lookup (var "tname") (Typing.inferenceContextSchemaTypes $ var "cx"))++showInferenceResultDef :: TBinding (InferenceResult -> String)+showInferenceResultDef = define "showInferenceResult" $+  doc "Show an inference result for debugging" $+  "result" ~>+  "term" <~ Typing.inferenceResultTerm (var "result") $+  "typ" <~ Typing.inferenceResultType (var "result") $+  "subst" <~ Typing.inferenceResultSubst (var "result") $+  Strings.cat $ list [+    string "{term=",+    ref ShowCore.termDef @@ var "term",+    string ", type=",+    ref ShowCore.typeDef @@ var "typ",+    string ", subst=",+    ref ShowTyping.typeSubstDef @@ var "subst",+    string "}"]++toFContextDef :: TBinding (InferenceContext -> M.Map Name Type)+toFContextDef = define "toFContext" $+  doc "Convert inference context to type context" $+  "cx" ~> Maps.map (ref Schemas.typeSchemeToFTypeDef) $ Typing.inferenceContextDataTypes $ var "cx"++typeOfDef :: TBinding (TypeContext -> Term -> Flow s Type)+typeOfDef = define "typeOf" $+  doc "Given a type context, reconstruct the type of a System F term" $+  "tcontext" ~> "term" ~>+  ref typeOfInternalDef @@+    Typing.typeContextInferenceContext (var "tcontext") @@+    Typing.typeContextVariables (var "tcontext") @@+    Typing.typeContextTypes (var "tcontext") @@+    (list []) @@+    var "term"++-- W: typeOf+typeOfInternalDef :: TBinding (InferenceContext -> S.Set Name -> M.Map Name Type -> [Type] -> Term -> Flow s Type)+typeOfInternalDef = define "typeOfInternal" $+  doc "Given internal context, reconstruct the type of a System F term" $+  "cx" ~> "vars" ~> "types" ~> "apptypes" ~> "term" ~>+  "checkApplied" <~ ("e" ~>  Logic.ifElse (Lists.null $ var "apptypes")+    (var "e")+    ( "app" <~ ("t" ~> "apptypes" ~>+        Logic.ifElse (Lists.null $ var "apptypes")+          (Flows.pure $ var "t")+          (cases _Type (var "t")+            (Just $ Flows.fail $ Strings.cat $ list [+              string "not a forall type: ",+              ref ShowCore.typeDef @@ var "t",+              string " in ",+              ref ShowCore.termDef @@ var "term"]) [+            _Type_forall>>: "ft" ~>+              "v" <~ Core.forallTypeParameter (var "ft") $+              "t2" <~ Core.forallTypeBody (var "ft") $+              var "app"+                @@ (ref Substitution.substInTypeDef @@+                  (Typing.typeSubst $ Maps.singleton (var "v") (Lists.head $ var "apptypes")) @@+                  (var "t2"))+                @@ (Lists.tail $ var "apptypes")])) $+      "t1" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "term" $+      exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "t1") $+      var "app" @@ var "t1" @@ var "apptypes")) $++  trace (Strings.cat $ list [+    string "checking type of: ",+    ref ShowCore.termDef @@ var "term",+    string " (vars: ",+    ref Formatting.showListDef @@ unaryFunction Core.unName @@ (Sets.toList $ var "vars"),+    string ", types: ",+    ref Formatting.showListDef @@ unaryFunction Core.unName @@ (Maps.keys $ var "types"),+    string ")"]) $++  cases _Term (var "term")+    (Just $ Flows.fail $ Strings.cat $ list [+      "unsupported term variant in typeOf: ",+      ref ShowMantle.termVariantDef @@ (ref Variants.termVariantDef @@ var "term")]) [++    _Term_annotated>>: "at" ~> var "checkApplied" @@ (+      "term1" <~ Core.annotatedTermSubject (var "at") $+      ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ var "apptypes" @@ var "term1"),++    _Term_application>>: "app" ~> var "checkApplied" @@ (+      "a" <~ Core.applicationFunction (var "app") $+      "b" <~ Core.applicationArgument (var "app") $+      "t1" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "a" $+      "t2" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "b" $+      exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "t1") $+      exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "t2") $+      cases _Type (var "t1")+        (Just $ Flows.fail $ Strings.cat $ list [+          "left hand side of application ",+          ref ShowCore.termDef @@ var "term",+          " is not a function type: ",+          ref ShowCore.typeDef @@ var "t1"]) [+        _Type_function>>: "ft" ~>+          "p" <~ Core.functionTypeDomain (var "ft") $+          "q" <~ Core.functionTypeCodomain (var "ft") $+          Logic.ifElse (Equality.equal (var "p") (var "t2"))+            (Flows.pure $ var "q")+            (Flows.fail $ Strings.cat $ list [+              "expected ",+              ref ShowCore.typeDef @@ var "p",+              " in ",+              ref ShowCore.termDef @@ var "term",+              " but found ",+              ref ShowCore.typeDef @@ var "t2"])]),++    _Term_function>>: "f" ~>+      cases _Function (var "f") Nothing [+        _Function_elimination>>: "elm" ~>+          cases _Elimination (var "elm") Nothing [+            _Elimination_product>>: "tp" ~> var "checkApplied" @@ (+              "index" <~ Core.tupleProjectionIndex (var "tp") $+              "arity" <~ Core.tupleProjectionArity (var "tp") $+              "mtypes" <~ Core.tupleProjectionDomain (var "tp") $+              Optionals.maybe+                (Flows.fail $ Strings.cat $ list [+                  "untyped tuple projection: ",+                  ref ShowCore.termDef @@ var "term"])+                ( "types" ~>+                  exec (Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "vars") (var "types")) $+                  Flows.pure $ Core.typeFunction $ Core.functionType+                    (Core.typeProduct $ var "types")+                    (Lists.at (var "index") (var "types")))+                (var "mtypes")),++            _Elimination_record>>: "p" ~>+              "tname" <~ Core.projectionTypeName (var "p") $+              "fname" <~ Core.projectionField (var "p") $+              "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+              "svars" <~ Core.typeSchemeVariables (var "schemaType") $+              "stype" <~ Core.typeSchemeType (var "schemaType") $+              "sfields" <<~ ref ExtractCore.recordTypeDef @@ var "tname" @@ var "stype" $+              "ftyp" <<~ ref Schemas.findFieldTypeDef @@ var "fname" @@ var "sfields" $+              "subst" <~ Typing.typeSubst (Maps.fromList $ Lists.zip (var "svars") (var "apptypes")) $+              "sftyp" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "ftyp" $+              Flows.pure $ Core.typeFunction $ Core.functionType+                (ref nominalApplicationDef @@ var "tname"  @@ var "apptypes")+                (var "sftyp"),++            _Elimination_union>>: "cs" ~>+              "tname" <~ Core.caseStatementTypeName (var "cs") $+              "dflt" <~ Core.caseStatementDefault (var "cs") $+              "cases" <~ Core.caseStatementCases (var "cs") $+              "cterms" <~ Lists.map (unaryFunction Core.fieldTerm) (var "cases") $+              "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+              "svars" <~ Core.typeSchemeVariables (var "schemaType") $+              "stype" <~ Core.typeSchemeType (var "schemaType") $+              "sfields" <<~ ref ExtractCore.unionTypeDef @@ var "tname" @@ var "stype" $+              "tdflt" <<~ Flows.mapOptional ("e" ~> ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "e") (var "dflt") $+              "tcterms" <<~ Flows.mapList ("e" ~> ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "e") (var "cterms") $+              "cods" <<~ Flows.mapList ("t" ~> Flows.map (unaryFunction Core.functionTypeCodomain) $ ref ExtractCore.functionTypeDef @@ var "t") (var "tcterms") $+              "ts" <~ Optionals.cat (Lists.cons (var "tdflt") $ Lists.map (unaryFunction Optionals.pure) (var "cods")) $+              "cod" <<~ ref checkSameTypeDef @@ string "case branches" @@ var "ts" $+              "subst" <~ Typing.typeSubst (Maps.fromList $ Lists.zip (var "svars") (var "apptypes")) $+              "scod" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "cod" $+              Flows.pure $ Core.typeFunction $ Core.functionType+                (ref nominalApplicationDef @@ var "tname"  @@ var "apptypes")+                (var "scod"),++            _Elimination_wrap>>: "tname" ~>+              "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+              "svars" <~ Core.typeSchemeVariables (var "schemaType") $+              "stype" <~ Core.typeSchemeType (var "schemaType") $+              "wrapped" <<~ ref ExtractCore.wrappedTypeDef @@ var "tname" @@ var "stype" $+              "subst" <~ Typing.typeSubst (Maps.fromList $ Lists.zip (var "svars") (var "apptypes")) $+              "swrapped" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "wrapped" $+              produce $ TTypes.function+                (ref nominalApplicationDef @@ var "tname" @@ var "apptypes")+                (var "swrapped")],++        _Function_lambda>>: "l" ~> var "checkApplied" @@ (+          "x" <~ Core.lambdaParameter (var "l") $+          "mt" <~ Core.lambdaDomain (var "l") $+          "e" <~ Core.lambdaBody (var "l") $+          Optionals.maybe+            (Flows.fail $ Strings.cat $ list [+              string "untyped lambda: ",+              ref ShowCore.termDef @@ var "term"])+            ("t" ~>+              exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "t") $+              "t1" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@+                (Maps.insert (var "x") (var "t") (var "types")) @@ list [] @@ var "e" $+              exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "t1") $+              Flows.pure $ Core.typeFunction $ Core.functionType (var "t") (var "t1"))+            (var "mt")),+        _Function_primitive>>: "name" ~> var "checkApplied" @@ (+          -- Note: no instantiation+          "ts" <~ Optionals.maybe+            (Flows.fail $ Strings.cat $ list [+              string "no such primitive: ",+              Core.unName $ var "name"])+            (unaryFunction Flows.pure)+            (Maps.lookup (var "name") (Typing.inferenceContextPrimitiveTypes $ var "cx")) $+          Flows.map (ref Schemas.typeSchemeToFTypeDef) (var "ts"))],++    _Term_let>>: "letTerm" ~> var "checkApplied" @@ (+      "bs" <~ Core.letBindings (var "letTerm") $+      "env" <~ Core.letEnvironment (var "letTerm") $+      "bnames" <~ Lists.map (unaryFunction Core.bindingName) (var "bs") $+      "bterms" <~ Lists.map (unaryFunction Core.bindingTerm) (var "bs") $+      "btypeOf" <~ ("b" ~>+        Optionals.maybe+          (Flows.fail $ Strings.cat $ list [+            string "untyped let binding in ",+            ref ShowCore.termDef @@ var "term"])+          ("ts" ~> Flows.pure $ ref Schemas.typeSchemeToFTypeDef @@ var "ts")+          (Core.bindingType $ var "b")) $+      "btypes" <<~ Flows.mapList (var "btypeOf") (var "bs") $+      "types2" <~ Maps.union (Maps.fromList $ Lists.zip (var "bnames") (var "btypes")) (var "types") $+      "typeofs" <<~ Flows.mapList (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types2" @@ list []) (var "bterms") $+      exec (Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "vars") (var "btypes")) $+      exec (Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "vars") (var "typeofs")) $+      Logic.ifElse (Equality.equal (var "typeofs") (var "btypes"))+        (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types2" @@ list [] @@ var "env")+        (Flows.fail $ Strings.cat $ list [+          string "binding types disagree: ",+          ref Formatting.showListDef @@ ref ShowCore.typeDef @@ var "btypes",+          string " and ",+          ref Formatting.showListDef @@ ref ShowCore.typeDef @@ var "typeofs",+          string " from terms: ",+          ref Formatting.showListDef @@ ref ShowCore.termDef @@ var "bterms"])),++    _Term_list>>: "els" ~>+      Logic.ifElse (Lists.null $ var "els")+        -- Empty list is polymorphic+        (Logic.ifElse (Equality.equal (Lists.length $ var "apptypes") (int32 1))+          (Flows.pure $ Core.typeList $ Lists.head $ var "apptypes")+          (Flows.fail $ "list type applied to more or less than one argument"))+        -- Nonempty list must have elements of the same type+        ( "eltypes" <<~ Flows.mapList+           (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [])+           (var "els") $+           "unifiedType" <<~ ref checkSameTypeDef @@ string "list elements" @@ var "eltypes" $+           -- Verify the unified type is well-formed in the current scope+           exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "unifiedType") $+           Flows.pure $ Core.typeList $ var "unifiedType"),++    _Term_literal>>: "lit" ~> var "checkApplied" @@ (+      Flows.pure $ Core.typeLiteral $ ref Variants.literalTypeDef @@ var "lit"),++    _Term_map>>: "m" ~>+      Logic.ifElse (Maps.null $ var "m")+        -- Empty map is polymorphic+        (Logic.ifElse (Equality.equal (Lists.length $ var "apptypes") (int32 2))+          (Flows.pure $ Core.typeMap $ Core.mapType+            (Lists.at (int32 1) $ var "apptypes")+            (Lists.at (int32 0) $ var "apptypes"))+          (Flows.fail $ "map type applied to more or less than two arguments"))+        -- Nonempty map must have keys and values of the same type+        (var "checkApplied" @@ (+          "pairs" <~ Maps.toList (var "m") $+          "kt" <<~ Flows.bind+            (Flows.mapList (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list []) $+              Lists.map (unaryFunction first) (var "pairs"))+            (ref checkSameTypeDef @@ string "map keys") $+          "vt" <<~ Flows.bind+            (Flows.mapList (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list []) $+              Lists.map (unaryFunction second) (var "pairs"))+            (ref checkSameTypeDef @@ string "map values") $+          exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "kt") $+          exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "vt") $+          Flows.pure $ Core.typeMap $ Core.mapType (var "kt") (var "vt"))),++    _Term_optional>>: "mt" ~>+      Optionals.maybe+        -- Nothing case is polymorphic+        (Logic.ifElse (Equality.equal (Lists.length $ var "apptypes") (int32 1))+          (Flows.pure $ Core.typeOptional $ Lists.head $ var "apptypes")+          (Flows.fail $ "optional type applied to more or less than one argument"))+        -- Just case: infer type of the contained term+        ("term" ~> var "checkApplied" @@ (+          "termType" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "term" $+           exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "termType") $+           Flows.pure $ Core.typeOptional $ var "termType"))+        (var "mt"),++    _Term_product>>: "tuple" ~> var "checkApplied" @@ (+      "etypes" <<~ Flows.mapList (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list []) (var "tuple") $+      exec (Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "vars") (var "etypes")) $+      Flows.pure $ Core.typeProduct $ var "etypes"),++    _Term_record>>: "record" ~>+      "tname" <~ Core.recordTypeName (var "record") $+      "fields" <~ Core.recordFields (var "record") $+      "ftypes" <<~ Flows.mapList+        (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [])+        (Lists.map (unaryFunction Core.fieldTerm) (var "fields")) $+      exec (Flows.mapList (ref checkTypeVariablesDef @@ var "cx" @@ var "vars") (var "ftypes")) $+      ref typeOfNominalDef+        @@ string "record typeOf"+        @@ var "cx"+        @@ var "tname"+        @@ (Core.typeRecord $ Core.rowType (var "tname") $ Lists.zipWith+          ("n" ~>+           "t" ~>+           Core.fieldType (var "n") (var "t"))+          (Lists.map (unaryFunction Core.fieldName) (var "fields"))+          (var "ftypes")),++    _Term_set>>: "els" ~>+      Logic.ifElse (Sets.null $ var "els")+        -- Empty set is polymorphic+        (Logic.ifElse (Equality.equal (Lists.length $ var "apptypes") (int32 1))+          (Flows.pure $ Core.typeSet $ Lists.head $ var "apptypes")+          (Flows.fail $ "set type applied to more or less than one argument"))+        -- Nonempty set must have elements of the same type+        ( "eltypes" <<~ Flows.mapList+           (ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [])+           (Sets.toList $ var "els") $+           "unifiedType" <<~ ref checkSameTypeDef @@ string "set elements" @@ var "eltypes" $+           -- Verify the unified type is well-formed in the current scope+           exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "unifiedType") $+           Flows.pure $ Core.typeSet $ var "unifiedType"),++    -- TermSum (Sum idx size term1) is ignored for now. See https://github.com/CategoricalData/hydra/issues/134.++    _Term_typeLambda>>: "ta" ~>+      "v" <~ Core.typeLambdaParameter (var "ta") $+      "e" <~ Core.typeLambdaBody (var "ta") $+      "t1" <<~ ref typeOfInternalDef @@ var "cx" @@ (Sets.insert (var "v") (var "vars")) @@ var "types" @@ list [] @@ var "e" $+      exec (ref checkTypeVariablesDef @@ var "cx" @@ (Sets.insert (var "v") (var "vars")) @@ var "t1") $+      Flows.pure $ Core.typeForall $ Core.forallType (var "v") (var "t1"),++    _Term_typeApplication>>: "tyapp" ~>+      "e" <~ Core.typedTermTerm (var "tyapp") $+      "t" <~ Core.typedTermType (var "tyapp") $+      ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ Lists.cons (var "t") (var "apptypes") @@ var "e",++    _Term_union>>: "injection" ~>+      "tname" <~ Core.injectionTypeName (var "injection") $++      -- Note: the following are only for sanity checking, and are not used in the typeOf result.+      "field" <~ Core.injectionField (var "injection") $+      "fname" <~ Core.fieldName (var "field") $+      "fterm" <~ Core.fieldTerm (var "field") $+      "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+      "svars" <~ Core.typeSchemeVariables (var "schemaType") $+      "stype" <~ Core.typeSchemeType (var "schemaType") $+      "sfields" <<~ ref ExtractCore.unionTypeDef @@ var "tname" @@ var "stype" $+      "ftyp" <<~ ref Schemas.findFieldTypeDef @@ var "fname" @@ var "sfields" $++      Flows.pure $ ref nominalApplicationDef @@ var "tname"  @@ var "apptypes",++    _Term_unit>>: constant $ var "checkApplied" @@ (Flows.pure Core.typeUnit),++    _Term_variable>>: "name" ~> var "checkApplied" @@ (Optionals.maybe+      (Flows.fail $ Strings.cat $ list [+        string "unbound variable: ",+        Core.unName $ var "name"])+      (unaryFunction Flows.pure)+      (Maps.lookup (var "name") (var "types"))),++    _Term_wrap>>: "wt" ~>+      "tname" <~ Core.wrappedTermTypeName (var "wt") $+      "innerTerm" <~ Core.wrappedTermObject (var "wt") $+      "innerType" <<~ ref typeOfInternalDef @@ var "cx" @@ var "vars" @@ var "types" @@ list [] @@ var "innerTerm" $+      exec (ref checkTypeVariablesDef @@ var "cx" @@ var "vars" @@ var "innerType") $+      ref typeOfNominalDef @@ string "wrapper typeOf" @@ var "cx" @@ var "tname" @@+        (Core.typeWrap $ Core.wrappedType (var "tname") (var "innerType"))]++typeOfNominalDef :: TBinding (String -> InferenceContext -> Name -> Type -> Flow s Type)+typeOfNominalDef = define "typeOfNominal" $+  doc "Infer the type of a nominal type" $+  "desc" ~> "cx" ~> "tname" ~> "expected" ~>+  "resolveType" <~ ("subst" ~> "v" ~>+    Optionals.fromMaybe (Core.typeVariable $ var "v") (Maps.lookup (var "v") (var "subst"))) $+  "schemaType" <<~ ref requireSchemaTypeDef @@ var "cx" @@ var "tname" $+  "svars" <~ Core.typeSchemeVariables (var "schemaType") $+  "stype" <~ Core.typeSchemeType (var "schemaType") $+  "substWrapper" <<~ ref Unification.unifyTypesDef @@+    (Typing.inferenceContextSchemaTypes $ var "cx") @@+    var "stype" @@+    var "expected" @@+    var "desc" $+  "subst" <~ Typing.unTypeSubst (var "substWrapper") $+  "tparams" <~ Lists.map (var "resolveType" @@ var "subst") (var "svars") $+  Flows.pure $ ref nominalApplicationDef @@ var "tname" @@ var "tparams"++typeOfUnitDef :: TBinding InferenceResult+typeOfUnitDef = define "inferTypeOfUnit" $+  doc "The trivial inference result for the unit term" $+  Typing.inferenceResult+    (Core.termUnit)+    (Core.typeUnit)+    (ref Substitution.idTypeSubstDef)++yieldDef :: TBinding (Term -> Type -> TypeSubst -> InferenceResult)+yieldDef = define "yield" $+  doc "Create an inference result" $+  "term" ~> "typ" ~> "subst" ~>+  Typing.inferenceResult+    (ref Substitution.substTypesInTermDef @@ var "subst" @@ var "term")+    (ref Substitution.substInTypeDef @@ var "subst" @@ var "typ")+    (var "subst")++yieldCheckedDef :: TBinding (InferenceContext -> [Name] -> Term -> Type -> TypeSubst -> Flow s InferenceResult)+yieldCheckedDef = define "yieldChecked" $+  doc "Create a checked inference result" $+  "cx" ~> "vars" ~> "term" ~> "typ" ~> "subst" ~>+  "iterm" <~ ref Substitution.substTypesInTermDef @@ var "subst" @@ var "term" $+  "itype" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "typ" $+  produce $ Typing.inferenceResult (var "iterm") (var "itype") (var "subst")++yieldDebugDef :: TBinding (InferenceContext -> String -> Term -> Type -> TypeSubst -> Flow s InferenceResult)+yieldDebugDef = define "yieldDebug" $+  doc "Create an inference result with debug output" $+  "cx" ~> "debugId" ~> "term" ~> "typ" ~> "subst" ~>+  "rterm" <~ ref Substitution.substTypesInTermDef @@ var "subst" @@ var "term" $+  "rtyp" <~ ref Substitution.substInTypeDef @@ var "subst" @@ var "typ" $+  "result" <<~ ref Annotations.debugIfDef @@ var "debugId" @@+    (Strings.cat $ list [+      string "\n\tterm: ",  ref ShowCore.termDef @@ var "term",+      string "\n\ttyp: ",   ref ShowCore.typeDef @@ var "typ",+      string "\n\tsubst: ", ref ShowTyping.typeSubstDef @@ var "subst",+      string "\n\trterm: ", ref ShowCore.termDef @@ var "rterm",+      string "\n\trtyp: ",  ref ShowCore.typeDef @@ var "rtyp"]) $+  produce $ Typing.inferenceResult (var "rterm") (var "rtyp") (var "subst")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Languages.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Languages where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.languages")+  [el hydraLanguageDef]+  [Variants.module_]+  kernelTypesModules $+  Just "Language constraints for Hydra Core"++hydraLanguageDef :: TBinding Language+hydraLanguageDef = definitionInModule module_ "hydraLanguage" $+  doc "Language constraints for Hydra Core, i.e. no constraints." $ lets [+  "eliminationVariants">: Sets.fromList $ ref Variants.eliminationVariantsDef,+  "literalVariants">: Sets.fromList $ ref Variants.literalVariantsDef,+  "floatTypes">: Sets.fromList $ ref Variants.floatTypesDef,+  "functionVariants">: Sets.fromList $ ref Variants.functionVariantsDef,+  "integerTypes">: Sets.fromList $ ref Variants.integerTypesDef,+  "termVariants">: Sets.fromList $ ref Variants.termVariantsDef,+  "typeVariants">: Sets.fromList $ ref Variants.typeVariantsDef,+  "types">: "t" ~> cases _Type (var "t") (Just true) []] $+  Coders.language+    (Coders.languageName "hydra.core")+    (Coders.languageConstraints+      (var "eliminationVariants")+      (var "literalVariants")+      (var "floatTypes")+      (var "functionVariants")+      (var "integerTypes")+      (var "termVariants")+      (var "typeVariants")+      (var "types"))
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Lexical.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Lexical where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+++module_ :: Module+module_ = Module (Namespace "hydra.lexical") elements+   [Monads.module_, Rewriting.module_, ShowCore.module_]+    kernelTypesModules $+    Just ("A module for lexical operations over graphs.")+  where+    elements = [+      el dereferenceElementDef,+      el elementsToGraphDef,+      el emptyGraphDef,+      el extendGraphWithBindingsDef,+      el fieldsOfDef,+      el getFieldDef,+      el lookupElementDef,+      el lookupPrimitiveDef,+      el matchEnumDef,+      el matchRecordDef,+      el matchUnionDef,+      el matchUnitFieldDef,+      el requireElementDef,+      el requirePrimitiveDef,+      el requireTermDef,+      el resolveTermDef,+      el schemaContextDef,+      el stripAndDereferenceTermDef,+      el typeOfPrimitiveDef,+      el withEmptyGraphDef,+      el withSchemaContextDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++dereferenceElementDef :: TBinding (Name -> Flow Graph (Maybe Binding))+dereferenceElementDef = define "dereferenceElement" $+  lambda "name" $ Flows.map+    (lambda "g" $ ref lookupElementDef @@ var "g" @@ var "name")+    (ref Monads.getStateDef)++elementsToGraphDef :: TBinding (Graph -> Maybe Graph -> [Binding] -> Graph)+elementsToGraphDef = define "elementsToGraph" $+  lambda "parent" $ lambda "schema" $ lambda "elements" $ lets [+    "toPair" >: lambda "el" $ pair (Core.bindingName $ var "el") (var "el")]+    $ Graph.graph+      (Maps.fromList (Lists.map (var "toPair") $ var "elements"))+      (Graph.graphEnvironment $ var "parent")+      (Graph.graphTypes $ var "parent")+      (Graph.graphBody $ var "parent")+      (Graph.graphPrimitives $ var "parent")+      (var "schema")++emptyGraphDef :: TBinding Graph+emptyGraphDef = define "emptyGraph" $+  doc "An empty graph; no elements, no primitives, no schema, and an arbitrary body." $+  Graph.graph+    Maps.empty+    Maps.empty+    Maps.empty+    (Core.termLiteral $ Core.literalString "empty graph")+    Maps.empty+    nothing++extendGraphWithBindingsDef :: TBinding ([Binding] -> Graph -> Graph)+extendGraphWithBindingsDef = define "extendGraphWithBindings" $+  lambdas ["bindings", "g"] $ lets [+    "newEls">: Maps.fromList $ Lists.map (var "toEl") (var "bindings"),+    "toEl">: lambda "binding" $ lets [+      "name">: Core.bindingName $ var "binding",+      "term">: Core.bindingTerm $ var "binding",+      "mts">: Core.bindingType $ var "binding"]+      $ pair (var "name") (Core.binding (var "name") (var "term") (var "mts"))]+    $ Graph.graphWithElements (var "g") (Maps.union (var "newEls") (Graph.graphElements $ var "g"))++fieldsOfDef :: TBinding (Type -> [FieldType])+fieldsOfDef = define "fieldsOf" $+  lambda "t" $ lets [+    "stripped">: ref Rewriting.deannotateTypeDef @@ var "t"]+    $ cases _Type (var "stripped") (Just $ list []) [+      _Type_forall>>: lambda "forallType" $ ref fieldsOfDef @@ (Core.forallTypeBody $ var "forallType"),+      _Type_record>>: lambda "rt" $ Core.rowTypeFields $ var "rt",+      _Type_union>>: lambda "rt" $ Core.rowTypeFields $ var "rt"]++getFieldDef :: TBinding (M.Map Name Term -> Name -> (Term -> Flow Graph b) -> Flow Graph b)+getFieldDef = define "getField" $+  lambdas ["m", "fname", "decode"] $+    Optionals.maybe+      (Flows.fail $ "expected field " ++ (Core.unName $ var "fname") ++ " not found")+      (var "decode")+      (Maps.lookup (var "fname") (var "m"))++lookupElementDef :: TBinding (Graph -> Name -> Maybe Binding)+lookupElementDef = define "lookupElement" $+  lambdas ["g", "name"] $ Maps.lookup (var "name") (Graph.graphElements $ var "g")++lookupPrimitiveDef :: TBinding (Graph -> Name -> Maybe Primitive)+lookupPrimitiveDef = define "lookupPrimitive" $+  lambda "g" $ lambda "name" $+    Maps.lookup (var "name") (Graph.graphPrimitives $ var "g")++matchEnumDef :: TBinding (Name -> [(Name, b)] -> Term -> Flow Graph b)+matchEnumDef = define "matchEnum" $+  lambdas ["tname", "pairs"] $+    ref matchUnionDef @@ var "tname" @@ (Lists.map (lambda "pair" $+      ref matchUnitFieldDef @@ (first $ var "pair") @@ (second $ var "pair")) $ var "pairs")++matchRecordDef :: TBinding ((M.Map Name Term -> Flow Graph b) -> Term -> Flow Graph b)+matchRecordDef = define "matchRecord" $+  lambdas ["decode", "term"] $ lets [+    "stripped">: ref Rewriting.deannotateAndDetypeTermDef @@ var "term"]+    $ cases _Term (var "stripped")+        (Just $ ref Monads.unexpectedDef @@ string "record" @@ (ref ShowCore.termDef @@ var "term")) [+      _Term_record>>: lambda "record" $ var "decode" @@+        (Maps.fromList $ Lists.map+          (lambda "field" $ pair (Core.fieldName $ var "field") (Core.fieldTerm $ var "field"))+          (Core.recordFields $ var "record"))]++matchUnionDef :: TBinding (Name -> [(Name, Term -> Flow Graph b)] -> Term -> Flow Graph b)+matchUnionDef = define "matchUnion" $+  lambdas ["tname", "pairs", "term"] $ lets [+    "stripped">: ref Rewriting.deannotateAndDetypeTermDef @@ var "term",+    "mapping">: Maps.fromList $ var "pairs"] $+    cases _Term (var "stripped")+      (Just $ ref Monads.unexpectedDef @@+        ("union with one of {" ++ (Strings.intercalate ", " $ Lists.map (lambda "pair" $ Core.unName $ first $ var "pair") $ var "pairs") ++ "}") @@+        (ref ShowCore.termDef @@ var "stripped")) [+      _Term_variable>>: lambda "name" $+        Flows.bind (ref requireElementDef @@ var "name") $+        lambda "el" $ ref matchUnionDef @@ var "tname" @@ var "pairs" @@ (Core.bindingTerm $ var "el"),+      _Term_union>>: lambda "injection" $+        Logic.ifElse (Core.equalName_ (Core.injectionTypeName $ var "injection") (var "tname"))+          (lets [+            "fname">: Core.fieldName $ Core.injectionField $ var "injection",+            "val">: Core.fieldTerm $ Core.injectionField $ var "injection"] $+            Optionals.maybe+              (Flows.fail $ "no matching case for field " ++ (Core.unName $ var "fname")+                ++ " in union type " ++ (Core.unName $ var "tname"))+              (lambda "f" $ var "f" @@ var "val")+              (Maps.lookup (var "fname") (var "mapping")))+          (ref Monads.unexpectedDef @@ ("injection for type " ++ (Core.unName $ var "tname")) @@ (ref ShowCore.termDef @@ var "term"))]++matchUnitFieldDef :: TBinding (Name -> y -> (Name, x -> Flow Graph y))+matchUnitFieldDef = define "matchUnitField" $+  lambdas ["fname", "x"] $ pair (var "fname") (lambda "ignored" $ Flows.pure $ var "x")++requireElementDef :: TBinding (Name -> Flow Graph Binding)+requireElementDef = define "requireElement" $+  lambda "name" $ lets [+    "showAll">: false,+    "ellipsis">: lambda "strings" $+      Logic.ifElse (Logic.and (Equality.gt (Lists.length $ var "strings") (int32 3)) (Logic.not $ var "showAll"))+        (Lists.concat2 (Lists.take (int32 3) (var "strings")) (list [string "..."]))+        (var "strings"),+    "err">: lambda "g" $ Flows.fail $+      "no such element: " ++ (Core.unName $ var "name") +++      ". Available elements: {" +++      (Strings.intercalate ", " $ var "ellipsis" @@ (Lists.map (lambda "el" $ Core.unName $ Core.bindingName $ var "el") $ Maps.elems $ Graph.graphElements $ var "g")) +++      "}"]+    $ Flows.bind (ref dereferenceElementDef @@ var "name") $+      lambda "mel" $ Optionals.maybe+        (Flows.bind (ref Monads.getStateDef) $ var "err")+        (unaryFunction Flows.pure)+        (var "mel")++requirePrimitiveDef :: TBinding (Name -> Flow Graph Primitive)+requirePrimitiveDef = define "requirePrimitive" $+  lambda "name" $+    Flows.bind (ref Monads.getStateDef) $+    lambda "g" $ Optionals.maybe+      (Flows.fail $ "no such primitive function: " ++ (Core.unName $ var "name"))+      (unaryFunction Flows.pure)+      (ref lookupPrimitiveDef @@ var "g" @@ var "name")++requireTermDef :: TBinding (Name -> Flow Graph Term)+requireTermDef = define "requireTerm" $+  lambda "name" $+    Flows.bind (ref resolveTermDef @@ var "name") $+    lambda "mt" $ Optionals.maybe+      (Flows.fail $ "no such element: " ++ (Core.unName $ var "name"))+      (unaryFunction Flows.pure)+      (var "mt")++resolveTermDef :: TBinding (Name -> Flow Graph (Maybe Term))+resolveTermDef = define "resolveTerm" $+  doc "TODO: distinguish between lambda-bound and let-bound variables" $+  lambda "name" $ lets [+    "recurse">: lambda "el" $ lets [+      "stripped">: ref Rewriting.deannotateTermDef @@ (Core.bindingTerm $ var "el")]+      $ cases _Term (var "stripped") (Just $ Flows.pure $ just $ Core.bindingTerm $ var "el") [+        _Term_variable>>: lambda "name'" $ ref resolveTermDef @@ var "name'"]]+    $ Flows.bind (ref Monads.getStateDef) $+      lambda "g" $ Optionals.maybe+        (Flows.pure nothing)+        (var "recurse")+        (Maps.lookup (var "name") (Graph.graphElements $ var "g"))++schemaContextDef :: TBinding (Graph -> Graph)+schemaContextDef = define "schemaContext" $+  doc "Note: assuming for now that primitive functions are the same in the schema graph" $+  lambda "g" $ Optionals.fromMaybe (var "g") (Graph.graphSchema $ var "g")++stripAndDereferenceTermDef :: TBinding (Term -> Flow Graph Term)+stripAndDereferenceTermDef = define "stripAndDereferenceTerm" $+  lambda "term" $ lets [+    "stripped">: ref Rewriting.deannotateAndDetypeTermDef @@ var "term"]+    $ cases _Term (var "stripped") (Just $ Flows.pure $ var "stripped") [+      _Term_variable>>: lambda "v" $+        Flows.bind (ref requireTermDef @@ var "v") $+        lambda "t" $ ref stripAndDereferenceTermDef @@ var "t"]++typeOfPrimitiveDef :: TBinding (Name -> Flow Graph TypeScheme)+typeOfPrimitiveDef = define "typeOfPrimitive" $+  lambda "name" $ Flows.map (unaryFunction Graph.primitiveType) $ ref requirePrimitiveDef @@ var "name"++-- TODO: move into hydra.lexical+withEmptyGraphDef :: TBinding (Flow Graph a -> Flow s a)+withEmptyGraphDef = define "withEmptyGraph" $+  doc "Execute flow with empty graph" $+  ref Monads.withStateDef @@ ref emptyGraphDef++withSchemaContextDef :: TBinding (Flow Graph x -> Flow Graph x)+withSchemaContextDef = define "withSchemaContext" $+  lambda "f" $+    Flows.bind (ref Monads.getStateDef) $+    lambda "g" $ ref Monads.withStateDef @@ (ref schemaContextDef @@ var "g") @@ var "f"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Literals.hs view
@@ -0,0 +1,104 @@+module Hydra.Sources.Kernel.Terms.Literals where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.literals") elements+    []+    kernelTypesModules $+    Just "Conversion functions for literal values."+  where+   elements = [+     el bigfloatToFloatValueDef,+     el bigintToIntegerValueDef,+     el floatValueToBigfloatDef,+     el integerValueToBigintDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++bigfloatToFloatValueDef :: TBinding (FloatType -> Bigfloat -> FloatValue)+bigfloatToFloatValueDef = define "bigfloatToFloatValue" $+  doc "Convert a bigfloat to a floating-point value of a given type (note: lossy)" $+  "ft" ~> "bf" ~> cases _FloatType (var "ft")+    Nothing [+    _FloatType_bigfloat>>: constant $ Core.floatValueBigfloat $ var "bf",+    _FloatType_float32>>: constant $ Core.floatValueFloat32 $ Literals.bigfloatToFloat32 $ var "bf",+    _FloatType_float64>>: constant $ Core.floatValueFloat64 $ Literals.bigfloatToFloat64 $ var "bf"]++bigintToIntegerValueDef :: TBinding (IntegerType -> Integer -> IntegerValue)+bigintToIntegerValueDef = define "bigintToIntegerValue" $+  doc "Convert a bigint to an integer value of a given type (note: lossy)" $+  "it" ~> "bi" ~> cases _IntegerType (var "it")+    Nothing [+    _IntegerType_bigint>>: constant $ Core.integerValueBigint $ var "bi",+    _IntegerType_int8>>: constant $ Core.integerValueInt8 $ Literals.bigintToInt8 $ var "bi",+    _IntegerType_int16>>: constant $ Core.integerValueInt16 $ Literals.bigintToInt16 $ var "bi",+    _IntegerType_int32>>: constant $ Core.integerValueInt32 $ Literals.bigintToInt32 $ var "bi",+    _IntegerType_int64>>: constant $ Core.integerValueInt64 $ Literals.bigintToInt64 $ var "bi",+    _IntegerType_uint8>>: constant $ Core.integerValueUint8 $ Literals.bigintToUint8 $ var "bi",+    _IntegerType_uint16>>: constant $ Core.integerValueUint16 $ Literals.bigintToUint16 $ var "bi",+    _IntegerType_uint32>>: constant $ Core.integerValueUint32 $ Literals.bigintToUint32 $ var "bi",+    _IntegerType_uint64>>: constant $ Core.integerValueUint64 $ Literals.bigintToUint64 $ var "bi"]++floatValueToBigfloatDef :: TBinding (FloatValue -> Bigfloat)+floatValueToBigfloatDef = define "floatValueToBigfloat" $+  doc "Convert a floating-point value of any precision to a bigfloat" $+  match _FloatValue+    Nothing [+    _FloatValue_bigfloat>>: "bf" ~> var "bf",+    _FloatValue_float32>>: "f32" ~> Literals.float32ToBigfloat $ var "f32",+    _FloatValue_float64>>: "f64" ~> Literals.float64ToBigfloat $ var "f64"]++integerValueToBigintDef :: TBinding (IntegerValue -> Integer)+integerValueToBigintDef = define "integerValueToBigint" $+  doc "Convert an integer value of any precision to a bigint" $+  match _IntegerValue+    Nothing [+    _IntegerValue_bigint>>: "bi" ~> var "bi",+    _IntegerValue_int8>>: "i8" ~> Literals.int8ToBigint $ var "i8",+    _IntegerValue_int16>>: "i16" ~> Literals.int16ToBigint $ var "i16",+    _IntegerValue_int32>>: "i32" ~> Literals.int32ToBigint $ var "i32",+    _IntegerValue_int64>>: "i64" ~> Literals.int64ToBigint $ var "i64",+    _IntegerValue_uint8>>: "ui8" ~> Literals.uint8ToBigint $ var "ui8",+    _IntegerValue_uint16>>: "ui16" ~> Literals.uint16ToBigint $ var "ui16",+    _IntegerValue_uint32>>: "ui32" ~> Literals.uint32ToBigint $ var "ui32",+    _IntegerValue_uint64>>: "ui64" ~> Literals.uint64ToBigint $ var "ui64"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Monads.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Monads where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Constants as Constants+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants++import Hydra.Mantle+++module_ :: Module+module_ = Module (Namespace "hydra.monads") elements+    [Constants.module_, ShowCore.module_]+    kernelTypesModules $+    Just ("Functions for working with Hydra's 'flow' and other monads.")+  where+    elements = [+      el bindDef,+      el emptyTraceDef,+      el execDef,+      el failDef,+      el flowSucceedsDef,+      el fromFlowDef,+      el getStateDef,+      el mapDef,+      el modifyDef,+      el mutateTraceDef,+      el optionalToListDef,+      el pureDef,+      el pushErrorDef,+      el putStateDef,+      el traceSummaryDef,+      el unexpectedDef,+      el warnDef,+      el withFlagDef,+      el withStateDef,+      el withTraceDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++bindDef :: TBinding (Flow s a -> (a -> Flow s b) -> Flow s b)+bindDef = define "bind" $ lambdas ["l", "r"] $ lets [+  "q">: lambdas ["s0", "t0"] $ lets [+    "fs1">: Compute.unFlow (var "l") (var "s0") (var "t0")] $+    Optionals.maybe+      (Compute.flowState+        nothing+        (Compute.flowStateState $ var "fs1")+        (Compute.flowStateTrace $ var "fs1"))+      (lambda "v" $ Compute.unFlow+        (var "r" @@ var "v")+        (Compute.flowStateState $ var "fs1")+        (Compute.flowStateTrace $ var "fs1"))+      (Compute.flowStateValue $ var "fs1")] $+  Compute.flow $ var "q"++emptyTraceDef :: TBinding Trace+emptyTraceDef = define "emptyTrace" $ Compute.trace (list []) (list []) Maps.empty++execDef :: TBinding (Flow s a -> s -> s)+execDef = define "exec" $+  lambdas ["f", "s0"] $+    Compute.flowStateState $ Compute.unFlow (var "f") (var "s0") (ref emptyTraceDef)++failDef :: TBinding (String -> Flow s a)+failDef = define "fail" $+  lambda "msg" $+    Compute.flow $ lambdas ["s", "t"] $+      Compute.flowState nothing (var "s") (ref pushErrorDef @@ var "msg" @@ var "t")++flowSucceedsDef :: TBinding (Flow s a -> Bool)+flowSucceedsDef = define "flowSucceeds" $+  doc "Check whether a flow succeeds" $+  lambdas ["s", "f"] $+    Optionals.isJust (Compute.flowStateValue $ (Compute.unFlow (var "f") (var "s") (ref emptyTraceDef)))++fromFlowDef :: TBinding (a -> s -> Flow s a -> a)+fromFlowDef = define "fromFlow" $+  doc "Get the value of a flow, or a default value if the flow fails" $+  lambdas ["def", "cx", "f"] $ Optionals.maybe+    (var "def")+    (lambda "xmo" $ var "xmo")+    (Compute.flowStateValue $ (Compute.unFlow (var "f") (var "cx") (ref emptyTraceDef)))++getStateDef :: TBinding (Flow s s)+getStateDef = define "getState" $+  doc "Get the state of the current flow" $+  Compute.flow $ lambdas ["s0", "t0"] $ lets [+    "fs1">: Compute.unFlow (ref pureDef @@ unit) (var "s0") (var "t0"),+    "v">: Compute.flowStateValue (var "fs1"),+    "s">: Compute.flowStateState (var "fs1"),+    "t">: Compute.flowStateTrace (var "fs1")] $+    Optionals.maybe+      (Compute.flowState nothing (var "s") (var "t"))+      (constant (Compute.flowState (just $ var "s") (var "s") (var "t")))+      (var "v")++mapDef :: TBinding ((a -> b) -> Flow s a -> Flow s b)+mapDef = define "map" $+  doc "Map a function over a flow" $+  lambdas ["f", "f1"] $+    Compute.flow $ lambdas ["s0", "t0"] $ lets [+      "f2">: Compute.unFlow (var "f1") (var "s0") (var "t0")] $+      Compute.flowState+        (Optionals.map (var "f") $ Compute.flowStateValue $ var "f2")+        (Compute.flowStateState $ var "f2")+        (Compute.flowStateTrace $ var "f2")++modifyDef :: TBinding ((s -> s) -> Flow s ())+modifyDef = define "modify" $ lambda "f" $+  ref bindDef+    @@ (ref getStateDef)+    @@ (lambda "s" $ ref putStateDef @@ (var "f" @@ var "s"))++mutateTraceDef :: TBinding ((Trace -> Hydra.Mantle.Either String Trace) -> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a)+mutateTraceDef = define "mutateTrace" $+  lambdas ["mutate", "restore", "f"] $+    Compute.flow $ lambdas ["s0", "t0"] $ lets [+      "forLeft">: lambda "msg" $+        Compute.flowState nothing (var "s0") (ref pushErrorDef @@ var "msg" @@ var "t0"),+      -- Retain the updated state, but reset the trace after execution+      "forRight">: lambda "t1" $ lets [+        -- Execute the internal flow after augmenting the trace+        "f2">: Compute.unFlow (var "f") (var "s0") (var "t1")] $+        Compute.flowState+          (Compute.flowStateValue $ var "f2")+          (Compute.flowStateState $ var "f2")+          (var "restore" @@ var "t0" @@ (Compute.flowStateTrace $ var "f2"))] $+      cases _Either (var "mutate" @@ var "t0") Nothing [+        _Either_left>>: var "forLeft",+        _Either_right>>: var "forRight"]++optionalToListDef :: TBinding (Maybe a -> [a])+optionalToListDef = define "optionalToList" $+  doc "Converts an optional value either to an empty list (if nothing) or a singleton list (if just)." $+  lambda "mx" $ Optionals.maybe (list []) (unaryFunction Lists.pure) (var "mx")++pureDef :: TBinding (a -> Flow s a)+pureDef = define "pure" $ lambda "xp" $+  Compute.flow $ lambdas ["s", "t"] $ Compute.flowState (just $ var "xp") (var "s") (var "t")++pushErrorDef :: TBinding (String -> Trace -> Trace)+pushErrorDef = define "pushError" $+  doc "Push an error message" $+  lambdas ["msg", "t"] $ lets [+    "condenseRepeats">: lets [+      "condenseGroup">: lambda "xs" $  lets [+        "x">: Lists.head $ var "xs",+        "n">: Lists.length $ var "xs"] $+        Logic.ifElse (Equality.equal (var "n") (int32 1))+          (var "x")+          (Strings.cat $ list [var "x", " (x", Literals.showInt32 (var "n"), ")"])] $+      lambda "ys" $ Lists.map (var "condenseGroup") $ Lists.group (var "ys" :: TTerm [String]),+    "errorMsg">: Strings.concat [+      "Error: ", var "msg", " (",+      (Strings.intercalate " > " (var "condenseRepeats" @@ (Lists.reverse $ Compute.traceStack $ var "t"))),+      ")"]] $+    Compute.trace+      (Compute.traceStack $ var "t")+      (Lists.cons (var "errorMsg") (Compute.traceMessages $ var "t"))+      (Compute.traceOther $ var "t")++putStateDef :: TBinding (s -> Flow s ())+putStateDef = define "putState" $+  doc "Set the state of a flow" $+  lambda "cx" $ Compute.flow $ lambdas ["s0", "t0"] $ lets [+    "f1">: Compute.unFlow (ref pureDef @@ unit) (var "s0") (var "t0")] $+    Compute.flowState+      (Compute.flowStateValue $ var "f1")+      (var "cx")+      (Compute.flowStateTrace $ var "f1")++traceSummaryDef :: TBinding (Trace -> String)+traceSummaryDef = define "traceSummary" $+  doc "Summarize a trace as a string" $+  lambda "t" $ lets [+    "messageLines">: (Lists.nub (Compute.traceMessages $ var "t")),+    "keyvalLines">: Logic.ifElse (Maps.null (Compute.traceOther $ var "t"))+      (list [])+      (Lists.cons ("key/value pairs: ")+        (Lists.map (var "toLine") (Maps.toList (Compute.traceOther $ var "t")))),+    "toLine">:+      lambda "pair" $ "\t" ++ (Core.unName $ (first $ var "pair")) ++ ": " ++ (ref ShowCore.termDef @@ (second $ var "pair"))] $+    Strings.intercalate "\n" (Lists.concat2 (var "messageLines") (var "keyvalLines"))++unexpectedDef :: TBinding (String -> String -> Flow s x)+unexpectedDef = define "unexpected" $+  doc "Fail if an actual value does not match an expected value" $+  lambdas ["expected", "actual"] $ ref failDef @@ ("expected " ++ var "expected" ++ " but found: " ++ var "actual")++warnDef :: TBinding (String -> Flow s a -> Flow s a)+warnDef = define "warn" $+  doc "Continue the current flow after adding a warning message" $+  lambdas ["msg", "b"] $ Compute.flow $ lambdas ["s0", "t0"] $ lets [+    "f1">: Compute.unFlow (var "b") (var "s0") (var "t0"),+    "addMessage">: lambda "t" $ Compute.trace+      (Compute.traceStack $ var "t")+      (Lists.cons ("Warning: " ++ var "msg") (Compute.traceMessages $ var "t"))+      (Compute.traceOther $ var "t")] $+    Compute.flowState+      (Compute.flowStateValue $ var "f1")+      (Compute.flowStateState $ var "f1")+      (var "addMessage" @@ (Compute.flowStateTrace $ var "f1"))++withFlagDef :: TBinding (String -> Flow s a -> Flow s a)+withFlagDef = define "withFlag" $+  doc "Continue the current flow after setting a flag" $+  lambda "flag" $ lets [+    "mutate">: lambda "t" $ Mantle.eitherRight $ (Compute.trace+      (Compute.traceStack $ var "t")+      (Compute.traceMessages $ var "t")+      (Maps.insert (var "flag") (Core.termLiteral $ Core.literalBoolean $ boolean True) (Compute.traceOther $ var "t"))),+    "restore">: lambda "ignored" $ lambda "t1" $ Compute.trace+      (Compute.traceStack $ var "t1")+      (Compute.traceMessages $ var "t1")+      (Maps.remove (var "flag") (Compute.traceOther $ var "t1"))] $+    ref mutateTraceDef @@ var "mutate" @@ var "restore"++withStateDef :: TBinding (s1 -> Flow s1 a -> Flow s2 a)+withStateDef = define "withState" $+  doc "Continue a flow using a given state" $+  lambdas ["cx0", "f"] $+    Compute.flow $ lambdas ["cx1", "t1"] $ lets [+      "f1">: Compute.unFlow (var "f") (var "cx0") (var "t1")] $+      Compute.flowState+        (Compute.flowStateValue $ var "f1")+        (var "cx1")+        (Compute.flowStateTrace $ var "f1")++withTraceDef :: TBinding (String -> Flow s a -> Flow s a)+withTraceDef = define "withTrace" $+  doc "Continue the current flow after augmenting the trace" $+  lambda "msg" $ lets [+    -- augment the trace+    "mutate">: lambda "t" $ Logic.ifElse (Equality.gte (Lists.length (Compute.traceStack $ var "t")) $ ref Constants.maxTraceDepthDef)+      (Mantle.eitherLeft $ string "maximum trace depth exceeded. This may indicate an infinite loop")+      (Mantle.eitherRight $ Compute.trace+        (Lists.cons (var "msg") (Compute.traceStack $ var "t"))+        (Compute.traceMessages $ var "t")+        (Compute.traceOther $ var "t")),+    -- reset the trace stack after execution+    "restore">: lambda "t0" $ lambda "t1" $ Compute.trace+      (Compute.traceStack $ var "t0")+      (Compute.traceMessages $ var "t1")+      (Compute.traceOther $ var "t1")] $+    ref mutateTraceDef @@ var "mutate" @@ var "restore"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Names.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Names where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Formatting as Formatting+++module_ :: Module+module_ = Module (Namespace "hydra.names") elements+    [Formatting.module_]+    kernelTypesModules $+    Just ("Functions for working with qualified names.")+  where+   elements = [+     el compactNameDef,+     el localNameOfDef,+     el namespaceOfDef,+     el namespaceToFilePathDef,+     el qnameDef,+     el qualifyNameDef,+     el uniqueLabelDef,+     el unqualifyNameDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++compactNameDef :: TBinding (M.Map Namespace String -> Name -> String)+compactNameDef = define "compactName" $+  doc "Given a mapping of namespaces to prefixes, convert a name to a compact string representation" $+  lambda "namespaces" $ lambda "name" $ lets [+    "qualName">: ref qualifyNameDef @@ var "name",+    "mns">: Module.qualifiedNameNamespace $ var "qualName",+    "local">: Module.qualifiedNameLocal $ var "qualName"]+    $ Optionals.maybe+        (Core.unName $ var "name")+        (lambda "ns" $+          Optionals.maybe (var "local")+            (lambda "pre" $ Strings.cat $ list [var "pre", string ":", var "local"])+            (Maps.lookup (var "ns") (var "namespaces")))+        (var "mns")++localNameOfDef :: TBinding (Name -> String)+localNameOfDef = define "localNameOf" $+  unaryFunction Module.qualifiedNameLocal <.> ref qualifyNameDef++namespaceOfDef :: TBinding (Name -> Maybe Namespace)+namespaceOfDef = define "namespaceOf" $+  unaryFunction Module.qualifiedNameNamespace <.> ref qualifyNameDef++namespaceToFilePathDef :: TBinding (CaseConvention -> FileExtension -> Namespace -> String)+namespaceToFilePathDef = define "namespaceToFilePath" $+  lambda "caseConv" $ lambda "ext" $ lambda "ns" $ lets [+    "parts">: Lists.map+      (ref Formatting.convertCaseDef @@ Mantle.caseConventionCamel @@ var "caseConv")+      (Strings.splitOn "." (Core.unNamespace $ var "ns"))]+    $ (Strings.intercalate "/" $ var "parts") ++ "." ++ (Module.unFileExtension $ var "ext")++qnameDef :: TBinding (Namespace -> String -> Name)+qnameDef = define "qname" $+  doc "Construct a qualified (dot-separated) name" $+  lambda "ns" $ lambda "name" $+    wrap _Name $+      Strings.cat $+        list [apply (unwrap _Namespace) (var "ns"), string ".", var "name"]++qualifyNameDef :: TBinding (Name -> QualifiedName)+qualifyNameDef = define "qualifyName" $+  lambda "name" $ lets [+    "parts">: Lists.reverse (Strings.splitOn "." (Core.unName $ var "name"))]+    $ Logic.ifElse+      (Equality.equal (int32 1) (Lists.length $ var "parts"))+      (Module.qualifiedName nothing (Core.unName $ var "name"))+      (Module.qualifiedName+        (just $ wrap _Namespace (Strings.intercalate "." (Lists.reverse (Lists.tail $ var "parts"))))+        (Lists.head $ var "parts"))++uniqueLabelDef :: TBinding (S.Set String -> String -> String)+uniqueLabelDef = define "uniqueLabel" $+  doc "Generate a unique label by appending a suffix if the label is already in use" $+  lambda "visited" $ lambda "l" $+  Logic.ifElse (Sets.member (var "l") (var "visited"))+    (ref uniqueLabelDef @@ var "visited" @@ Strings.cat2 (var "l") (string "'"))+    (var "l")++unqualifyNameDef :: TBinding (QualifiedName -> Name)+unqualifyNameDef = define "unqualifyName" $+  doc "Convert a qualified name to a dot-separated name" $+  lambda "qname" $ lets [+    "prefix">: Optionals.maybe+      (string "")+      (lambda "n" $ (unwrap _Namespace @@ var "n") ++ string ".")+      (project _QualifiedName _QualifiedName_namespace @@ var "qname")]+    $ wrap _Name $ var "prefix" ++ (project _QualifiedName _QualifiedName_local @@ var "qname")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Reduction.hs view
@@ -0,0 +1,411 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Reduction where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Arity as Arity+import qualified Hydra.Sources.Kernel.Terms.Extract.Core as ExtractCore+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Schemas as Schemas+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+++module_ :: Module+module_ = Module (Namespace "hydra.reduction") elements+    [Arity.module_, ExtractCore.module_, Lexical.module_, Rewriting.module_,+      Schemas.module_]+    kernelTypesModules $+    Just ("Functions for reducing terms and types, i.e. performing computations.")+  where+   elements = [+     el alphaConvertDef,+     el betaReduceTypeDef,+     el contractTermDef,+     el countPrimitiveInvocationsDef,+     el etaReduceTermDef,+     el expandLambdasDef,+     el expansionArityDef,+     el reduceTermDef,+     el termIsClosedDef,+     el termIsValueDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++alphaConvertDef :: TBinding (Name -> Name -> Term -> Term)+alphaConvertDef = define "alphaConvert" $+  doc "Alpha convert a variable in a term" $+  "vold" ~> "vnew" ~> "term" ~> ref Rewriting.replaceFreeTermVariableDef @@ var "vold" @@ (Core.termVariable $ var "vnew") @@ var "term"++-- Note: this is eager beta reduction, in that we always descend into subtypes,+--       and always reduce the right-hand side of an application prior to substitution+betaReduceTypeDef :: TBinding (Type -> Flow Graph Type)+betaReduceTypeDef = define "betaReduceType" $+  lambda "typ" $ lets [+    "mapExpr">: lambdas ["recurse", "t"] $+      Flows.bind (var "recurse" @@ var "t") $+        lambda "r" $+          match _Type (Just $ Flows.pure $ var "r") [+            _Type_application>>: lambda "a" $ var "reduceApp" @@ var "a"] @@ var "r",+    "reduceApp">: lambda "app" $ lets [+      "lhs">: Core.applicationTypeFunction $ var "app",+      "rhs">: Core.applicationTypeArgument $ var "app"]+      $ match _Type Nothing [+        _Type_annotated>>: lambda "at" $+          Flows.bind (var "reduceApp" @@ (Core.applicationType+            (Core.annotatedTypeSubject $ var "at")+            (var "rhs"))) $+            lambda "a" $ Flows.pure $ Core.typeAnnotated $ Core.annotatedType (var "a") (Core.annotatedTypeAnnotation $ var "at"),+        _Type_forall>>: lambda "ft" $+          ref betaReduceTypeDef @@ (ref Rewriting.replaceFreeTypeVariableDef+            @@ (Core.forallTypeParameter $ var "ft")+            @@ var "rhs"+            @@ (Core.forallTypeBody $ var "ft")),+        _Type_variable>>: lambda "name" $+          Flows.bind (ref Schemas.requireTypeDef @@ var "name") $+            lambda "t'" $ ref betaReduceTypeDef @@ (Core.typeApplication $ Core.applicationType (var "t'") (var "rhs"))] @@ var "lhs"]+    $ ref Rewriting.rewriteTypeMDef @@ var "mapExpr" @@ var "typ"++contractTermDef :: TBinding (Term -> Term)+contractTermDef = define "contractTerm" $+  doc ("Apply the special rules:\n"+    <> "    ((\\x.e1) e2) == e1, where x does not appear free in e1\n"+    <> "  and\n"+    <> "     ((\\x.e1) e2) = e1[x/e2]\n"+    <> "These are both limited forms of beta reduction which help to \"clean up\" a term without fully evaluating it.") $+  "term" ~> lets [+    "rewrite">: "recurse" ~> "t" ~> lets [+      "rec">: var "recurse" @@ var "t"] $+      cases _Term (var "rec")+        (Just $ var "rec") [+        _Term_application>>: "app" ~> lets [+          "lhs">: Core.applicationFunction $ var "app",+          "rhs">: Core.applicationArgument $ var "app"] $+          cases _Term (ref Rewriting.deannotateTermDef @@ var "lhs")+            (Just $ var "rec") [+            _Term_function>>: "f" ~> cases _Function (var "f")+              (Just $ var "rec") [+              _Function_lambda>>: "l" ~> lets [+                "v">: Core.lambdaParameter $ var "l",+                "body">: Core.lambdaBody $ var "l"] $+                Logic.ifElse (ref Rewriting.isFreeVariableInTermDef @@ var "v" @@ var "body")+                  (var "body")+                  (ref Rewriting.replaceFreeTermVariableDef @@ var "v" @@ var "rhs" @@ var "body")]]]] $+    ref Rewriting.rewriteTermDef @@ var "rewrite" @@ var "term"++-- For demo purposes. This should be generalized to enable additional side effects of interest.+countPrimitiveInvocationsDef :: TBinding Bool+countPrimitiveInvocationsDef = define "countPrimitiveInvocations" true++-- Note: unused / untested+etaReduceTermDef :: TBinding (Term -> Term)+etaReduceTermDef = define "etaReduceTerm" $+  lambda "term" $ lets [+    "noChange">: var "term",+    "reduceLambda">: lambda "l" $ lets [+      "v">: Core.lambdaParameter $ var "l",+      "d">: Core.lambdaDomain $ var "l",+      "body">: Core.lambdaBody $ var "l"]+      $ match _Term (Just $ var "noChange") [+        _Term_annotated>>: lambda "at" $+          var "reduceLambda" @@ (Core.lambda (var "v") (var "d") (Core.annotatedTermSubject $ var "at")),+        _Term_application>>: lambda "app" $ lets [+          "lhs">: Core.applicationFunction $ var "app",+          "rhs">: Core.applicationArgument $ var "app"]+          $ match _Term (Just $ var "noChange") [+            _Term_annotated>>: lambda "at" $+              var "reduceLambda" @@ (Core.lambda (var "v") (var "d") $+                Core.termApplication $ Core.application (var "lhs") (Core.annotatedTermSubject $ var "at")),+            _Term_variable>>: lambda "v1" $+              Logic.ifElse+                (Logic.and+                  (Equality.equal (Core.unName $ var "v") (Core.unName $ var "v1"))+                  (Logic.not $ ref Rewriting.isFreeVariableInTermDef @@ var "v" @@ var "lhs"))+                (ref etaReduceTermDef @@ var "lhs")+                (var "noChange")]+          @@ (ref etaReduceTermDef @@ var "rhs")]+      @@ (ref etaReduceTermDef @@ var "body")]+    $ match _Term (Just $ var "noChange") [+      _Term_annotated>>: lambda "at" $+        Core.termAnnotated $ Core.annotatedTerm+          (ref etaReduceTermDef @@ (Core.annotatedTermSubject $ var "at"))+          (Core.annotatedTermAnnotation $ var "at"),+      _Term_function>>: lambda "f" $+        match _Function (Just $ var "noChange") [+          _Function_lambda>>: lambda "l" $ var "reduceLambda" @@ var "l"]+        @@ var "f"]+    @@ var "term"++expandLambdasDef :: TBinding (Graph -> Term -> Term)+expandLambdasDef = define "expandLambdas" $+  doc ("Recursively transform arbitrary terms like 'add 42' into terms like '\\x.add 42 x', in which the implicit"+    <> " parameters of primitive functions and eliminations are made into explicit lambda parameters."+    <> " Variable references are not expanded."+    <> " This is useful for targets like Python with weaker support for currying than Hydra or Haskell."+    <> " Note: this is a \"trusty\" function which assumes the graph is well-formed, i.e. no dangling references.") $+  "graph" ~> "term" ~> lets [+    "expand">: "args" ~> "arity" ~> "t" ~> lets [+      "apps">: Lists.foldl+        ("lhs" ~> "arg" ~> Core.termApplication $ Core.application (var "lhs") (var "arg"))+        (var "t")+        (var "args"),+      "is">: Logic.ifElse (Equality.lte (var "arity") (Lists.length $ var "args"))+        (list [])+        (Math.range (int32 1) (Math.sub (var "arity") (Lists.length $ var "args"))),+      "pad">: "indices" ~> "t" ~>+        Logic.ifElse (Lists.null $ var "indices")+          (var "t")+          (Core.termFunction $ Core.functionLambda $+            Core.lambda (Core.name $ Strings.cat2 (string "v") (Literals.showInt32 $ Lists.head $ var "indices")) nothing $+              var "pad" @@ Lists.tail (var "indices") @@+                (Core.termApplication $ Core.application (var "t") $ Core.termVariable $+                  Core.name $ Strings.cat2 (string "v") (Literals.showInt32 $ Lists.head $ var "indices")))] $+      var "pad" @@ var "is" @@ var "apps",+    "rewrite">: "args" ~> "recurse" ~> "t" ~> lets [+      "afterRecursion">: "term" ~>+        var "expand" @@ var "args" @@ (ref expansionArityDef @@ var "graph" @@ var "term") @@ var "term"] $+      cases _Term (var "t")+        (Just $ var "afterRecursion" @@ (var "recurse" @@ var "t")) [+        _Term_application>>: "app" ~> lets [+          "lhs">: Core.applicationFunction $ var "app",+          "rhs">: Core.applicationArgument $ var "app",+          "erhs">: var "rewrite" @@ (list []) @@ var "recurse" @@ var "rhs"] $+          var "rewrite" @@ (Lists.cons (var "erhs") (var "args")) @@ var "recurse" @@ var "lhs"]]+    $ ref contractTermDef @@ (ref Rewriting.rewriteTermDef @@ (var "rewrite" @@ (list [])) @@ var "term")++expansionArityDef :: TBinding (Graph -> Term -> Int)+expansionArityDef = define "expansionArity" $+  doc "Calculate the arity for lambda expansion" $+  "graph" ~> "term" ~>+    cases _Term (ref Rewriting.deannotateTermDef @@ var "term")+      (Just $ int32 0) [+      _Term_application>>: lambda "app" $+        Math.sub+          (ref expansionArityDef @@ var "graph" @@ Core.applicationFunction (var "app"))+          (int32 1),+      _Term_function>>: "f" ~> cases _Function (var "f")+        Nothing [+        _Function_elimination>>: constant $ int32 1,+        _Function_lambda>>: constant $ int32 0,+        _Function_primitive>>: "name" ~>+          ref Arity.primitiveArityDef @@ (Optionals.fromJust (ref Lexical.lookupPrimitiveDef @@ var "graph" @@ var "name"))],+      _Term_typeLambda>>: "ta" ~> ref expansionArityDef @@ var "graph" @@ Core.typeLambdaBody (var "ta"),+      _Term_typeApplication>>: "tt" ~> ref expansionArityDef @@ var "graph" @@ Core.typedTermTerm (var "tt"),+      _Term_variable>>: "name" ~>+        Optionals.maybe (int32 0)+          ("ts" ~> ref Arity.typeArityDef @@ (Core.typeSchemeType $ var "ts"))+          (Optionals.bind+            (ref Lexical.lookupElementDef @@ var "graph" @@ var "name")+            ("el" ~> Core.bindingType $ var "el"))]++reduceTermDef :: TBinding (Bool -> Term -> Flow Graph Term)+reduceTermDef = define "reduceTerm" $+  doc "A term evaluation function which is alternatively lazy or eager" $+  lambdas ["eager", "term"] $ lets [+    "reduce">: lambda "eager" $ ref reduceTermDef @@ var "eager",++    "doRecurse">: lambdas ["eager", "term"] $+      Logic.and (var "eager") $ cases _Term (var "term") (Just true) [+        _Term_function>>: match _Function (Just true) [+          _Function_lambda>>: constant false]],++    "reduceArg">: lambdas ["eager", "arg"] $+      Logic.ifElse (var "eager")+        (Flows.pure $ var "arg")+        (var "reduce" @@ false @@ var "arg"),++    "applyToArguments">: lambdas ["fun", "args"] $+      Logic.ifElse (Lists.null $ var "args")+        (var "fun")+        (var "applyToArguments" @@+          (Core.termApplication $ Core.application (var "fun") (Lists.head $ var "args")) @@+          (Lists.tail $ var "args")),++    "replaceFreeTypeVariable">: lambdas ["toReplace", "replacement", "term"] $ lets [+      "mapping">: lambdas ["recurse", "inner"] $+        match _Term (Just $ var "recurse" @@ var "inner") [+          _Term_function>>: match _Function (Just $ var "recurse" @@ var "inner") [+            _Function_lambda>>: lambda "l" $ Logic.ifElse+              (Equality.equal (Core.lambdaParameter $ var "l") (var "toReplace"))+              (var "inner")+              (var "recurse" @@ var "inner")],+          _Term_variable>>: lambda "name" $ Logic.ifElse+            (Equality.equal (var "name") (var "toReplace"))+            (var "replacement")+            (var "inner")] @@ var "inner"]+      $ ref Rewriting.rewriteTermDef @@ var "mapping" @@ var "term",++    "applyElimination">: lambdas ["elm", "reducedArg"] $+      match _Elimination Nothing [+        _Elimination_record>>: lambda "proj" $+          Flows.bind (ref ExtractCore.recordDef @@ (Core.projectionTypeName $ var "proj") @@ (ref Rewriting.deannotateTermDef @@ var "reducedArg")) $+            lambda "fields" $ lets [+              "matchingFields">: Lists.filter+                (lambda "f" $ Equality.equal (Core.fieldName $ var "f") (Core.projectionField $ var "proj"))+                (var "fields")]+              $ Logic.ifElse+                (Lists.null $ var "matchingFields")+                (Flows.fail $ Strings.cat $ list [+                  string "no such field: ",+                  unwrap _Name @@ (Core.projectionField $ var "proj"),+                  string " in ",+                  unwrap _Name @@ (Core.projectionTypeName $ var "proj"),+                  string " record"])+                (Flows.pure $ Core.fieldTerm $ Lists.head $ var "matchingFields"),+        _Elimination_union>>: lambda "cs" $+          Flows.bind (ref ExtractCore.injectionDef @@ (Core.caseStatementTypeName $ var "cs") @@ var "reducedArg") $+            lambda "field" $ lets [+              "matchingFields">: Lists.filter+                (lambda "f" $ Equality.equal (Core.fieldName $ var "f") (Core.fieldName $ var "field"))+                (Core.caseStatementCases $ var "cs")]+              $ Logic.ifElse (Lists.null $ var "matchingFields")+                (Optionals.maybe+                  (Flows.fail $ Strings.cat $ list [+                    string "no such field ",+                    unwrap _Name @@ (Core.fieldName $ var "field"),+                    string " in ",+                    unwrap _Name @@ (Core.caseStatementTypeName $ var "cs"),+                    string " case statement"])+                  (unaryFunction Flows.pure)+                  (Core.caseStatementDefault $ var "cs"))+                (Flows.pure $ Core.termApplication $ Core.application+                  (Core.fieldTerm $ Lists.head $ var "matchingFields")+                  (Core.fieldTerm $ var "field")),+        _Elimination_wrap>>: lambda "name" $ ref ExtractCore.wrapDef @@ var "name" @@ var "reducedArg"] @@ var "elm",++    "applyIfNullary">: lambdas ["eager", "original", "args"] $ lets [+      "stripped">: ref Rewriting.deannotateTermDef @@ var "original"]+      $ cases _Term (var "stripped") (Just $ Flows.pure $ var "applyToArguments" @@ var "original" @@ var "args") [+        _Term_application>>: lambda "app" $ var "applyIfNullary" @@ var "eager" @@+          (Core.applicationFunction $ var "app") @@+          (Lists.cons (Core.applicationArgument $ var "app") (var "args")),+        _Term_function>>: match _Function Nothing [+            _Function_elimination>>: lambda "elm" $+              Logic.ifElse (Lists.null $ var "args")+                (Flows.pure $ var "original")+                (lets [+                  "arg">: Lists.head $ var "args",+                  "remainingArgs">: Lists.tail $ var "args"]+                  $ Flows.bind (var "reduceArg" @@ var "eager" @@ (ref Rewriting.deannotateTermDef @@ var "arg")) $+                    lambda "reducedArg" $+                      Flows.bind (Flows.bind (var "applyElimination" @@ var "elm" @@ var "reducedArg") (var "reduce" @@ var "eager")) $+                        lambda "reducedResult" $ var "applyIfNullary" @@ var "eager" @@ var "reducedResult" @@ var "remainingArgs"),+            _Function_lambda>>: lambda "l" $+              Logic.ifElse (Lists.null $ var "args")+                (Flows.pure $ var "original")+                (lets [+                  "param">: Core.lambdaParameter $ var "l",+                  "body">: Core.lambdaBody $ var "l",+                  "arg">: Lists.head $ var "args",+                  "remainingArgs">: Lists.tail $ var "args"]+                  $ Flows.bind (var "reduce" @@ var "eager" @@ (ref Rewriting.deannotateTermDef @@ var "arg")) $+                    lambda "reducedArg" $+                      Flows.bind (var "reduce" @@ var "eager" @@ (var "replaceFreeTypeVariable" @@ var "param" @@ var "reducedArg" @@ var "body")) $+                        lambda "reducedResult" $ var "applyIfNullary" @@ var "eager" @@ var "reducedResult" @@ var "remainingArgs"),+            _Function_primitive>>: lambda "name" $+              Flows.bind (ref Lexical.requirePrimitiveDef @@ var "name") $ lambda "prim" $+                lets [+                  "arity">: ref Arity.primitiveArityDef @@ var "prim"]+                  $ Logic.ifElse (Equality.gt (var "arity") (Lists.length $ var "args"))+                    (Flows.pure $ var "applyToArguments" @@ var "original" @@ var "args")+                    (lets [+                      "argList">: Lists.take (var "arity") (var "args"),+                      "remainingArgs">: Lists.drop (var "arity") (var "args")]+                      $ Flows.bind (Flows.mapList (var "reduceArg" @@ var "eager") (var "argList")) $ lambda "reducedArgs" $+                          Flows.bind+                            (Flows.bind+                              (Graph.primitiveImplementation (var "prim") @@ var "reducedArgs")+                              (var "reduce" @@ var "eager")) $ lambda "reducedResult" $+                                var "applyIfNullary" @@ var "eager" @@ var "reducedResult" @@ var "remainingArgs")],+        _Term_variable>>: lambda "v" $ Flows.pure $ var "applyToArguments" @@ var "original" @@ var "args"],+    "mapping">: lambdas ["recurse", "mid"] $+      Flows.bind+        (Logic.ifElse (var "doRecurse" @@ var "eager" @@ var "mid")+          (var "recurse" @@ var "mid")+          (Flows.pure $ var "mid")) $+        lambda "inner" $ var "applyIfNullary" @@ var "eager" @@ var "inner" @@ (list [])]+    $ ref Rewriting.rewriteTermMDef @@ var "mapping" @@ var "term"++termIsClosedDef :: TBinding (Term -> Bool)+termIsClosedDef = define "termIsClosed" $+  doc "Whether a term is closed, i.e. represents a complete program" $+  lambda "term" $ Sets.null $ ref Rewriting.freeVariablesInTermDef @@ var "term"++termIsValueDef :: TBinding (Graph -> Term -> Bool)+termIsValueDef = define "termIsValue" $+  doc "Whether a term has been fully reduced to a value" $+  lambda "g" $ lambda "term" $ lets [+    "forList">: lambda "els" $ Lists.foldl (lambda "b" $ lambda "t" $ Logic.and (var "b") (ref termIsValueDef @@ var "g" @@ var "t")) true (var "els"),+    "checkField">: lambda "f" $ ref termIsValueDef @@ var "g" @@ Core.fieldTerm (var "f"),+    "checkFields">: lambda "fields" $ Lists.foldl (lambda "b" $ lambda "f" $ Logic.and (var "b") (var "checkField" @@ var "f")) true (var "fields"),+    "functionIsValue">: lambda "f" $+      match _Function Nothing [+        _Function_elimination>>: lambda "e" $+          match _Elimination Nothing [+            _Elimination_wrap>>: constant true,+            _Elimination_record>>: constant true,+            _Elimination_union>>: lambda "cs" $+              Logic.and (var "checkFields" @@ Core.caseStatementCases (var "cs"))+                (Optionals.maybe true (ref termIsValueDef @@ var "g") (Core.caseStatementDefault $ var "cs"))]+          @@ var "e",+        _Function_lambda>>: lambda "l" $ ref termIsValueDef @@ var "g" @@ Core.lambdaBody (var "l"),+        _Function_primitive>>: constant true]+      @@ var "f"]+    $ match _Term (Just false) [+      _Term_application>>: constant false,+      _Term_literal>>: constant true,+      _Term_function>>: lambda "f" $ var "functionIsValue" @@ var "f",+      _Term_list>>: lambda "els" $ var "forList" @@ var "els",+      _Term_map>>: lambda "m" $+        Lists.foldl (lambda "b" $ lambda "kv" $+          Logic.and (var "b") $ Logic.and+            (ref termIsValueDef @@ var "g" @@ first (var "kv"))+            (ref termIsValueDef @@ var "g" @@ second (var "kv")))+          true $ Maps.toList (var "m"),+      _Term_optional>>: lambda "m" $+        Optionals.maybe true (ref termIsValueDef @@ var "g") (var "m"),+      _Term_record>>: lambda "r" $ var "checkFields" @@ Core.recordFields (var "r"),+      _Term_set>>: lambda "s" $ var "forList" @@ Sets.toList (var "s"),+      _Term_union>>: lambda "i" $ var "checkField" @@ Core.injectionField (var "i"),+      _Term_unit>>: constant true,+      _Term_variable>>: constant false]+    @@ (ref Rewriting.deannotateTermDef @@ var "term")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Rewriting.hs view
@@ -0,0 +1,1173 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Rewriting where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Names as Names+import qualified Hydra.Sources.Kernel.Terms.Sorting as Sorting+++module_ :: Module+module_ = Module (Namespace "hydra.rewriting") elements+    [Names.module_, Sorting.module_]+    kernelTypesModules $+    Just ("Utilities for type and term rewriting and analysis.")+  where+   elements = [+     el deannotateAndDetypeTermDef,+     el deannotateTermDef,+     el deannotateTypeDef,+     el deannotateTypeParametersDef,+     el deannotateTypeRecursiveDef,+     el deannotateTypeSchemeRecursiveDef,+     el expandTypedLambdasDef,+     el flattenLetTermsDef,+     el foldOverTermDef,+     el foldOverTypeDef,+     el freeVariablesInTermDef,+     el freeVariablesInTypeDef,+     el freeVariablesInTypeOrderedDef,+     el freeVariablesInTypeSchemeSimpleDef,+     el freeVariablesInTypeSchemeDef,+     el freeVariablesInTypeSimpleDef,+     el inlineTypeDef,+     el isFreeVariableInTermDef,+     el isLambdaDef,+     el mapBeneathTypeAnnotationsDef,+     el normalizeTypeVariablesInTermDef,+     el removeTermAnnotationsDef,+     el removeTypeAnnotationsDef,+     el removeTypesFromTermDef,+     el replaceFreeTermVariableDef,+     el replaceFreeTypeVariableDef,+     el rewriteDef,+     el rewriteTermDef,+     el rewriteTermMDef,+     el rewriteTypeDef,+     el rewriteTypeMDef,+     el simplifyTermDef,+     el substituteTypeVariablesDef,+     el substituteVariableDef,+     el substituteVariablesDef,+     el subtermsDef,+     el subtermsWithAccessorsDef,+     el subtypesDef,+     el termDependencyNamesDef,+     el toShortNamesDef,+     el topologicalSortBindingMapDef,+     el topologicalSortBindingsDef,+     el typeDependencyNamesDef,+     el typeNamesInTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++deannotateAndDetypeTermDef :: TBinding (Term -> Term)+deannotateAndDetypeTermDef = define "deannotateAndDetypeTerm" $+  doc "Strip type annotations from the top levels of a term" $+  lambda "t" $ cases _Term (var "t")+    (Just $ var "t") [+    _Term_annotated>>: lambda "at" $ ref deannotateAndDetypeTermDef @@ (Core.annotatedTermSubject $ var "at"),+    _Term_typeApplication>>: lambda "tt" $ ref deannotateAndDetypeTermDef @@ (Core.typedTermTerm $ var "tt"),+    _Term_typeLambda>>: lambda "ta" $ ref deannotateAndDetypeTermDef @@ (Core.typeLambdaBody $ var "ta")]++deannotateTermDef :: TBinding (Term -> Term)+deannotateTermDef = define "deannotateTerm" $+  doc "Strip all annotations (including System F type annotations) from the top levels of a term" $+  lambda "t" $ cases _Term (var "t")+    (Just $ var "t") [+    _Term_annotated>>: "at" ~> ref deannotateTermDef @@ (Core.annotatedTermSubject $ var "at")]++deannotateTypeDef :: TBinding (Type -> Type)+deannotateTypeDef = define "deannotateType" $+  doc "Strip all annotations from a term" $+  lambda "t" $ cases _Type (var "t")+    (Just $ var "t") [+    _Type_annotated>>: ref deannotateTypeDef <.> (project _AnnotatedType _AnnotatedType_subject)]++deannotateTypeParametersDef :: TBinding (Type -> Type)+deannotateTypeParametersDef = define "deannotateTypeParameters" $+  doc "Strip any top-level type lambdas from a type, extracting the (possibly nested) type body" $+  lambda "t" $ cases _Type (ref deannotateTypeDef @@ var "t")+    (Just $ var "t") [+    _Type_forall>>: lambda "lt" (ref deannotateTypeParametersDef @@ (project _ForallType _ForallType_body @@ var "lt"))]++deannotateTypeRecursiveDef :: TBinding (Type -> Type)+deannotateTypeRecursiveDef = define "deannotateTypeRecursive" $+  doc "Recursively strip all annotations from a type" $+  lambda "typ" $ lets [+    "strip">: lambdas ["recurse", "typ"] $ lets [+      "rewritten">: var "recurse" @@ var "typ"] $+      cases _Type (var "rewritten")+        (Just $ var "rewritten") [+        _Type_annotated>>: lambda "at" $ Core.annotatedTypeSubject $ var "at"]] $+    ref rewriteTypeDef @@ var "strip" @@ var "typ"++deannotateTypeSchemeRecursiveDef :: TBinding (TypeScheme -> TypeScheme)+deannotateTypeSchemeRecursiveDef = define "deannotateTypeSchemeRecursive" $+  doc "Recursively strip all annotations from a type scheme" $+  lambda "ts" $ lets [+    "vars">: Core.typeSchemeVariables $ var "ts",+    "typ">: Core.typeSchemeType $ var "ts"] $+    Core.typeScheme (var "vars") (ref deannotateTypeRecursiveDef @@ var "typ")++expandTypedLambdasDef :: TBinding (Term -> Term)+expandTypedLambdasDef = define "expandTypedLambdas" $+  doc "A variation of expandLambdas which also attaches type annotations when padding function terms" $+  lambda "term" $ lets [+    "toNaryFunType">: lambda "typ" $ lets [+      "helper">: lambda "t" $+        cases _Type (var "t")+          (Just $ pair (list []) (var "t")) [+          _Type_function>>: lambda "ft" $ lets [+            "dom0">: Core.functionTypeDomain $ var "ft",+            "cod0">: Core.functionTypeCodomain $ var "ft",+            "recursive">: var "helper" @@ var "cod0",+            "doms">: first $ var "recursive",+            "cod1">: second $ var "recursive"]+            $ pair (Lists.cons (var "dom0") (var "doms")) (var "cod1")]]+      $ var "helper" @@ (ref deannotateTypeDef @@ var "typ"),+    "padTerm">: lambdas ["i", "doms", "cod", "term"] $+      Logic.ifElse (Lists.null $ var "doms")+        (var "term")+        (lets [+          "dom">: Lists.head $ var "doms",+          "var">: Core.name $ Strings.cat2 (string "v") (Literals.showInt32 $ var "i"),+          "tailDoms">: Lists.tail $ var "doms",+          "toFunctionType">: lambdas ["doms", "cod"] $+            Lists.foldl+              (lambda "c" $ lambda "d" $ Core.typeFunction $ Core.functionType (var "d") (var "c"))+              (var "cod")+              (var "doms")]+          $ Core.termFunction $ Core.functionLambda $ Core.lambda (var "var") (just $ var "dom") $+            var "padTerm"+              @@ (Math.add (var "i") (int32 1))+              @@ (var "tailDoms")+              @@ (var "cod")+              @@ (Core.termApplication $ Core.application+                    (var "term")+                    (Core.termVariable $ var "var"))),+    "expand">: lambdas ["doms", "cod", "term"] $+      cases _Term (var "term")+        (Just $ ref rewriteTermDef @@ var "rewrite" @@ var "term") [+        _Term_annotated>>: lambda "at" $ Core.termAnnotated $ Core.annotatedTerm+          (var "expand" @@ var "doms" @@ var "cod" @@ (Core.annotatedTermSubject $ var "at"))+          (Core.annotatedTermAnnotation $ var "at"),+        _Term_application>>: lambda "app" $ lets [+          "lhs">: Core.applicationFunction $ var "app",+          "rhs">: Core.applicationArgument $ var "app"]+          $ ref rewriteTermDef @@ var "rewrite" @@ var "term",+        _Term_function>>: match _Function+          (Just $ var "padTerm" @@ int32 1 @@ var "doms" @@ var "cod" @@ var "term") [+          _Function_lambda>>: lambda "l" $ Core.termFunction $ Core.functionLambda $ Core.lambda+            (Core.lambdaParameter $ var "l")+            (Core.lambdaDomain $ var "l")+            (var "expand" @@ (Lists.tail $ var "doms") @@ var "cod" @@ (Core.lambdaBody $ var "l"))],+        _Term_let>>: lambda "lt" $ lets [+          "expandBinding">: lambda "b" $ Core.binding+            (Core.bindingName $ var "b")+            (ref expandTypedLambdasDef @@ (Core.bindingTerm $ var "b"))+            (Core.bindingType $ var "b")]+          $ Core.termLet $ Core.let_+            (Lists.map (var "expandBinding") (Core.letBindings $ var "lt"))+            (var "expand" @@ var "doms" @@ var "cod" @@ (Core.letEnvironment $ var "lt"))],+    "rewrite">: lambdas ["recurse", "term"] $ var "recurse" @@ var "term"]+    $ ref rewriteTermDef @@ var "rewrite" @@ var "term"++flattenLetTermsDef :: TBinding (Term -> Term)+flattenLetTermsDef = define "flattenLetTerms" $+  doc "Flatten nested let expressions" $+  lambda "term" $ lets [+    "rewriteBinding">: lambda "binding" $ lets [+      "key0">: Core.bindingName $ var "binding",+      "val0">: Core.bindingTerm $ var "binding",+      "t">: Core.bindingType $ var "binding"] $+      cases _Term (var "val0")+        (Just $ pair (Core.binding (var "key0") (var "val0") (var "t")) (list [])) [+        _Term_annotated>>: lambda "at" $ lets [+          "val1">: Core.annotatedTermSubject $ var "at",+          "ann">: Core.annotatedTermAnnotation $ var "at",+          "recursive">: var "rewriteBinding" @@ (Core.binding (var "key0") (var "val1") (var "t")),+          "innerBinding">: first $ var "recursive",+          "deps">: second $ var "recursive",+          "val2">: Core.bindingTerm $ var "innerBinding"]+          $ pair+            (Core.binding (var "key0") (Core.termAnnotated $ Core.annotatedTerm (var "val2") (var "ann")) (var "t"))+            (var "deps"),+        _Term_let>>: lambda "innerLet" $ lets [+          "bindings1">: Core.letBindings $ var "innerLet",+          "body1">: Core.letEnvironment $ var "innerLet",+          "prefix">: Strings.cat2 (unwrap _Name @@ var "key0") (string "_"),+          "qualify">: lambda "n" $ Core.name $ Strings.cat2 (var "prefix") (unwrap _Name @@ var "n"),+          "toSubstPair">: lambda "b" $ pair (Core.bindingName $ var "b") (var "qualify" @@ (Core.bindingName $ var "b")),+          "subst">: Maps.fromList $ Lists.map (var "toSubstPair") (var "bindings1"),+          "replaceVars">: ref substituteVariablesDef @@ var "subst",+          "newBody">: var "replaceVars" @@ var "body1",+          "newBinding">: lambda "b" $ Core.binding+            (var "qualify" @@ (Core.bindingName $ var "b"))+            (var "replaceVars" @@ (Core.bindingTerm $ var "b"))+            (Core.bindingType $ var "b")]+          $ pair+            (Core.binding (var "key0") (var "newBody") (var "t"))+            (Lists.map (var "newBinding") (var "bindings1"))],+    "flatten">: lambdas ["recurse", "term"] $ lets [+      "rewritten">: var "recurse" @@ var "term"] $+      cases _Term (var "rewritten")+        (Just $ var "rewritten") [+        _Term_let>>: lambda "lt" $ lets [+          "bindings">: Core.letBindings $ var "lt",+          "body">: Core.letEnvironment $ var "lt",+          "forResult">: lambda "hr" $ Lists.cons (first $ var "hr") (second $ var "hr"),+          "newBindings">: Lists.concat $ Lists.map (var "forResult" <.> var "rewriteBinding") (var "bindings")] $+          Core.termLet $ Core.let_ (var "newBindings") (var "body")]]+    $ ref rewriteTermDef @@ var "flatten" @@ var "term"++foldOverTermDef :: TBinding (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x)+foldOverTermDef = define "foldOverTerm" $+  doc "Fold over a term, traversing its subterms in the specified order" $+  lambdas ["order", "fld", "b0", "term"] $ cases _TraversalOrder (var "order") Nothing [+    _TraversalOrder_pre>>: constant (Phantoms.fold (ref foldOverTermDef @@ var "order" @@ var "fld")+      @@ (var "fld" @@ var "b0" @@ var "term")+      @@ (ref subtermsDef @@ var "term")),+    _TraversalOrder_post>>: constant (var "fld"+      @@ (Phantoms.fold (ref foldOverTermDef @@ var "order" @@ var "fld")+        @@ (var "b0")+        @@ (ref subtermsDef @@ var "term"))+      @@ var "term")]++foldOverTypeDef :: TBinding (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x)+foldOverTypeDef = define "foldOverType" $+  doc "Fold over a type, traversing its subtypes in the specified order" $+  lambdas ["order", "fld", "b0", "typ"] $ cases _TraversalOrder (var "order") Nothing [+    _TraversalOrder_pre>>: constant (Phantoms.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")+      @@ (var "fld" @@ var "b0" @@ var "typ")+      @@ (ref subtypesDef @@ var "typ")),+    _TraversalOrder_post>>: constant (var "fld"+      @@ (Phantoms.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")+        @@ (var "b0")+        @@ (ref subtypesDef @@ var "typ"))+      @@ var "typ")]++freeVariablesInTermDef :: TBinding (Term -> S.Set Name)+freeVariablesInTermDef = define "freeVariablesInTerm" $+  doc "Find the free variables (i.e. variables not bound by a lambda or let) in a term" $+  lambda "term" $ lets [+    "dfltVars">: Phantoms.fold (lambda "s" $ lambda "t" $ Sets.union (var "s") (ref freeVariablesInTermDef @@ var "t"))+      @@ Sets.empty+      @@ (ref subtermsDef @@ var "term")] $+    cases _Term (var "term")+      (Just $ var "dfltVars") [+      _Term_function>>: match _Function (Just $ var "dfltVars") [+        _Function_lambda>>: lambda "l" (Sets.delete+          (Core.lambdaParameter $ var "l")+          (ref freeVariablesInTermDef @@ (Core.lambdaBody $ var "l")))],+--      TODO: restore the following+--      _Term_let>>: lambda "l" (Sets.difference+--        @@ (ref freeVariablesInTermDef @@ (Core.letEnvironment $ var "l"))+--        @@ (Sets.fromList (Lists.map first (Maps.toList (Core.letBindings $ var "l"))))),+      _Term_variable>>: lambda "v" (Sets.singleton $ var "v")]++freeVariablesInTypeDef :: TBinding (Type -> S.Set Name)+freeVariablesInTypeDef = define "freeVariablesInType" $+  doc "Find the free variables (i.e. variables not bound by a lambda or let) in a type" $+  lambda "typ" $ lets [+    "dfltVars">: Phantoms.fold (lambda "s" $ lambda "t" $ Sets.union (var "s") (recurse @@ var "t"))+      @@ Sets.empty+      @@ (ref subtypesDef @@ var "typ")] $+    cases _Type (var "typ")+      (Just $ var "dfltVars") [+      _Type_forall>>: lambda "lt" (Sets.delete+          (Core.forallTypeParameter $ var "lt")+          (recurse @@ (Core.forallTypeBody $ var "lt"))),+      -- TODO: let-types+      _Type_variable>>: lambda "v" (Sets.singleton $ var "v")]+  where+    recurse = ref freeVariablesInTypeDef++freeVariablesInTypeOrderedDef :: TBinding (Type -> [Name])+freeVariablesInTypeOrderedDef = define "freeVariablesInTypeOrdered" $+  doc "Find the free variables in a type in deterministic left-to-right order" $+  lambda "typ" $ lets [+    "collectVars">: lambdas ["boundVars", "t"] $+      cases _Type (var "t")+        (Just $ Lists.concat $ Lists.map (var "collectVars" @@ var "boundVars") $+                ref subtypesDef @@ var "t") [+        _Type_variable>>: lambda "v" $+          Logic.ifElse (Sets.member (var "v") (var "boundVars"))+            (list [])+            (list [var "v"]),+        _Type_forall>>: lambda "ft" $+          var "collectVars" @@+            (Sets.insert (Core.forallTypeParameter $ var "ft") (var "boundVars")) @@+            (Core.forallTypeBody $ var "ft")]] $+    (Lists.nub :: TTerm [Name] -> TTerm [Name]) $ var "collectVars" @@ Sets.empty @@ var "typ"++freeVariablesInTypeSimpleDef :: TBinding (Type -> S.Set Name)+freeVariablesInTypeSimpleDef = define "freeVariablesInTypeSimple" $+  doc "Same as freeVariablesInType, but ignores the binding action of lambda types" $+  lambda "typ" $ lets [+    "helper">: lambdas ["types", "typ"] $ cases _Type (var "typ")+      (Just $ var "types") [+      _Type_variable>>: lambda "v" $ Sets.insert (var "v") (var "types")]] $+    ref foldOverTypeDef @@ Coders.traversalOrderPre @@ var "helper" @@ Sets.empty @@ var "typ"++freeVariablesInTypeSchemeDef :: TBinding (TypeScheme -> S.Set Name)+freeVariablesInTypeSchemeDef = define "freeVariablesInTypeScheme" $+  doc "Find free variables in a type scheme" $+  lambda "ts" $ lets [+    "vars">: Core.typeSchemeVariables $ var "ts",+    "t">: Core.typeSchemeType $ var "ts"]+    $ Sets.difference (ref freeVariablesInTypeDef @@ var "t") (Sets.fromList $ var "vars")++freeVariablesInTypeSchemeSimpleDef :: TBinding (TypeScheme -> S.Set Name)+freeVariablesInTypeSchemeSimpleDef = define "freeVariablesInTypeSchemeSimple" $+  doc "Find free variables in a type scheme (simple version)" $+  lambda "ts" $ lets [+    "vars">: Core.typeSchemeVariables $ var "ts",+    "t">: Core.typeSchemeType $ var "ts"]+    $ Sets.difference (ref freeVariablesInTypeSimpleDef @@ var "t") (Sets.fromList $ var "vars")++inlineTypeDef :: TBinding (M.Map Name Type -> Type -> Flow s Type)+inlineTypeDef = define "inlineType" $+  doc "Inline all type variables in a type using the provided schema. Note: this function is only appropriate for nonrecursive type definitions" $+  lambdas ["schema", "typ"] $ lets [+    "f">: lambdas ["recurse", "typ"] $ binds [+      "tr">: var "recurse" @@ var "typ"] $+      cases _Type (var "tr")+        (Just $ produce $ var "tr") [+        _Type_variable>>: lambda "v" $+          Optionals.maybe+            (Flows.fail $ Strings.cat2 (string "No such type in schema: ") (unwrap _Name @@ var "v"))+            (ref inlineTypeDef @@ var "schema")+            (Maps.lookup (var "v") (var "schema"))]] $+    ref rewriteTypeMDef @@ var "f" @@ var "typ"++isFreeVariableInTermDef :: TBinding (Name -> Term -> Bool)+isFreeVariableInTermDef = define "isFreeVariableInTerm" $+ doc "Check whether a variable is free (not bound) in a term" $+ lambda "v" $ lambda "term" $+   Logic.not $ Sets.member (var "v") (ref freeVariablesInTermDef @@ var "term")++isLambdaDef :: TBinding (Term -> Bool)+isLambdaDef = define "isLambda" $+  doc "Check whether a term is a lambda, possibly nested within let and/or annotation terms" $+  lambda "term" $ cases _Term (ref deannotateTermDef @@ var "term")+    (Just false) [+    _Term_function>>: match _Function+      (Just false) [+      _Function_lambda>>: constant true],+    _Term_let>>: lambda "lt" (ref isLambdaDef @@ (project _Let _Let_environment @@ var "lt"))]++mapBeneathTypeAnnotationsDef :: TBinding ((Type -> Type) -> Type -> Type)+mapBeneathTypeAnnotationsDef = define "mapBeneathTypeAnnotations" $+  doc "Apply a transformation to the first type beneath a chain of annotations" $+  lambdas ["f", "t"] $ cases _Type (var "t")+    (Just $ var "f" @@ var "t") [+    _Type_annotated>>: lambda "at" $ Core.typeAnnotated $ Core.annotatedType+      (ref mapBeneathTypeAnnotationsDef @@ var "f" @@ (Core.annotatedTypeSubject $ var "at"))+      (Core.annotatedTypeAnnotation $ var "at")]++normalizeTypeVariablesInTermDef :: TBinding (Term -> Term)+normalizeTypeVariablesInTermDef = define "normalizeTypeVariablesInTerm" $+  doc "Recursively replace the type variables of let bindings with the systematic type variables t0, t1, t2, ..." $+  lambda "term" $ lets [+    "substType">: lambdas ["subst", "typ"] $ lets [+      "rewrite">: lambdas ["recurse", "typ"] $ cases _Type (var "typ")+        (Just $ var "recurse" @@ var "typ") [+        _Type_variable>>: lambda "v" $ Core.typeVariable $ var "replaceName" @@ var "subst" @@ var "v"]] $+      ref rewriteTypeDef @@ var "rewrite" @@ var "typ",+    "replaceName">: lambdas ["subst", "v"] $ Optionals.fromMaybe (var "v") $ Maps.lookup (var "v") (var "subst"),+    "rewriteWithSubst">: lambda "substAndBound" $ lets [+      "subst">: first $ var "substAndBound",+      "boundVars">: second $ var "substAndBound",+      "rewrite">: lambdas ["recurse", "term"] $ cases _Term (var "term")+        (Just $ var "recurse" @@ var "term") [+        _Term_function>>: match _Function+          (Just $ var "recurse" @@ var "term") [+          _Function_elimination>>: match _Elimination+            (Just $ var "recurse" @@ var "term") [+            _Elimination_product>>: lambda "tproj" $ lets [+              "arity">: Core.tupleProjectionArity $ var "tproj",+              "index">: Core.tupleProjectionIndex $ var "tproj",+              "domain">: Core.tupleProjectionDomain $ var "tproj"] $+              Core.termFunction $ Core.functionElimination $ Core.eliminationProduct $ Core.tupleProjection+                (var "arity")+                (var "index")+                (Optionals.map+                  (lambda "types" $ Lists.map (var "substType" @@ var "subst") (var "types"))+                  (var "domain"))],+          _Function_lambda>>: lambda "l" $ Core.termFunction $ Core.functionLambda $ Core.lambda+            (Core.lambdaParameter $ var "l")+            (Optionals.map (var "substType" @@ var "subst") (Core.lambdaDomain $ var "l"))+            (var "rewriteWithSubst" @@ (pair (var "subst") (var "boundVars")) @@ (Core.lambdaBody $ var "l"))],+        _Term_let>>: lambda "lt" $ lets [+          "bindings">: Core.letBindings $ var "lt",+          "env">: Core.letEnvironment $ var "lt",+          "rewriteBinding">: lambda "b" $+            Optionals.maybe+              (var "b")+              (lambda "ts" $ lets [+                "vars">: Core.typeSchemeVariables $ var "ts",+                "typ">: Core.typeSchemeType $ var "ts",+                "varsLen">: Lists.length $ var "vars",+                "boundVarsLen">: Sets.size $ var "boundVars",+                "normalVariables">: Lists.map (lambda "i" $ Core.name $ Strings.cat2 (string "t") (Literals.showInt32 $ var "i")) $+                  Math.range (int32 0) (Math.add (var "varsLen") (var "boundVarsLen")),+                "newVars">: Lists.take (Lists.length $ var "vars") $ Lists.filter+                  (lambda "n" $ Logic.not $ Sets.member (var "n") (var "boundVars"))+                  (var "normalVariables"),+                "newSubst">: Maps.union (Maps.fromList $ Lists.zip (var "vars") (var "newVars")) (var "subst"),+                "newValue">: var "rewriteWithSubst"+                  @@ (pair (var "newSubst") (Sets.union (var "boundVars") (Sets.fromList $ var "newVars")))+                  @@ (Core.bindingTerm $ var "b")] $+                Core.binding+                  (Core.bindingName $ var "b")+                  (var "newValue")+                  (just $ Core.typeScheme (var "newVars") (var "substType" @@ var "newSubst" @@ var "typ")))+              (Core.bindingType $ var "b")] $+          Core.termLet $ Core.let_+            (Lists.map (var "rewriteBinding") (var "bindings"))+            (var "rewriteWithSubst" @@ (pair (var "subst") (var "boundVars")) @@ var "env"),+        _Term_typeApplication>>: lambda "tt" $ Core.termTypeApplication $ Core.typedTerm+          (var "rewriteWithSubst" @@ (pair (var "subst") (var "boundVars")) @@ (Core.typedTermTerm $ var "tt"))+          (var "substType" @@ var "subst" @@ (Core.typedTermType $ var "tt")),+        _Term_typeLambda>>: lambda "ta" $ Core.termTypeLambda $ Core.typeLambda+          (var "replaceName" @@ var "subst" @@ (Core.typeLambdaParameter $ var "ta"))+          (var "rewriteWithSubst" @@ (pair (var "subst") (var "boundVars")) @@ (Core.typeLambdaBody $ var "ta"))]] $+      ref rewriteTermDef @@ var "rewrite"] $+    var "rewriteWithSubst" @@ (pair Maps.empty Sets.empty) @@ var "term"++removeTermAnnotationsDef :: TBinding (Term -> Term)+removeTermAnnotationsDef = define "removeTermAnnotations" $+  doc "Recursively remove term annotations, including within subterms" $+  lambda "term" $ lets [+    "remove">: lambdas ["recurse", "term"] $ lets [+      "rewritten">: var "recurse" @@ var "term"] $+      cases _Term (var "term")+        (Just $ var "rewritten") [+        _Term_annotated>>: lambda "at" $ Core.annotatedTermSubject $ var "at"]]+    $ ref rewriteTermDef @@ var "remove" @@ var "term"++removeTypeAnnotationsDef :: TBinding (Type -> Type)+removeTypeAnnotationsDef = define "removeTypeAnnotations" $+  doc "Recursively remove type annotations, including within subtypes" $+  lambda "typ" $ lets [+    "remove">: lambdas ["recurse", "typ"] $ lets [+      "rewritten">: var "recurse" @@ var "typ"] $+      cases _Type (var "rewritten")+        (Just $ var "rewritten") [+        _Type_annotated>>: lambda "at" $ Core.annotatedTypeSubject $ var "at"]] $+    ref rewriteTypeDef @@ var "remove" @@ var "typ"++removeTypesFromTermDef :: TBinding (Term -> Term)+removeTypesFromTermDef = define "removeTypesFromTerm" $+  doc "Strip type annotations from terms while preserving other annotations" $+  lambda "term" $ lets [+    "strip">: lambdas ["recurse", "term"] $ lets [+      "rewritten">: var "recurse" @@ var "term",+      "stripBinding">: lambda "b" $ Core.binding+        (Core.bindingName $ var "b")+        (Core.bindingTerm $ var "b")+        nothing] $+      cases _Term (var "rewritten")+        (Just $ var "rewritten") [+        _Term_function>>: lambda "f" $ cases _Function (var "f")+          (Just $ Core.termFunction $ var "f") [+          _Function_elimination>>: lambda "e" $ cases _Elimination (var "e")+            (Just $ Core.termFunction $ Core.functionElimination $ var "e") [+            _Elimination_product>>: lambda "tp" $ Core.termFunction $ Core.functionElimination $ Core.eliminationProduct $+              Core.tupleProjection+                (Core.tupleProjectionIndex $ var "tp")+                (Core.tupleProjectionArity $ var "tp")+                nothing],+          _Function_lambda>>: lambda "l" $ Core.termFunction $ Core.functionLambda $ Core.lambda+            (Core.lambdaParameter $ var "l")+            nothing+            (Core.lambdaBody $ var "l")],+        _Term_let>>: lambda "lt" $ Core.termLet $ Core.let_+          (Lists.map (var "stripBinding") (Core.letBindings $ var "lt"))+          (Core.letEnvironment $ var "lt"),+        _Term_typeApplication>>: lambda "tt" $ Core.typedTermTerm $ var "tt",+        _Term_typeLambda>>: lambda "ta" $ Core.typeLambdaBody $ var "ta"]]+    $ ref rewriteTermDef @@ var "strip" @@ var "term"++replaceFreeTermVariableDef :: TBinding (Name -> Term -> Term -> Term)+replaceFreeTermVariableDef = define "replaceFreeTermVariable" $+  doc "Replace a free variable in a term" $+  "vold" ~> "tnew" ~> "term" ~>+  "rewrite" <~ ("recurse" ~> "t" ~> cases _Term (var "t")+    (Just $ var "recurse" @@ var "t") [+    _Term_function>>: lambda "f" $+      cases _Function (var "f")+        (Just $ var "recurse" @@ var "t") [+        _Function_lambda>>: "l" ~> (+          "v" <~ Core.lambdaParameter (var "l") $+          Logic.ifElse (Equality.equal (var "v") (var "vold"))+            (var "t")+            (var "recurse" @@ var "t"))],+    _Term_variable>>: "v" ~>+      Logic.ifElse (Equality.equal (var "v") (var "vold"))+        (var "tnew")+        (Core.termVariable $ var "v")]) $+  ref rewriteTermDef @@ var "rewrite" @@ var "term"++rewriteDef :: TBinding (((x -> y) -> x -> y) -> ((x -> y) -> x -> y) -> x -> y)+rewriteDef = define "rewrite" $ lambdas ["fsub", "f"] $ lets [+  "recurse">: var "f" @@ (var "fsub" @@ var "recurse")] $+  var "recurse"++replaceFreeTypeVariableDef :: TBinding (Name -> Type -> Type -> Type)+replaceFreeTypeVariableDef = define "replaceFreeTypeVariable" $+  doc "Replace free occurrences of a name in a type" $+  lambdas ["v", "rep", "typ"] $ lets [+    "mapExpr">: lambdas ["recurse", "t"] $ cases _Type (var "t")+      (Just $ var "recurse" @@ var "t") [+      _Type_forall>>: lambda "ft" $ Logic.ifElse+        (Equality.equal (var "v") (Core.forallTypeParameter $ var "ft"))+        (var "t")+        (Core.typeForall $ Core.forallType+          (Core.forallTypeParameter $ var "ft")+          (var "recurse" @@ (Core.forallTypeBody $ var "ft"))),+      _Type_variable>>: lambda "v'" $ Logic.ifElse+        (Equality.equal (var "v") (var "v'"))+        (var "rep")+        (var "t")]] $+    ref rewriteTypeDef @@ var "mapExpr" @@ var "typ"++rewriteTermDef :: TBinding (((Term -> Term) -> Term -> Term) -> Term -> Term)+rewriteTermDef = define "rewriteTerm" $ lambda "f" $ lets [+  "fsub">: lambdas ["recurse", "term"] $ lets [+    "forElimination">: lambda "elm" $ cases _Elimination (var "elm") Nothing [+      _Elimination_product>>: lambda "tp" $ Core.eliminationProduct $ var "tp",+      _Elimination_record>>: lambda "p" $ Core.eliminationRecord $ var "p",+      _Elimination_union>>: lambda "cs" $ Core.eliminationUnion $ Core.caseStatement+        (Core.caseStatementTypeName $ var "cs")+        (Optionals.map (var "recurse") (Core.caseStatementDefault $ var "cs"))+        (Lists.map (var "forField") (Core.caseStatementCases $ var "cs")),+      _Elimination_wrap>>: lambda "name" $ Core.eliminationWrap $ var "name"],+    "forField">: lambda "f" $ Core.fieldWithTerm (var "recurse" @@ (Core.fieldTerm $ var "f")) (var "f"),+    "forFunction">: lambda "fun" $ cases _Function (var "fun") Nothing [+      _Function_elimination>>: lambda "elm" $ Core.functionElimination $ var "forElimination" @@ var "elm",+      _Function_lambda>>: lambda "l" $ Core.functionLambda $ Core.lambda+        (Core.lambdaParameter $ var "l")+        (Core.lambdaDomain $ var "l")+        (var "recurse" @@ (Core.lambdaBody $ var "l")),+      _Function_primitive>>: lambda "name" $ Core.functionPrimitive $ var "name"],+    "forLet">: lambda "lt" $ lets [+      "mapBinding">: lambda "b" $ Core.binding+        (Core.bindingName $ var "b")+        (var "recurse" @@ (Core.bindingTerm $ var "b"))+        (Core.bindingType $ var "b")] $+      Core.let_+        (Lists.map (var "mapBinding") (Core.letBindings $ var "lt"))+        (var "recurse" @@ (Core.letEnvironment $ var "lt")),+    "forMap">: lambda "m" $ lets [+      "forPair">: lambda "p" $ pair (var "recurse" @@ (untuple 2 0 @@ var "p")) (var "recurse" @@ (untuple 2 1 @@ var "p"))] $+      Maps.fromList $ Lists.map (var "forPair") $ Maps.toList $ var "m"] $+    cases _Term (var "term") Nothing [+      _Term_annotated>>: lambda "at" $ Core.termAnnotated $ Core.annotatedTerm+        (var "recurse" @@ (Core.annotatedTermSubject $ var "at"))+        (Core.annotatedTermAnnotation $ var "at"),+      _Term_application>>: lambda "a" $ Core.termApplication $ Core.application+        (var "recurse" @@ (Core.applicationFunction $ var "a"))+        (var "recurse" @@ (Core.applicationArgument $ var "a")),+      _Term_function>>: lambda "fun" $ Core.termFunction $ var "forFunction" @@ var "fun",+      _Term_let>>: lambda "lt" $ Core.termLet $ var "forLet" @@ var "lt",+      _Term_list>>: lambda "els" $ Core.termList $ Lists.map (var "recurse") (var "els"),+      _Term_literal>>: lambda "v" $ Core.termLiteral $ var "v",+      _Term_map>>: lambda "m" $ Core.termMap $ var "forMap" @@ var "m",+      _Term_wrap>>: lambda "wt" $ Core.termWrap $ Core.wrappedTerm+        (Core.wrappedTermTypeName $ var "wt")+        (var "recurse" @@ (Core.wrappedTermObject $ var "wt")),+      _Term_optional>>: lambda "m" $ Core.termOptional $ Optionals.map (var "recurse") (var "m"),+      _Term_product>>: lambda "tuple" $ Core.termProduct $ Lists.map (var "recurse") (var "tuple"),+      _Term_record>>: lambda "r" $ Core.termRecord $ Core.record+        (Core.recordTypeName $ var "r")+        (Lists.map (var "forField") (Core.recordFields $ var "r")),+      _Term_set>>: lambda "s" $ Core.termSet $ Sets.fromList $ Lists.map (var "recurse") $ Sets.toList (var "s"),+      _Term_sum>>: lambda "s" $ Core.termSum $ Core.sum+        (Core.sumIndex $ var "s")+        (Core.sumSize $ var "s")+        (var "recurse" @@ (Core.sumTerm $ var "s")),+      _Term_typeApplication>>: lambda "tt" $ Core.termTypeApplication $ Core.typedTerm+        (var "recurse" @@ (Core.typedTermTerm $ var "tt"))+        (Core.typedTermType $ var "tt"),+      _Term_typeLambda>>: lambda "ta" $ Core.termTypeLambda $ Core.typeLambda+        (Core.typeLambdaParameter $ var "ta")+        (var "recurse" @@ (Core.typeLambdaBody $ var "ta")),+      _Term_union>>: lambda "i" $ Core.termUnion $ Core.injection+        (Core.injectionTypeName $ var "i")+        (var "forField" @@ (Core.injectionField $ var "i")),+      _Term_unit>>: constant Core.termUnit,+      _Term_variable>>: lambda "v" $ Core.termVariable $ var "v"]] $+  ref rewriteDef @@ var "fsub" @@ var "f"+  where+    foo = emit++emit :: String+emit = "pure"++rewriteTermMDef :: TBinding (((Term -> Flow s Term) -> Term -> Flow s Term) -> Term -> Flow s Term)+rewriteTermMDef = define "rewriteTermM" $+  doc "Monadic term rewriting with custom transformation function" $+  lambda "f" $ lets [+    "fsub">: lambda "recurse" $ lambda "term" $ lets [+      "forField">: lambda "f" $ Flows.map+        (lambda "t" $ Core.fieldWithTerm (var "t") (var "f"))+        (var "recurse" @@ Core.fieldTerm (var "f")),+      "forPair">: lambda "kv" $ lets [+        "k">: first $ var "kv",+        "v">: second $ var "kv"] $ binds [+        "km">: var "recurse" @@ var "k",+        "vm">: var "recurse" @@ var "v"] $+        produce $ pair (var "km") (var "vm"),+      "mapBinding">: lambda "binding" $ lets [+        "k">: Core.bindingName $ var "binding",+        "v">: Core.bindingTerm $ var "binding",+        "t">: Core.bindingType $ var "binding"] $ binds [+        "v'">: var "recurse" @@ var "v"] $+        produce $ Core.binding (var "k") (var "v'") (var "t")] $+      cases _Term (var "term") Nothing [+        _Term_annotated>>: lambda "at" $ binds [+          "ex">: var "recurse" @@ Core.annotatedTermSubject (var "at")] $+          produce $ Core.termAnnotated $ Core.annotatedTerm (var "ex") (Core.annotatedTermAnnotation $ var "at"),+        _Term_application>>: lambda "app" $ binds [+          "lhs">: var "recurse" @@ Core.applicationFunction (var "app"),+          "rhs">: var "recurse" @@ Core.applicationArgument (var "app")] $+          produce $ Core.termApplication $ Core.application (var "lhs") (var "rhs"),+        _Term_function>>: lambda "fun" $ binds [+          "rfun">: cases _Function (var "fun") Nothing [+            _Function_elimination>>: lambda "e" $+              cases _Elimination (var "e") Nothing [+                _Elimination_product>>: lambda "tp" $ produce $ Core.functionElimination $ Core.eliminationProduct $ var "tp",+                _Elimination_record>>: lambda "p" $ produce $ Core.functionElimination $ Core.eliminationRecord $ var "p",+                _Elimination_union>>: lambda "cs" $ lets [+                  "n">: Core.caseStatementTypeName $ var "cs",+                  "def">: Core.caseStatementDefault $ var "cs",+                  "cases">: Core.caseStatementCases $ var "cs"]+                  $ Flows.bind+                      (Optionals.maybe (produce nothing)+                        (lambda "t" $ Flows.map (unaryFunction just) $ var "recurse" @@ var "t")+                        (var "def")) $+                    lambda "rdef" $+                      Flows.map+                        (lambda "rcases" $ Core.functionElimination $ Core.eliminationUnion $+                          Core.caseStatement (var "n") (var "rdef") (var "rcases"))+                        (Flows.mapList (var "forField") (var "cases")),+                _Elimination_wrap>>: lambda "name" $ produce $ Core.functionElimination $ Core.eliminationWrap $ var "name"],+            _Function_lambda>>: lambda "l" $ lets [+              "v">: Core.lambdaParameter $ var "l",+              "d">: Core.lambdaDomain $ var "l",+              "body">: Core.lambdaBody $ var "l"] $ binds [+              "rbody">: var "recurse" @@ var "body"] $+              produce $ Core.functionLambda $ Core.lambda (var "v") (var "d") (var "rbody"),+            _Function_primitive>>: lambda "name" $ produce $ Core.functionPrimitive $ var "name"]] $+          produce $ Core.termFunction $ var "rfun",+        _Term_let>>: lambda "lt" $ lets [+          "bindings">: Core.letBindings $ var "lt",+          "env">: Core.letEnvironment $ var "lt"] $ binds [+          "rbindings">: Flows.mapList (var "mapBinding") (var "bindings"),+          "renv">: var "recurse" @@ var "env"] $+          produce $ Core.termLet $ Core.let_ (var "rbindings") (var "renv"),+        _Term_list>>: lambda "els" $ binds [+          "rels">: Flows.mapList (var "recurse") (var "els")] $+          produce $ Core.termList $ var "rels",+        _Term_literal>>: lambda "v" $ produce $ Core.termLiteral $ var "v",+        _Term_map>>: lambda "m" $ binds [+          "pairs">: Flows.mapList (var "forPair") $ Maps.toList $ var "m"] $+          produce $ Core.termMap $ Maps.fromList $ var "pairs",+        _Term_optional>>: lambda "m" $ binds [+          "rm">: Flows.mapOptional (var "recurse") (var "m")] $+          produce $ Core.termOptional $ var "rm",+        _Term_product>>: lambda "tuple" $ Flows.map+            (lambda "rtuple" $ Core.termProduct $ var "rtuple")+            (Flows.mapList (var "recurse") (var "tuple")),+        _Term_record>>: lambda "r" $ lets [+          "n">: Core.recordTypeName $ var "r",+          "fields">: Core.recordFields $ var "r"] $+          Flows.map+            (lambda "rfields" $ Core.termRecord $ Core.record (var "n") (var "rfields"))+            (Flows.mapList (var "forField") (var "fields")),+        _Term_set>>: lambda "s" $ binds [+          "rlist">: Flows.mapList (var "recurse") $ Sets.toList $ var "s"] $+          produce $ Core.termSet $ Sets.fromList $ var "rlist",+        _Term_sum>>: lambda "sum" $ lets [+          "i">: Core.sumIndex $ var "sum",+          "s">: Core.sumSize $ var "sum",+          "trm">: Core.sumTerm $ var "sum"] $ binds [+          "rtrm">: var "recurse" @@ var "trm"] $+          produce $ Core.termSum $ Core.sum (var "i") (var "s") (var "rtrm"),+        _Term_typeApplication>>: lambda "tt" $ binds [+          "t">: var "recurse" @@ Core.typedTermTerm (var "tt")] $+          produce $ Core.termTypeApplication $ Core.typedTerm (var "t") (Core.typedTermType (var "tt")),+        _Term_typeLambda>>: lambda "tl" $ lets [+          "v">: Core.typeLambdaParameter $ var "tl",+          "body">: Core.typeLambdaBody $ var "tl"] $ binds [+          "rbody">: var "recurse" @@ var "body"] $+          produce $ Core.termTypeLambda $ Core.typeLambda (var "v") (var "rbody"),+        _Term_union>>: lambda "i" $ lets [+          "n">: Core.injectionTypeName $ var "i",+          "field">: Core.injectionField $ var "i"] $+          Flows.map+            (lambda "rfield" $ Core.termUnion $ Core.injection (var "n") (var "rfield"))+            (var "forField" @@ var "field"),+        _Term_unit>>: constant $ produce Core.termUnit,+        _Term_variable>>: lambda "v" $ produce $ Core.termVariable $ var "v",+        _Term_wrap>>: lambda "wt" $ lets [+          "name">: Core.wrappedTermTypeName $ var "wt",+          "t">: Core.wrappedTermObject $ var "wt"] $ binds [+          "rt">: var "recurse" @@ var "t"] $+          produce $ Core.termWrap $ Core.wrappedTerm (var "name") (var "rt")]] $+    ref rewriteDef @@ var "fsub" @@ var "f"++rewriteTypeDef :: TBinding (((Type -> Type) -> Type -> Type) -> Type -> Type)+rewriteTypeDef = define "rewriteType" $ lambda "f" $ lets [+  "fsub">: lambdas ["recurse", "typ"] $ lets [+    "forField">: lambda "f" $ Core.fieldTypeWithType (var "f") (var "recurse" @@ (Core.fieldTypeType $ var "f"))] $+    cases _Type (var "typ") Nothing [+      _Type_annotated>>: lambda "at" $ Core.typeAnnotated $ Core.annotatedType+        (var "recurse" @@ (Core.annotatedTypeSubject $ var "at"))+        (Core.annotatedTypeAnnotation $ var "at"),+      _Type_application>>: lambda "app" $ Core.typeApplication $ Core.applicationType+        (var "recurse" @@ (Core.applicationTypeFunction $ var "app"))+        (var "recurse" @@ (Core.applicationTypeArgument $ var "app")),+      _Type_function>>: lambda "fun" $ Core.typeFunction $ Core.functionType+        (var "recurse" @@ (Core.functionTypeDomain $ var "fun"))+        (var "recurse" @@ (Core.functionTypeCodomain $ var "fun")),+      _Type_forall>>: lambda "lt" $ Core.typeForall $ Core.forallType+        (Core.forallTypeParameter $ var "lt")+        (var "recurse" @@ (Core.forallTypeBody $ var "lt")),+      _Type_list>>: lambda "t" $ Core.typeList $ var "recurse" @@ var "t",+      _Type_literal>>: lambda "lt" $ Core.typeLiteral $ var "lt",+      _Type_map>>: lambda "mt" $ Core.typeMap $ Core.mapType+        (var "recurse" @@ (Core.mapTypeKeys $ var "mt"))+        (var "recurse" @@ (Core.mapTypeValues $ var "mt")),+      _Type_optional>>: lambda "t" $ Core.typeOptional $ var "recurse" @@ var "t",+      _Type_product>>: lambda "ts" $ Core.typeProduct $ Lists.map (var "recurse") (var "ts"),+      _Type_record>>: lambda "rt" $ Core.typeRecord $ Core.rowType+        (Core.rowTypeTypeName $ var "rt")+        (Lists.map (var "forField") (Core.rowTypeFields $ var "rt")),+      _Type_set>>: lambda "t" $ Core.typeSet $ var "recurse" @@ var "t",+      _Type_sum>>: lambda "ts" $ Core.typeSum $ Lists.map (var "recurse") (var "ts"),+      _Type_union>>: lambda "rt" $ Core.typeUnion $ Core.rowType+        (Core.rowTypeTypeName $ var "rt")+        (Lists.map (var "forField") (Core.rowTypeFields $ var "rt")),+      _Type_unit>>: constant Core.typeUnit,+      _Type_variable>>: lambda "v" $ Core.typeVariable $ var "v",+      _Type_wrap>>: lambda "wt" $ Core.typeWrap $ Core.wrappedType+        (Core.wrappedTypeTypeName $ var "wt")+        (var "recurse" @@ (Core.wrappedTypeObject $ var "wt"))]] $+  ref rewriteDef @@ var "fsub" @@ var "f"++rewriteTypeMDef :: TBinding (((Type -> Flow s Type) -> Type -> Flow s Type) -> Type -> Flow s Type)+rewriteTypeMDef = define "rewriteTypeM" $+  doc "Monadic type rewriting" $ lets [+  "fsub">: lambdas ["recurse", "typ"] $ cases _Type (var "typ") Nothing [+    _Type_annotated>>: lambda "at" $ binds [+      "t">: var "recurse" @@ (Core.annotatedTypeSubject $ var "at")] $+      produce $ Core.typeAnnotated $ Core.annotatedType (var "t") (Core.annotatedTypeAnnotation $ var "at"),+    _Type_application>>: lambda "at" $ binds [+      "lhs">: var "recurse" @@ (Core.applicationTypeFunction $ var "at"),+      "rhs">: var "recurse" @@ (Core.applicationTypeArgument $ var "at")] $+      produce $ Core.typeApplication $ Core.applicationType (var "lhs") (var "rhs"),+    _Type_function>>: lambda "ft" $ binds [+      "dom">: var "recurse" @@ (Core.functionTypeDomain $ var "ft"),+      "cod">: var "recurse" @@ (Core.functionTypeCodomain $ var "ft")] $+      produce $ Core.typeFunction $ Core.functionType (var "dom") (var "cod"),+    _Type_forall>>: lambda "ft" $ binds [+      "b">: var "recurse" @@ (Core.forallTypeBody $ var "ft")] $+      produce $ Core.typeForall $ Core.forallType (Core.forallTypeParameter $ var "ft") (var "b"),+    _Type_list>>: lambda "t" $ binds [+      "rt">: var "recurse" @@ var "t"] $+      produce $ Core.typeList $ var "rt",+    _Type_literal>>: lambda "lt" $ produce $ Core.typeLiteral $ var "lt",+    _Type_map>>: lambda "mt" $ binds [+      "kt">: var "recurse" @@ (Core.mapTypeKeys $ var "mt"),+      "vt">: var "recurse" @@ (Core.mapTypeValues $ var "mt")] $+      produce $ Core.typeMap $ Core.mapType (var "kt") (var "vt"),+    _Type_optional>>: lambda "t" $ binds [+      "rt">: var "recurse" @@ var "t"] $+      produce $ Core.typeOptional $ var "rt",+    _Type_product>>: lambda "types" $ binds [+      "rtypes">: Flows.mapList (var "recurse") (var "types")] $+      produce $ Core.typeProduct $ var "rtypes",+    _Type_record>>: lambda "rt" $ lets [+      "name">: Core.rowTypeTypeName $ var "rt",+      "fields">: Core.rowTypeFields $ var "rt",+      "forField">: lambda "f" $ binds [+        "t">: var "recurse" @@ (Core.fieldTypeType $ var "f")] $+        produce $ Core.fieldTypeWithType (var "f") (var "t")] $ binds [+      "rfields">: Flows.mapList (var "forField") (var "fields")] $+      produce $ Core.typeRecord $ Core.rowType (var "name") (var "rfields"),+    _Type_set>>: lambda "t" $ binds [+      "rt">: var "recurse" @@ var "t"] $+      produce $ Core.typeSet $ var "rt",+    _Type_sum>>: lambda "types" $ binds [+      "rtypes">: Flows.mapList (var "recurse") (var "types")] $+      produce $ Core.typeSum $ var "rtypes",+    _Type_union>>: lambda "rt" $ lets [+      "name">: Core.rowTypeTypeName $ var "rt",+      "fields">: Core.rowTypeFields $ var "rt",+      "forField">: lambda "f" $ binds [+        "t">: var "recurse" @@ (Core.fieldTypeType $ var "f")] $+        produce $ Core.fieldTypeWithType (var "f") (var "t")] $ binds [+      "rfields">: Flows.mapList (var "forField") (var "fields")] $+      produce $ Core.typeUnion $ Core.rowType (var "name") (var "rfields"),+    _Type_unit>>: constant $ produce Core.typeUnit,+    _Type_variable>>: lambda "v" $ produce $ Core.typeVariable $ var "v",+    _Type_wrap>>: lambda "wt" $ binds [+      "t">: var "recurse" @@ (Core.wrappedTypeObject $ var "wt")] $+      produce $ Core.typeWrap $ Core.wrappedType (Core.wrappedTypeTypeName $ var "wt") (var "t")]] $+  lambda "f" $ ref rewriteDef @@ var "fsub" @@ var "f"++simplifyTermDef :: TBinding (Term -> Term)+simplifyTermDef = define "simplifyTerm" $+  doc "Simplify terms by applying beta reduction where possible" $+  lambda "term" $ lets [+    "simplify">: lambdas ["recurse", "term"] $ lets [+      "stripped">: ref deannotateTermDef @@ var "term"] $+      var "recurse" @@ (cases _Term (var "stripped")+        (Just $ var "term") [+        _Term_application>>: lambda "app" $ lets [+          "lhs">: Core.applicationFunction $ var "app",+          "rhs">: Core.applicationArgument $ var "app",+          "strippedLhs">: ref deannotateTermDef @@ var "lhs"] $+          cases _Term (var "strippedLhs")+            (Just $ var "term") [+            _Term_function>>: match _Function+              (Just $ var "term") [+              _Function_lambda>>: lambda "l" $ lets [+                "var">: Core.lambdaParameter $ var "l",+                "body">: Core.lambdaBody $ var "l"] $+                Logic.ifElse (Sets.member (var "var") (ref freeVariablesInTermDef @@ var "body"))+                  (lets [+                    "strippedRhs">: ref deannotateTermDef @@ var "rhs"] $+                    cases _Term (var "strippedRhs")+                      (Just $ var "term") [+                      _Term_variable>>: lambda "v" $+                        ref simplifyTermDef @@ (ref substituteVariableDef @@ var "var" @@ var "v" @@ var "body")])+                  (ref simplifyTermDef @@ var "body")]]])] $+    ref rewriteTermDef @@ var "simplify" @@ var "term"++substituteTypeVariablesDef :: TBinding (M.Map Name Name -> Type -> Type)+substituteTypeVariablesDef = define "substituteTypeVariables" $+  doc "Substitute type variables in a type" $+  lambdas ["subst", "typ"] $ lets [+    "replace">: lambdas ["recurse", "typ"] $ cases _Type (var "typ")+      (Just $ var "recurse" @@ var "typ") [+      _Type_variable>>: lambda "n" $+        Core.typeVariable $ Optionals.fromMaybe (var "n") $ Maps.lookup (var "n") (var "subst")]] $+    ref rewriteTypeDef @@ var "replace" @@ var "typ"++substituteVariableDef :: TBinding (Name -> Name -> Term -> Term)+substituteVariableDef = define "substituteVariable" $+  doc "Substitute one variable for another in a term" $+  lambdas ["from", "to", "term"] $ lets [+    "replace">: lambdas ["recurse", "term"] $+      cases _Term (var "term")+        (Just $ var "recurse" @@ var "term") [+        _Term_variable>>: lambda "x" $+          Core.termVariable $ Logic.ifElse (Equality.equal (var "x") (var "from")) (var "to") (var "x"),+        _Term_function>>: match _Function+          (Just $ var "recurse" @@ var "term") [+          _Function_lambda>>: lambda "l" $ Logic.ifElse+            (Equality.equal (Core.lambdaParameter $ var "l") (var "from"))+            (var "term")+            (var "recurse" @@ var "term")]]] $+    ref rewriteTermDef @@ var "replace" @@ var "term"++substituteVariablesDef :: TBinding (M.Map Name Name -> Term -> Term)+substituteVariablesDef = define "substituteVariables" $+  doc "Substitute multiple variables in a term" $+  lambdas ["subst", "term"] $ lets [+    "replace">: lambdas ["recurse", "term"] $+      cases _Term (var "term")+        (Just $ var "recurse" @@ var "term") [+        _Term_variable>>: lambda "n" $+          Core.termVariable $ Optionals.fromMaybe (var "n") $ Maps.lookup (var "n") (var "subst"),+        _Term_function>>: match _Function+          (Just $ var "recurse" @@ var "term") [+          _Function_lambda>>: lambda "l" $+            Optionals.maybe+              (var "recurse" @@ var "term")+              (constant $ var "term")+              (Maps.lookup (Core.lambdaParameter $ var "l") (var "subst"))]]] $+    ref rewriteTermDef @@ var "replace" @@ var "term"++subtermsDef :: TBinding (Term -> [Term])+subtermsDef = define "subterms" $+  doc "Find the children of a given term" $+  match _Term Nothing [+    _Term_annotated>>: lambda "at" $ list [Core.annotatedTermSubject $ var "at"],+    _Term_application>>: lambda "p" $ list [+      Core.applicationFunction $ var "p",+      Core.applicationArgument $ var "p"],+    _Term_function>>: match _Function+      (Just $ list []) [+      _Function_elimination>>: match _Elimination+        (Just $ list []) [+        _Elimination_union>>: lambda "cs" $ Lists.concat2+          (Optionals.maybe (list []) (lambda "t" $ list [var "t"]) (Core.caseStatementDefault $ var "cs"))+          (Lists.map (unaryFunction Core.fieldTerm) (Core.caseStatementCases $ var "cs"))],+      _Function_lambda>>: lambda "l" $ list [Core.lambdaBody $ var "l"]],+    _Term_let>>: lambda "lt" $ Lists.cons+      (Core.letEnvironment $ var "lt")+      (Lists.map (unaryFunction Core.bindingTerm) (Core.letBindings $ var "lt")),+    _Term_list>>: lambda "l" $ var "l",+    _Term_literal>>: constant $ list [],+    _Term_map>>: lambda "m" $ Lists.concat $ Lists.map+      (lambda "p" $ list [first $ var "p", second $ var "p"])+      (Maps.toList $ var "m"),+    _Term_optional>>: lambda "m" $ Optionals.maybe (list []) (lambda "t" $ list [var "t"]) (var "m"),+    _Term_product>>: lambda "tuple" $ var "tuple",+    _Term_record>>: lambda "rt" (Lists.map (unaryFunction Core.fieldTerm) (Core.recordFields $ var "rt")),+    _Term_set>>: lambda "l" $ Sets.toList $ var "l",+    _Term_sum>>: lambda "st" $ list [Core.sumTerm $ var "st"],+    _Term_typeApplication>>: lambda "ta" $ list [Core.typedTermTerm $ var "ta"],+    _Term_typeLambda>>: lambda "ta" $ list [Core.typeLambdaBody $ var "ta"],+    _Term_union>>: lambda "ut" $ list [Core.fieldTerm $ (Core.injectionField $ var "ut")],+    _Term_unit>>: constant $ list [],+    _Term_variable>>: constant $ list [],+    _Term_wrap>>: lambda "n" $ list [Core.wrappedTermObject $ var "n"]]++subtermsWithAccessorsDef :: TBinding (Term -> [(TermAccessor, Term)])+subtermsWithAccessorsDef = define "subtermsWithAccessors" $+  doc "Find the children of a given term" $+  match _Term Nothing [+    _Term_annotated>>: lambda "at" $ single Mantle.termAccessorAnnotatedSubject $ Core.annotatedTermSubject $ var "at",+    _Term_application>>: lambda "p" $ list [+      result Mantle.termAccessorApplicationFunction $ Core.applicationFunction $ var "p",+      result Mantle.termAccessorApplicationArgument $ Core.applicationArgument $ var "p"],+    _Term_function>>: match _Function+      (Just none) [+      _Function_elimination>>: match _Elimination+        (Just none) [+        _Elimination_union>>: lambda "cs" $ Lists.concat2+          (Optionals.maybe none+            (lambda "t" $ single Mantle.termAccessorUnionCasesDefault $ var "t")+            (Core.caseStatementDefault $ var "cs"))+          (Lists.map+            (lambda "f" $ result (Mantle.termAccessorUnionCasesBranch $ Core.fieldName $ var "f") $ Core.fieldTerm $ var "f")+            (Core.caseStatementCases $ var "cs"))],+      _Function_lambda>>: lambda "l" $ single Mantle.termAccessorLambdaBody $ Core.lambdaBody $ var "l"],+    _Term_let>>: lambda "lt" $ Lists.cons+      (result Mantle.termAccessorLetEnvironment $ Core.letEnvironment $ var "lt")+      (Lists.map+        (lambda "b" $ result (Mantle.termAccessorLetBinding $ Core.bindingName $ var "b") $ Core.bindingTerm $ var "b")+        (Core.letBindings $ var "lt")),+    _Term_list>>: lambda "l" $ Lists.map+      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0+      (lambda "e" $ result (Mantle.termAccessorListElement $ int32 0) $ var "e")+      (var "l"),+    _Term_literal>>: constant none,+    _Term_map>>: lambda "m" (Lists.concat+      (Lists.map+        (lambda "p" $ list [+          -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0+          result (Mantle.termAccessorMapKey $ int32 0) $ first $ var "p",+          result (Mantle.termAccessorMapValue $ int32 0) $ second $ var "p"])+        (Maps.toList $ var "m"))),+    _Term_optional>>: lambda "m" $ Optionals.maybe none+      (lambda "t" $ single Mantle.termAccessorOptionalTerm $ var "t")+      (var "m"),+    _Term_product>>: lambda "p" $ Lists.map+      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0+      (lambda "e" $ result (Mantle.termAccessorProductTerm $ int32 0) $ var "e")+      (var "p"),+    _Term_record>>: lambda "rt" (Lists.map+      (lambda "f" $ result (Mantle.termAccessorRecordField $ Core.fieldName $ var "f") $ Core.fieldTerm $ var "f")+      (Core.recordFields $ var "rt")),+    _Term_set>>: lambda "s" $ Lists.map+      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0+      (lambda "e" $ result (Mantle.termAccessorListElement $ int32 0) $ var "e")+      (Sets.toList $ var "s"),+    _Term_sum>>: lambda "st" $+      single Mantle.termAccessorSumTerm $+      Core.sumTerm $ var "st",+    _Term_typeApplication>>: lambda "ta" $+      single Mantle.termAccessorTypeApplicationTerm $+      Core.typedTermTerm $ var "ta",+    _Term_typeLambda>>: lambda "ta" $+      single Mantle.termAccessorTypeLambdaBody $+      Core.typeLambdaBody $ var "ta",+    _Term_union>>: lambda "ut" $+      single Mantle.termAccessorInjectionTerm $+      Core.fieldTerm $ (Core.injectionField $ var "ut"),+    _Term_unit>>: constant none,+    _Term_variable>>: constant none,+    _Term_wrap>>: lambda "n" $ single Mantle.termAccessorWrappedTerm $ Core.wrappedTermObject $ var "n"]+  where+    none = list []+    single accessor term = list [result accessor term]+    result accessor term = pair accessor term+    simple term = result Mantle.termAccessorAnnotatedSubject term++subtypesDef :: TBinding (Type -> [Type])+subtypesDef = define "subtypes" $+  doc "Find the children of a given type expression" $+  match _Type Nothing [+    _Type_annotated>>: lambda "at" $ list [Core.annotatedTypeSubject $ var "at"],+    _Type_application>>: lambda "at" $ list [+      Core.applicationTypeFunction $ var "at",+      Core.applicationTypeArgument $ var "at"],+    _Type_function>>: lambda "ft" $ list [+      Core.functionTypeDomain $ var "ft",+      Core.functionTypeCodomain $ var "ft"],+    _Type_forall>>: lambda "lt" $ list [Core.forallTypeBody $ var "lt"],+    _Type_list>>: lambda "lt" $ list [var "lt"],+    _Type_literal>>: constant $ list [],+    _Type_map>>: lambda "mt" $ list [+      Core.mapTypeKeys $ var "mt",+      Core.mapTypeValues $ var "mt"],+    _Type_optional>>: lambda "ot" $ list [var "ot"],+    _Type_product>>: lambda "pt" $ var "pt",+    _Type_record>>: lambda "rt" (Lists.map (unaryFunction Core.fieldTypeType) (Core.rowTypeFields $ var "rt")),+    _Type_set>>: lambda "st" $ list [var "st"],+    _Type_sum>>: lambda "st" $ var "st",+    _Type_union>>: lambda "rt" (Lists.map (unaryFunction Core.fieldTypeType) (Core.rowTypeFields $ var "rt")),+    _Type_unit>>: constant $ list [],+    _Type_variable>>: constant $ list [],+    _Type_wrap>>: lambda "nt" $ list [Core.wrappedTypeObject $ var "nt"]]++termDependencyNamesDef :: TBinding (Bool -> Bool -> Bool -> Term -> S.Set Name)+termDependencyNamesDef = define "termDependencyNames" $+  doc "Note: does not distinguish between bound and free variables; use freeVariablesInTerm for that" $+  lambdas ["binds", "withPrims", "withNoms"] $ lets [+    "addNames">: lambdas ["names", "term"] $ lets [+      "nominal">: lambda "name" $ Logic.ifElse (var "withNoms")+        (Sets.insert (var "name") (var "names"))+        (var "names"),+      "prim">: lambda "name" $ Logic.ifElse (var "withPrims")+        (Sets.insert (var "name") (var "names"))+        (var "names"),+      "var">: lambda "name" $ Logic.ifElse (var "binds")+        (Sets.insert (var "name") (var "names"))+        (var "names")]+      $ cases _Term (var "term")+        (Just $ var "names") [+        _Term_function>>: lambda "f" $ cases _Function (var "f")+          (Just $ var "names") [+          _Function_primitive>>: lambda "name" $ var "prim" @@ var "name",+          _Function_elimination>>: lambda "e" $ cases _Elimination (var "e")+            (Just $ var "names") [+            _Elimination_record>>: lambda "proj" $ var "nominal" @@ (Core.projectionTypeName $ var "proj"),+            _Elimination_union>>: lambda "caseStmt" $ var "nominal" @@ (Core.caseStatementTypeName $ var "caseStmt"),+            _Elimination_wrap>>: lambda "name" $ var "nominal" @@ var "name"]],+        _Term_record>>: lambda "record" $ var "nominal" @@ (Core.recordTypeName $ var "record"),+        _Term_union>>: lambda "injection" $ var "nominal" @@ (Core.injectionTypeName $ var "injection"),+        _Term_variable>>: lambda "name" $ var "var" @@ var "name",+        _Term_wrap>>: lambda "wrappedTerm" $ var "nominal" @@ (Core.wrappedTermTypeName $ var "wrappedTerm")]]+    $ ref foldOverTermDef @@ Coders.traversalOrderPre @@ var "addNames" @@ Sets.empty++toShortNamesDef :: TBinding ([Name] -> M.Map Name Name)+toShortNamesDef = define "toShortNames" $+  doc "Generate short names from a list of fully qualified names" $+  lambda "original" $ lets [+    "groupNamesByLocal">: lambda "names" $ Lists.foldl (var "addName") Maps.empty (var "names"),+    "addName">: lambda "acc" $ lambda "name" $ lets [+      "local">: ref Names.localNameOfDef @@ var "name",+      "group">: Optionals.fromMaybe Sets.empty $ Maps.lookup (var "local") (var "acc")]+      $ Maps.insert (var "local") (Sets.insert (var "name") (var "group")) (var "acc"),+    "groups">: var "groupNamesByLocal" @@ var "original",+    "renameGroup">: lambda "localNames" $ lets [+      "local">: first $ var "localNames",+      "names">: second $ var "localNames",+      "rangeFrom">: lambda "start" $ Lists.cons (var "start") (var "rangeFrom" @@ (Math.add (var "start") (int32 1))),+      "rename">: lambda "name" $ lambda "i" $ pair (var "name") $ Core.name $+        Logic.ifElse (Equality.gt (var "i") (int32 1))+          (Strings.cat2 (var "local") (Literals.showInt32 $ var "i"))+          (var "local")]+      $ Lists.zipWith (var "rename") (Sets.toList $ var "names") (var "rangeFrom" @@ int32 1)]+    $ Maps.fromList $ Lists.concat $ Lists.map (var "renameGroup") $ Maps.toList $ var "groups"++topologicalSortBindingMapDef :: TBinding (M.Map Name Term -> [[(Name, Term)]])+topologicalSortBindingMapDef = define "topologicalSortBindingMap" $+  doc "Topological sort of connected components, in terms of dependencies between variable/term binding pairs" $+  lambda "bindingMap" $ lets [+    "bindings">: Maps.toList $ var "bindingMap",+    "keys">: Sets.fromList $ Lists.map (unaryFunction first) (var "bindings"),+    "hasTypeAnnotation">: lambda "term" $+      cases _Term (var "term")+        (Just false) [+        _Term_annotated>>: lambda "at" $ var "hasTypeAnnotation" @@ (Core.annotatedTermSubject $ var "at")],+    "depsOf">: lambda "nameAndTerm" $ lets [+      "name">: first $ var "nameAndTerm",+      "term">: second $ var "nameAndTerm"]+      $ pair (var "name") $ Logic.ifElse (var "hasTypeAnnotation" @@ var "term")+        (list [])+        (Sets.toList $ Sets.intersection (var "keys") $ ref freeVariablesInTermDef @@ var "term"),+    "toPair">: lambda "name" $ pair (var "name") $ Optionals.fromMaybe+      (Core.termLiteral $ Core.literalString $ string "Impossible!")+      (Maps.lookup (var "name") (var "bindingMap"))]+    $ Lists.map (unaryFunction $ Lists.map $ var "toPair") (ref Sorting.topologicalSortComponentsDef @@ Lists.map (var "depsOf") (var "bindings"))++topologicalSortBindingsDef :: TBinding ([Binding] -> Either [[Name]] [Name])+topologicalSortBindingsDef = define "topologicalSortBindings" $+  doc "Topological sort of elements based on their dependencies" $+  lambda "els" $ lets [+    "adjlist">: lambda "e" $ pair+      (Core.bindingName $ var "e")+      (Sets.toList $ ref termDependencyNamesDef @@ false @@ true @@ true @@ (Core.bindingTerm $ var "e"))]+    $ ref Sorting.topologicalSortDef @@ Lists.map (var "adjlist") (var "els")++typeDependencyNamesDef :: TBinding (Bool -> Type -> S.Set Name)+typeDependencyNamesDef = define "typeDependencyNames" $+  lambdas ["withSchema", "typ"] $+    Logic.ifElse (var "withSchema")+      (Sets.union+        (ref freeVariablesInTypeDef @@ var "typ")+        (ref typeNamesInTypeDef @@ var "typ"))+      (ref freeVariablesInTypeDef @@ var "typ")++typeNamesInTypeDef :: TBinding (Type -> S.Set Name)+typeNamesInTypeDef = define "typeNamesInType" $ lets [+  "addNames">: lambdas ["names", "typ"] $ cases _Type (var "typ")+    (Just $ var "names") [+    _Type_record>>: lambda "rowType" $ lets [+      "tname">: Core.rowTypeTypeName $ var "rowType"] $+      Sets.insert (var "tname") (var "names"),+    _Type_union>>: lambda "rowType" $ lets [+      "tname">: Core.rowTypeTypeName $ var "rowType"] $+      Sets.insert (var "tname") (var "names"),+    _Type_wrap>>: lambda "wrappedType" $ lets [+      "tname">: Core.wrappedTypeTypeName $ var "wrappedType"] $+      Sets.insert (var "tname") (var "names")]] $+  ref foldOverTypeDef @@ Coders.traversalOrderPre @@ var "addNames" @@ Sets.empty
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Schemas.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Schemas where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Constants as Constants+import qualified Hydra.Sources.Kernel.Terms.Decode.Core as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Encode.Core as EncodeCore+import qualified Hydra.Sources.Kernel.Terms.Lexical as Lexical+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads+import qualified Hydra.Sources.Kernel.Terms.Names as Names+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Sorting as Sorting+import qualified Hydra.Sources.Kernel.Terms.Variants as Variants+++module_ :: Module+module_ = Module (Namespace "hydra.schemas") elements+    [DecodeCore.module_, EncodeCore.module_, Names.module_, Rewriting.module_,+      ShowCore.module_, Sorting.module_, Variants.module_]+    kernelTypesModules $+    Just ("Various functions for dereferencing and decoding schema types.")+  where+    elements = [+      el definitionDependencyNamespacesDef,+      el dependencyNamespacesDef,+      el dereferenceTypeDef,+      el elementAsTypedTermDef,+      el elementsWithDependenciesDef,+      el extendTypeContextForLambdaDef,+      el extendTypeContextForLetDef,+      el extendTypeContextForTypeLambdaDef,+      el fieldMapDef,+      el fieldTypeMapDef,+      el findFieldTypeDef,+      el fieldTypesDef,+      el fTypeToTypeSchemeDef,+      el fullyStripTypeDef,+      el graphAsTermDef,+      el graphAsTypesDef,+      el isEnumRowTypeDef,+      el isEnumTypeDef,+      el isSerializableDef,+      el moduleDependencyNamespacesDef,+      el namespacesForDefinitionsDef,+      el requireRecordTypeDef,+      el requireRowTypeDef,+      el requireTypeDef,+      el requireUnionTypeDef,+      el resolveTypeDef,+      el schemaGraphToTypingEnvironmentDef,+      el termAsGraphDef,+      el topologicalSortTypeDefinitionsDef,+      el typeDependenciesDef,+      el typeSchemeToFTypeDef,+      el typesToElementsDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++definitionDependencyNamespacesDef :: TBinding ([Definition] -> S.Set Namespace)+definitionDependencyNamespacesDef = define "definitionDependencyNamespaces" $+  doc "Get dependency namespaces from definitions" $+  lambdas ["defs"] $ lets [+    "defNames">: lambda "def" $+      match _Definition Nothing [+        _Definition_type>>: lambda "typeDef" $+          ref Rewriting.typeDependencyNamesDef @@ true @@ Module.typeDefinitionType (var "typeDef"),+        _Definition_term>>: lambda "termDef" $+          ref Rewriting.termDependencyNamesDef @@ true @@ true @@ true @@ Module.termDefinitionTerm (var "termDef")]+      @@ var "def",+    "allNames">: Sets.unions $ Lists.map (var "defNames") (var "defs")]+    $ Sets.fromList $ Optionals.cat $ Lists.map (ref Names.namespaceOfDef) (Sets.toList $ var "allNames")++dependencyNamespacesDef :: TBinding (Bool -> Bool -> Bool -> Bool -> [Binding] -> Flow Graph (S.Set Namespace))+dependencyNamespacesDef = define "dependencyNamespaces" $+  doc "Find dependency namespaces in all of a set of terms" $+  lambdas ["binds", "withPrims", "withNoms", "withSchema", "els"] $ lets [+    "depNames">: lambda "el" $ lets [+      "term">: Core.bindingTerm $ var "el",+      "dataNames">: ref Rewriting.termDependencyNamesDef @@ var "binds" @@ var "withPrims" @@ var "withNoms" @@ var "term",+      "schemaNames">: Logic.ifElse (var "withSchema")+        (Optionals.maybe Sets.empty+          (lambda "ts" $ ref Rewriting.typeDependencyNamesDef @@ true @@ Core.typeSchemeType (var "ts"))+          (Core.bindingType $ var "el"))+        Sets.empty]+      $ Logic.ifElse (ref EncodeCore.isEncodedTypeDef @@ (ref Rewriting.deannotateTermDef @@ var "term"))+          (Flows.bind (ref DecodeCore.typeDef @@ var "term") $+            lambda "typ" $ Flows.pure $ Sets.unions $ list [+              var "dataNames", var "schemaNames",+              ref Rewriting.typeDependencyNamesDef @@ true @@ var "typ"])+          (Flows.pure $ Sets.unions $ list [var "dataNames", var "schemaNames"])]+    $ Flows.bind (Flows.mapList (var "depNames") (var "els")) $+      lambda "namesList" $ Flows.pure $ Sets.fromList $ Optionals.cat $ Lists.map (ref Names.namespaceOfDef) $+        Sets.toList $ Sets.delete (ref Constants.placeholderNameDef) $ Sets.unions $ var "namesList"++dereferenceTypeDef :: TBinding (Name -> Flow Graph (Maybe Type))+dereferenceTypeDef = define "dereferenceType" $+  doc "Dereference a type name to get the actual type" $+  "name" ~>+  "mel" <<~ ref Lexical.dereferenceElementDef @@ var "name" $+  optCases (var "mel")+    (Flows.pure nothing)+    ("el" ~> Flows.map (unaryFunction just) $ ref DecodeCore.typeDef @@ Core.bindingTerm (var "el"))++elementAsTypedTermDef :: TBinding (Binding -> Flow Graph TypedTerm)+elementAsTypedTermDef = define "elementAsTypedTerm" $+  doc "Convert an element to a typed term" $+  lambda "el" $+    Optionals.maybe (Flows.fail $ string "missing element type")+      (lambda "ts" $ Flows.pure $ Core.typedTerm (Core.bindingTerm $ var "el") (Core.typeSchemeType $ var "ts"))+      (Core.bindingType $ var "el")++elementsWithDependenciesDef :: TBinding ([Binding] -> Flow Graph [Binding])+elementsWithDependenciesDef = define "elementsWithDependencies" $+  doc "Get elements with their dependencies" $+  lambda "original" $ lets [+    "depNames">: lambda "el" $ Sets.toList $ ref Rewriting.termDependencyNamesDef @@ true @@ false @@ false @@ (Core.bindingTerm $ var "el"),+    "allDepNames">: Lists.nub $ Lists.concat2+      (Lists.map (unaryFunction Core.bindingName) (var "original"))+      (Lists.concat $ Lists.map (var "depNames") (var "original"))]+    $ Flows.mapList (ref Lexical.requireElementDef) (var "allDepNames")++extendTypeContextForLambdaDef :: TBinding (TypeContext -> Lambda -> TypeContext)+extendTypeContextForLambdaDef = define "extendTypeContextForLambda" $+  doc "Extend a type context by descending into a System F lambda body" $+  "tcontext" ~> "lam" ~>+  "var" <~ Core.lambdaParameter (var "lam") $+  "dom" <~ Optionals.fromJust (Core.lambdaDomain (var "lam")) $+  Typing.typeContextWithTypes+    (var "tcontext")+    (Maps.insert (var "var") (var "dom") (Typing.typeContextTypes (var "tcontext")))++extendTypeContextForLetDef :: TBinding (TypeContext -> Let -> TypeContext)+extendTypeContextForLetDef = define "extendTypeContextForLet" $+  doc "Extend a type context by descending into a let body" $+  "tcontext" ~> "letrec" ~>+  "bindings" <~ Core.letBindings (var "letrec") $+  Typing.typeContextWithTypes+    (var "tcontext")+    (Maps.union+      (Typing.typeContextTypes (var "tcontext"))+      (Maps.fromList $ Lists.map+        ("b" ~> pair+          (Core.bindingName $ var "b")+          (ref typeSchemeToFTypeDef @@ (Optionals.fromJust $ Core.bindingType $ var "b")))+        (var "bindings")))++extendTypeContextForTypeLambdaDef :: TBinding (TypeContext -> TypeLambda -> TypeContext)+extendTypeContextForTypeLambdaDef = define "extendTypeContextForTypeLambda" $+  doc "Extend a type context by descending into a System F type lambda body" $+  "tcontext" ~> "tlam" ~>+  "name" <~ Core.typeLambdaParameter (var "tlam") $+  Typing.typeContextWithVariables+    (var "tcontext")+    (Sets.insert (var "name") (Typing.typeContextVariables (var "tcontext")))++fieldMapDef :: TBinding ([Field] -> M.Map Name Term)+fieldMapDef = define "fieldMap" $+  "toPair" <~ ("f" ~> pair (Core.fieldName $ var "f") (Core.fieldTerm $ var "f")) $+  "fields" ~> Maps.fromList $ Lists.map (var "toPair") (var "fields")++fieldTypeMapDef :: TBinding ([FieldType] -> M.Map Name Type)+fieldTypeMapDef = define "fieldTypeMap" $+  "toPair" <~ ("f" ~> pair (Core.fieldTypeName $ var "f") (Core.fieldTypeType $ var "f")) $+  "fields" ~> Maps.fromList $ Lists.map (var "toPair") (var "fields")++fieldTypesDef :: TBinding (Type -> Flow Graph (M.Map Name Type))+fieldTypesDef = define "fieldTypes" $+  doc "Get field types from a record or union type" $+  lambda "t" $ lets [+    "toMap">: lambda "fields" $ Maps.fromList $ Lists.map+      (lambda "ft" $ pair (Core.fieldTypeName $ var "ft") (Core.fieldTypeType $ var "ft"))+      (var "fields")]+    $ match _Type (Just $ ref Monads.unexpectedDef @@ string "record or union type" @@ (ref ShowCore.typeDef @@ var "t")) [+      _Type_forall>>: lambda "ft" $ ref fieldTypesDef @@ Core.forallTypeBody (var "ft"),+      _Type_record>>: lambda "rt" $ Flows.pure $ var "toMap" @@ Core.rowTypeFields (var "rt"),+      _Type_union>>: lambda "rt" $ Flows.pure $ var "toMap" @@ Core.rowTypeFields (var "rt"),+      _Type_variable>>: lambda "name" $+        trace (Strings.cat2 (string "field types of ") (Core.unName $ var "name")) $+        Flows.bind (ref Lexical.requireElementDef @@ var "name") $+          lambda "el" $+            Flows.bind (ref DecodeCore.typeDef @@ Core.bindingTerm (var "el")) $+              ref fieldTypesDef]+    @@ (ref Rewriting.deannotateTypeDef @@ var "t")++findFieldTypeDef :: TBinding (Name -> [FieldType] -> Flow s Type)+findFieldTypeDef = define "findFieldType" $+  doc "Find a field type by name in a list of field types" $+  lambda "fname" $ lambda "fields" $ lets [+    "matchingFields">: Lists.filter+      (lambda "ft" $ Equality.equal (Core.unName $ Core.fieldTypeName $ var "ft") (Core.unName $ var "fname"))+      (var "fields")]+    $ Logic.ifElse (Lists.null $ var "matchingFields")+        (Flows.fail $ Strings.cat2 (string "No such field: ") (Core.unName $ var "fname"))+        (Logic.ifElse (Equality.equal (Lists.length $ var "matchingFields") (int32 1))+          (Flows.pure $ Core.fieldTypeType $ Lists.head $ var "matchingFields")+          (Flows.fail $ Strings.cat2 (string "Multiple fields named ") (Core.unName $ var "fname")))++fTypeToTypeSchemeDef :: TBinding (Type -> TypeScheme)+fTypeToTypeSchemeDef = define "fTypeToTypeScheme" $+  doc "Convert a forall type to a type scheme" $+  "gatherForall" <~ ("vars" ~> "typ" ~> cases _Type (ref Rewriting.deannotateTypeDef @@ var "typ")+     (Just $ Core.typeScheme (Lists.reverse $ var "vars") (var "typ")) [+     _Type_forall>>: "ft" ~> var "gatherForall" @@+       (Lists.cons (Core.forallTypeParameter $ var "ft") (var "vars")) @@+       (Core.forallTypeBody $ var "ft")]) $+  "typ" ~> var "gatherForall" @@ list [] @@ var "typ"++fullyStripTypeDef :: TBinding (Type -> Type)+fullyStripTypeDef = define "fullyStripType" $+  doc "Fully strip a type of forall quantifiers" $+  lambda "typ" $+    match _Type (Just $ var "typ") [+      _Type_forall>>: lambda "ft" $ ref fullyStripTypeDef @@ Core.forallTypeBody (var "ft")]+    @@ (ref Rewriting.deannotateTypeDef @@ var "typ")++graphAsTermDef :: TBinding (Graph -> Term)+graphAsTermDef = define "graphAsTerm" $+  doc "Convert a graph to a term, taking advantage of the built-in duality between graphs and terms" $+  "g" ~>+  "toBinding" <~ ("el" ~>+    "name" <~ Core.bindingName (var "el") $+    "term" <~ Core.bindingTerm (var "el") $+    "mts" <~ Core.bindingType (var "el") $+    Core.binding (var "name") (var "term") (var "mts")) $+  Core.termLet $ Core.let_+    (Lists.map (var "toBinding") (Maps.elems $ Graph.graphElements (var "g")))+    (Graph.graphBody (var "g"))++graphAsTypesDef :: TBinding (Graph -> Flow s (M.Map Name Type))+graphAsTypesDef = define "graphAsTypes" $+  doc "Decode a schema graph which encodes a set of named types" $+  "sg" ~>+  "els" <~ Maps.elems (Graph.graphElements (var "sg")) $+  "toPair" <~ ("el" ~>+    "typ" <<~ ref DecodeCore.typeDef @@ (Core.bindingTerm $ var "el") $+    produce $ pair (Core.bindingName $ var "el") (var "typ")) $+  "pairs" <<~ Flows.mapList (var "toPair") (var "els") $+  produce $ Maps.fromList $ var "pairs"++isEnumRowTypeDef :: TBinding (RowType -> Bool)+isEnumRowTypeDef = define "isEnumRowType" $+  doc "Check if a row type represents an enum (all fields are unit-typed)" $+  lambda "rt" $ Lists.foldl (binaryFunction Logic.and) true $+    Lists.map (lambda "f" $ ref EncodeCore.isUnitTypeDef @@ (Core.fieldTypeType $ var "f")) $+      Core.rowTypeFields $ var "rt"++isEnumTypeDef :: TBinding (Type -> Bool)+isEnumTypeDef = define "isEnumType" $+  doc "Check if a type is an enum type" $+  lambda "typ" $+    match _Type (Just false) [+      _Type_union>>: lambda "rt" $ ref isEnumRowTypeDef @@ var "rt"]+    @@ (ref Rewriting.deannotateTypeDef @@ var "typ")++isSerializableDef :: TBinding (Binding -> Flow Graph Bool)+isSerializableDef = define "isSerializable" $+  doc "Check if an element is serializable (no function types in dependencies)" $+  lambda "el" $ lets [+    "variants">: lambda "typ" $+      Lists.map (ref Variants.typeVariantDef) $ ref Rewriting.foldOverTypeDef @@ Coders.traversalOrderPre @@+        (lambda "m" $ lambda "t" $ Lists.cons (var "t") (var "m")) @@ list [] @@ var "typ"]+    $ Flows.map+      (lambda "deps" $ lets [+        "allVariants">: Sets.fromList $ Lists.concat $ Lists.map (var "variants") $ Maps.elems $ var "deps"]+        $ Logic.not $ Sets.member Mantle.typeVariantFunction $ var "allVariants")+      (ref typeDependenciesDef @@ false @@ (unaryFunction Equality.identity) @@ Core.bindingName (var "el"))++moduleDependencyNamespacesDef :: TBinding (Bool -> Bool -> Bool -> Bool -> Module -> Flow Graph (S.Set Namespace))+moduleDependencyNamespacesDef = define "moduleDependencyNamespaces" $+  doc "Find dependency namespaces in all elements of a module, excluding the module's own namespace" $+  lambdas ["binds", "withPrims", "withNoms", "withSchema", "mod"] $+    Flows.bind (ref dependencyNamespacesDef @@ var "binds" @@ var "withPrims" @@ var "withNoms" @@ var "withSchema" @@+      Module.moduleElements (var "mod")) $+      lambda "deps" $ Flows.pure $ Sets.delete (Module.moduleNamespace $ var "mod") (var "deps")++namespacesForDefinitionsDef :: TBinding ((Namespace -> a) -> Namespace -> [Definition] -> Namespaces a)+namespacesForDefinitionsDef = define "namespacesForDefinitions" $+  doc "Create namespaces mapping for definitions" $+  lambdas ["encodeNamespace", "focusNs", "defs"] $ lets [+    "nss">: Sets.delete (var "focusNs") $ ref definitionDependencyNamespacesDef @@ var "defs",+    "toPair">: lambda "ns" $ pair (var "ns") (var "encodeNamespace" @@ var "ns")]+    $ Module.namespaces (var "toPair" @@ var "focusNs") $ Maps.fromList $ Lists.map (var "toPair") $ Sets.toList $ var "nss"++requireRecordTypeDef :: TBinding (Name -> Flow Graph RowType)+requireRecordTypeDef = define "requireRecordType" $+  doc "Require a name to resolve to a record type" $+  ref requireRowTypeDef @@ string "record type" @@+    (lambda "t" $+      cases _Type (var "t") (Just nothing) [+        _Type_record>>: lambda "rt" $ just $ var "rt"])++requireRowTypeDef :: TBinding (String -> (Type -> Maybe RowType) -> Name -> Flow Graph RowType)+requireRowTypeDef = define "requireRowType" $+  doc "Require a name to resolve to a row type" $+  lambdas ["label", "getter", "name"] $ lets [+    "rawType">: lambda "t" $ cases _Type (var "t") (Just $ var "t") [+      _Type_annotated>>: lambda "at" $ var "rawType" @@ Core.annotatedTypeSubject (var "at"),+      _Type_forall>>: lambda "ft" $ var "rawType" @@ Core.forallTypeBody (var "ft")]]+    $ Flows.bind (ref requireTypeDef @@ var "name") $+      lambda "t" $+        Optionals.maybe+          (Flows.fail $ Strings.cat $ list [+            Core.unName $ var "name",+            string " does not resolve to a ",+            var "label",+            string " type: ",+            ref ShowCore.typeDef @@ var "t"])+          (unaryFunction Flows.pure)+          (var "getter" @@ (var "rawType" @@ var "t"))++requireTypeDef :: TBinding (Name -> Flow Graph Type)+requireTypeDef = define "requireType" $+  doc "Require a type by name" $+  lambda "name" $+  trace (Strings.cat2 (string "require type ") (Core.unName $ var "name")) $+  Flows.bind (ref Lexical.withSchemaContextDef @@ (ref Lexical.requireElementDef @@ var "name")) $+    lambda "el" $ ref DecodeCore.typeDef @@ Core.bindingTerm (var "el")++requireUnionTypeDef :: TBinding (Name -> Flow Graph RowType)+requireUnionTypeDef = define "requireUnionType" $+  doc "Require a name to resolve to a union type" $+  ref requireRowTypeDef @@ string "union" @@+    (lambda "t" $+      match _Type (Just nothing) [+        _Type_union>>: lambda "rt" $ just $ var "rt"]+      @@ var "t")++resolveTypeDef :: TBinding (Type -> Flow Graph (Maybe Type))+resolveTypeDef = define "resolveType" $+  doc "Resolve a type, dereferencing type variables" $+  lambda "typ" $+    match _Type (Just $ Flows.pure $ just $ var "typ") [+      _Type_variable>>: lambda "name" $+        ref Lexical.withSchemaContextDef @@+          (Flows.bind (ref Lexical.resolveTermDef @@ var "name") $+            lambda "mterm" $+              Optionals.maybe (Flows.pure nothing)+                (lambda "t" $ Flows.map (unaryFunction just) $ ref DecodeCore.typeDef @@ var "t")+                (var "mterm"))]+    @@ (ref Rewriting.deannotateTypeDef @@ var "typ")++schemaGraphToTypingEnvironmentDef :: TBinding (Graph -> Flow s (M.Map Name TypeScheme))+schemaGraphToTypingEnvironmentDef = define "schemaGraphToTypingEnvironment" $+  doc "Convert a schema graph to a typing environment" $+  "g" ~>+  "toTypeScheme" <~ ("vars" ~> "typ" ~> cases _Type (ref Rewriting.deannotateTypeDef @@ var "typ")+    (Just $ Core.typeScheme (Lists.reverse $ var "vars") (var "typ")) [+    _Type_forall>>: "ft" ~> var "toTypeScheme"+      @@ Lists.cons (Core.forallTypeParameter $ var "ft") (var "vars")+      @@ Core.forallTypeBody (var "ft")]) $+  "toPair" <~ ("el" ~> Flows.map+    ("mts" ~> Optionals.map ("ts" ~> pair (Core.bindingName $ var "el") (var "ts")) (var "mts"))+    (optCases (Core.bindingType $ var "el")+--      (Flows.pure nothing)+      ( "typ" <<~ ref DecodeCore.typeDef @@ (Core.bindingTerm $ var "el") $+        "ts" <~ ref fTypeToTypeSchemeDef @@ var "typ" $+        produce $ just $ var "ts")+      -- TODO: the following is a legacy solution; type schemes are encoded as types now, and do not need System F annotations+      ("ts" ~> Logic.ifElse+          (Equality.equal (var "ts") (Core.typeScheme (list []) (Core.typeVariable $ Core.nameLift _TypeScheme)))+          (Flows.map (unaryFunction just) $ ref DecodeCore.typeSchemeDef @@ Core.bindingTerm (var "el"))+          (Logic.ifElse+            (Equality.equal (var "ts") (Core.typeScheme (list []) (Core.typeVariable $ Core.nameLift _Type)))+            (Flows.map (lambda "decoded" $ just $ var "toTypeScheme" @@ list [] @@ var "decoded") $ ref DecodeCore.typeDef @@ Core.bindingTerm (var "el"))+            (cases _Term (ref Rewriting.deannotateTermDef @@ (Core.bindingTerm $ var "el")) (Just $ Flows.pure nothing) [+              _Term_record>>: lambda "r" $+                Logic.ifElse+                  (Equality.equal (Core.recordTypeName $ var "r") (Core.nameLift _TypeScheme))+                  (Flows.map+                    (unaryFunction just)+                    (ref DecodeCore.typeSchemeDef @@ Core.bindingTerm (var "el")))+                  (Flows.pure nothing),+              _Term_union>>: lambda "i" $+                Logic.ifElse (Equality.equal (Core.injectionTypeName $ var "i") (Core.nameLift _Type))+                  (Flows.map+                    (lambda "decoded" $ just $ var "toTypeScheme" @@ list [] @@ var "decoded")+                    (ref DecodeCore.typeDef @@ Core.bindingTerm (var "el")))+                  (Flows.pure nothing)]))))) $+  ref Monads.withStateDef @@ var "g" @@+    (Flows.bind (Flows.mapList (var "toPair") $ Maps.elems $ Graph.graphElements $ var "g") $+      lambda "mpairs" $ Flows.pure $ Maps.fromList $ Optionals.cat $ var "mpairs")++-- Note: this is lossy, as it throws away the term body+termAsGraphDef :: TBinding (Term -> (M.Map Name Term, Term))+termAsGraphDef = define "termAsGraph" $+  doc "Find the equivalent graph representation of a term" $+  "term" ~> cases _Term (ref Rewriting.deannotateTermDef @@ var "term")+    (Just Maps.empty) [+    _Term_let>>: "lt" ~>+      "bindings" <~ Core.letBindings (var "lt") $+      "fromBinding" <~ ("b" ~>+        "name" <~ Core.bindingName (var "b") $+        "term" <~ Core.bindingTerm (var "b") $+        "ts" <~ Core.bindingType (var "b") $+        pair (var "name") (Core.binding (var "name") (var "term") (var "ts"))) $+      Maps.fromList $ Lists.map (var "fromBinding") (var "bindings")]++topologicalSortTypeDefinitionsDef :: TBinding ([TypeDefinition] -> [[TypeDefinition]])+topologicalSortTypeDefinitionsDef = define "topologicalSortTypeDefinitions" $+  doc "Topologically sort type definitions by dependencies" $+  lambda "defs" $ lets [+    "toPair">: lambda "def" $ pair+      (Module.typeDefinitionName $ var "def")+      (Sets.toList $ ref Rewriting.typeDependencyNamesDef @@ false @@ Module.typeDefinitionType (var "def")),+    "nameToDef">: Maps.fromList $ Lists.map+      (lambda "d" $ pair (Module.typeDefinitionName $ var "d") (var "d"))+      (var "defs"),+    "sorted">: ref Sorting.topologicalSortComponentsDef @@ Lists.map (var "toPair") (var "defs")]+    $ Lists.map (lambda "names" $ Optionals.cat $ Lists.map (lambda "n" $ Maps.lookup (var "n") (var "nameToDef")) (var "names")) $+      var "sorted"++typeDependenciesDef :: TBinding (Bool -> (Type -> Type) -> Name -> Flow Graph (M.Map Name Type))+typeDependenciesDef = define "typeDependencies" $+  doc "Get all type dependencies for a given type name" $+  lambdas ["withSchema", "transform", "name"] $ lets [+  "requireType">: lambda "name" $+    trace (Strings.cat2 (string "type dependencies of ") (Core.unName $ var "name")) $+    Flows.bind (ref Lexical.requireElementDef @@ var "name") $+      lambda "el" $ ref DecodeCore.typeDef @@ Core.bindingTerm (var "el"),+  "toPair">: lambda "name" $+    Flows.bind (var "requireType" @@ var "name") $+      lambda "typ" $ Flows.pure $ pair (var "name") (var "transform" @@ var "typ"),+  "deps">: lambda "seeds" $ lambda "names" $+    Logic.ifElse (Sets.null $ var "seeds")+      (Flows.pure $ var "names")+      (Flows.bind (Flows.mapList (var "toPair") $ Sets.toList $ var "seeds") $+        lambda "pairs" $ lets [+          "newNames">: Maps.union (var "names") $ Maps.fromList $ var "pairs",+          "refs">: Lists.foldl (binaryFunction Sets.union) Sets.empty $ Lists.map+            (lambda "pair" $ ref Rewriting.typeDependencyNamesDef @@ var "withSchema" @@ second (var "pair"))+            (var "pairs"),+          "visited">: Sets.fromList $ Maps.keys $ var "names",+          "newSeeds">: Sets.difference (var "refs") (var "visited")]+          $ var "deps" @@ var "newSeeds" @@ var "newNames")] $+    var "deps" @@ Sets.singleton (var "name") @@ Maps.empty++typeSchemeToFTypeDef :: TBinding (TypeScheme -> Type)+typeSchemeToFTypeDef = define "typeSchemeToFType" $+  doc "Convert a type scheme to a forall type" $+  "ts" ~>+  "vars" <~ Core.typeSchemeVariables (var "ts") $+  "body" <~ Core.typeSchemeType (var "ts") $+  Lists.foldl+    ("t" ~> "v" ~> Core.typeForall $ Core.forallType (var "v") (var "t"))+    (var "body")+    -- Put the variables in the same order in which they are introduced by the type scheme.+    (Lists.reverse $ var "vars")++typesToElementsDef :: TBinding (M.Map Name Type -> M.Map Name Binding)+typesToElementsDef = define "typesToElements" $+  doc "Encode a map of named types to a map of elements" $+  "typeMap" ~>+  "toElement" <~ ("pair" ~>+    "name" <~ first (var "pair") $+    pair+      (var "name")+      (Core.binding+        (var "name")+        (ref EncodeCore.typeDef @@ (second $ var "pair"))+        nothing)) $+  Maps.fromList $ Lists.map (var "toElement") $ Maps.toList $ var "typeMap"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Serialization.hs view
@@ -0,0 +1,585 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Serialization where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import Hydra.Ast+++module_ :: Module+module_ = Module (Namespace "hydra.serialization") elements+    []+    kernelTypesModules $+    Just ("Utilities for constructing generic program code ASTs, used for the serialization phase of source code generation.")+  where+   elements = [+     el angleBracesDef,+     el angleBracesListDef,+     el bracesListAdaptiveDef,+     el bracketListDef,+     el bracketListAdaptiveDef,+     el bracketsDef,+     el commaSepDef,+     el curlyBlockDef,+     el curlyBracesDef,+     el curlyBracesListDef,+     el cstDef,+     el customIndentDef,+     el customIndentBlockDef,+     el dotSepDef,+     el doubleNewlineSepDef,+     el doubleSpaceDef,+     el expressionLengthDef,+     el fullBlockStyleDef,+     el halfBlockStyleDef,+     el ifxDef,+     el indentDef,+     el indentBlockDef,+     el indentSubsequentLinesDef,+     el infixWsDef,+     el infixWsListDef,+     el inlineStyleDef,+     el newlineSepDef,+     el noPaddingDef,+     el noSepDef,+     el numDef,+     el opDef,+     el orOpDef,+     el orSepDef,+     el parenListDef,+     el parensDef,+     el parenthesesDef,+     el parenthesizeDef,+     el prefixDef,+     el printExprDef,+     el semicolonSepDef,+     el sepDef,+     el spaceSepDef,+     el squareBracketsDef,+     el symDef,+     el symbolSepDef,+     el tabIndentDef,+     el tabIndentDoubleSpaceDef,+     el tabIndentSingleSpaceDef,+     el unsupportedTypeDef,+     el unsupportedVariantDef,+     el withCommaDef,+     el withSemiDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++angleBracesDef :: TBinding Brackets+angleBracesDef = define "angleBraces" $+  Ast.brackets (ref symDef @@ string "<") (ref symDef @@ string ">")++angleBracesListDef :: TBinding (BlockStyle -> [Expr] -> Expr)+angleBracesListDef = define "angleBracesList" $+  lambdas ["style", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "<>")+      (ref bracketsDef @@ ref angleBracesDef @@ var "style" @@ (ref commaSepDef @@ var "style" @@ var "els"))++bracesListAdaptiveDef :: TBinding ([Expr] -> Expr)+bracesListAdaptiveDef = define "bracesListAdaptive" $+  doc "Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression." $+  lambda "els" $ lets [+    "inlineList">: ref curlyBracesListDef @@ nothing @@ ref inlineStyleDef @@ var "els"]+    $ Logic.ifElse (Equality.gt (ref expressionLengthDef @@ var "inlineList") (int32 70))+      (ref curlyBracesListDef @@ nothing @@ ref halfBlockStyleDef @@ var "els")+      (var "inlineList")++bracketListAdaptiveDef :: TBinding ([Expr] -> Expr)+bracketListAdaptiveDef = define "bracketListAdaptive" $+  doc "Produce a bracketed list which separates elements by spaces or newlines depending on the estimated width of the expression." $+  lambda "els" $ lets [+    "inlineList">: ref bracketListDef @@ ref inlineStyleDef @@ var "els"]+    $ Logic.ifElse (Equality.gt (ref expressionLengthDef @@ var "inlineList") (int32 70))+      (ref bracketListDef @@ ref halfBlockStyleDef @@ var "els")+      (var "inlineList")++bracketListDef :: TBinding (BlockStyle -> [Expr] -> Expr)+bracketListDef = define "bracketList" $+  lambdas ["style", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "[]")+      (ref bracketsDef @@ ref squareBracketsDef @@ var "style" @@ (ref commaSepDef @@ var "style" @@ var "els"))++bracketsDef :: TBinding (Brackets -> BlockStyle -> Expr -> Expr)+bracketsDef = define "brackets" $+  lambdas ["br", "style", "e"] $+    Ast.exprBrackets $ Ast.bracketExpr (var "br") (var "e") (var "style")++commaSepDef :: TBinding (BlockStyle -> [Expr] -> Expr)+commaSepDef = define "commaSep" $+  ref symbolSepDef @@ string ","++cstDef :: TBinding (String -> Expr)+cstDef = define "cst" $+  lambda "s" $ Ast.exprConst $ ref symDef @@ var "s"++curlyBlockDef :: TBinding (BlockStyle -> Expr -> Expr)+curlyBlockDef = define "curlyBlock" $+  lambdas ["style", "e"] $+    ref curlyBracesListDef @@ nothing @@ var "style" @@ (list [var "e"])++curlyBracesDef :: TBinding Brackets+curlyBracesDef = define "curlyBraces" $+  Ast.brackets (ref symDef @@ string "{") (ref symDef @@ string "}")++curlyBracesListDef :: TBinding (Maybe String -> BlockStyle -> [Expr] -> Expr)+curlyBracesListDef = define "curlyBracesList" $+  lambdas ["msymb", "style", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "{}")+      (ref bracketsDef @@ ref curlyBracesDef @@ var "style" @@+        (ref symbolSepDef @@ (Optionals.fromMaybe (string ",") (var "msymb")) @@ var "style" @@ var "els"))++customIndentBlockDef :: TBinding (String -> [Expr] -> Expr)+customIndentBlockDef = define "customIndentBlock" $+  lambdas ["idt", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "")+      (Logic.ifElse (Equality.equal (Lists.length $ var "els") (int32 1))+        (Lists.head $ var "els")+        (lets [+          "head">: Lists.head $ var "els",+          "rest">: Lists.tail $ var "els",+          "idtOp">: Ast.op+            (ref symDef @@ string "")+            (Ast.padding Ast.wsSpace (Ast.wsBreakAndIndent $ var "idt"))+            (Ast.precedence $ int32 0)+            Ast.associativityNone]+          $ ref ifxDef @@ var "idtOp" @@ var "head" @@ (ref newlineSepDef @@ var "rest")))++customIndentDef :: TBinding (String -> String -> String)+customIndentDef = define "customIndent" $+  lambdas ["idt", "s"] $ Strings.cat $+    Lists.intersperse (string "\n") $ Lists.map (lambda "line" $ var "idt" ++ var "line") $ Strings.lines $ var "s"++dotSepDef :: TBinding ([Expr] -> Expr)+dotSepDef = define "dotSep" $+  ref sepDef @@ (Ast.op+    (ref symDef @@ string ".")+    (Ast.padding Ast.wsNone Ast.wsNone)+    (Ast.precedence $ int32 0)+    Ast.associativityNone)++doubleNewlineSepDef :: TBinding ([Expr] -> Expr)+doubleNewlineSepDef = define "doubleNewlineSep" $+  ref sepDef @@ (Ast.op+    (ref symDef @@ string "")+    (Ast.padding Ast.wsBreak Ast.wsBreak)+    (Ast.precedence $ int32 0)+    Ast.associativityNone)++doubleSpaceDef :: TBinding String+doubleSpaceDef = define "doubleSpace" $+  string "  "++expressionLengthDef :: TBinding (Expr -> Int)+expressionLengthDef = define "expressionLength" $+  doc "Find the approximate length (number of characters, including spaces and newlines) of an expression without actually printing it." $+  lambda "e" $ lets [+    "symbolLength">: lambda "s" $ Strings.length $ Ast.unSymbol $ var "s",+    "wsLength">: lambda "ws" $ cases _Ws (var "ws") Nothing [+      _Ws_none>>: constant $ int32 0,+      _Ws_space>>: constant $ int32 1,+      _Ws_break>>: constant $ int32 1,+      _Ws_breakAndIndent>>: lambda "s" $ Math.add (int32 1) (Strings.length $ var "s"),+      _Ws_doubleBreak>>: constant $ int32 2],+    "blockStyleLength">: lambda "style" $ lets [+      "mindentLen">: Optionals.maybe (int32 0) (unaryFunction Strings.length) (Ast.blockStyleIndent $ var "style"),+      "nlBeforeLen">: Logic.ifElse (Ast.blockStyleNewlineBeforeContent $ var "style") (int32 1) (int32 0),+      "nlAfterLen">: Logic.ifElse (Ast.blockStyleNewlineAfterContent $ var "style") (int32 1) (int32 0)]+      $ Math.add (var "mindentLen") $ Math.add (var "nlBeforeLen") (var "nlAfterLen"),+    "bracketsLength">: lambda "brackets" $+      Math.add+        (var "symbolLength" @@ (Ast.bracketsOpen $ var "brackets"))+        (var "symbolLength" @@ (Ast.bracketsClose $ var "brackets")),+    "bracketExprLength">: lambda "be" $+      Math.add+        (var "bracketsLength" @@ (Ast.bracketExprBrackets $ var "be"))+        (Math.add+          (ref expressionLengthDef @@ (Ast.bracketExprEnclosed $ var "be"))+          (var "blockStyleLength" @@ (Ast.bracketExprStyle $ var "be"))),+    "indentedExpressionLength">: lambda "ie" $ lets [+      "baseLen">: ref expressionLengthDef @@ (Ast.indentedExpressionExpr $ var "ie"),+      "indentLen">: cases _IndentStyle (Ast.indentedExpressionStyle $ var "ie") Nothing [+        _IndentStyle_allLines>>: lambda "s" $ Strings.length $ var "s",+        _IndentStyle_subsequentLines>>: lambda "s" $ Strings.length $ var "s"]]+      $ Math.add (var "baseLen") (var "indentLen"),+    "opLength">: lambda "op" $ lets [+      "symLen">: var "symbolLength" @@ (Ast.opSymbol $ var "op"),+      "padding">: Ast.opPadding $ var "op",+      "leftLen">: var "wsLength" @@ (Ast.paddingLeft $ var "padding"),+      "rightLen">: var "wsLength" @@ (Ast.paddingRight $ var "padding")]+      $ Math.add (var "symLen") $ Math.add (var "leftLen") (var "rightLen"),+    "opExprLength">: lambda "oe" $ lets [+      "opLen">: var "opLength" @@ (Ast.opExprOp $ var "oe"),+      "leftLen">: ref expressionLengthDef @@ (Ast.opExprLhs $ var "oe"),+      "rightLen">: ref expressionLengthDef @@ (Ast.opExprRhs $ var "oe")]+      $ Math.add (var "opLen") $ Math.add (var "leftLen") (var "rightLen")]+    $ cases _Expr (var "e") Nothing [+      _Expr_const>>: lambda "s" $ var "symbolLength" @@ var "s",+      _Expr_indent>>: lambda "ie" $ var "indentedExpressionLength" @@ var "ie",+      _Expr_op>>: lambda "oe" $ var "opExprLength" @@ var "oe",+      _Expr_brackets>>: lambda "be" $ var "bracketExprLength" @@ var "be"]++fullBlockStyleDef :: TBinding BlockStyle+fullBlockStyleDef = define "fullBlockStyle" $+  Ast.blockStyle (just $ ref doubleSpaceDef) true true++halfBlockStyleDef :: TBinding BlockStyle+halfBlockStyleDef = define "halfBlockStyle" $+  Ast.blockStyle (just $ ref doubleSpaceDef) true false++ifxDef :: TBinding (Op -> Expr -> Expr -> Expr)+ifxDef = define "ifx" $+  lambdas ["op", "lhs", "rhs"] $+    Ast.exprOp $ Ast.opExpr (var "op") (var "lhs") (var "rhs")++indentBlockDef :: TBinding ([Expr] -> Expr)+indentBlockDef = define "indentBlock" $+  ref customIndentBlockDef @@ ref doubleSpaceDef++indentDef :: TBinding (String -> String)+indentDef = define "indent" $+  ref customIndentDef @@ ref doubleSpaceDef++indentSubsequentLinesDef :: TBinding (String -> Expr -> Expr)+indentSubsequentLinesDef = define "indentSubsequentLines" $+  lambdas ["idt", "e"] $+    Ast.exprIndent $ Ast.indentedExpression (Ast.indentStyleSubsequentLines $ var "idt") (var "e")++infixWsDef :: TBinding (String -> Expr -> Expr -> Expr)+infixWsDef = define "infixWs" $+  lambdas ["op", "l", "r"] $+    ref spaceSepDef @@ list [var "l", ref cstDef @@ var "op", var "r"]++infixWsListDef :: TBinding (String -> [Expr] -> Expr)+infixWsListDef = define "infixWsList" $+  lambdas ["op", "opers"] $ lets [+    "opExpr">: ref cstDef @@ var "op",+    "foldFun">: lambdas ["e", "r"] $+      Logic.ifElse (Lists.null $ var "e")+        (list [var "r"])+        (Lists.cons (var "r") $ Lists.cons (var "opExpr") (var "e"))]+    $ ref spaceSepDef @@ (Lists.foldl (var "foldFun") (list []) $ Lists.reverse $ var "opers")++inlineStyleDef :: TBinding BlockStyle+inlineStyleDef = define "inlineStyle" $+  Ast.blockStyle nothing false false++newlineSepDef :: TBinding ([Expr] -> Expr)+newlineSepDef = define "newlineSep" $+  ref sepDef @@ (Ast.op+    (ref symDef @@ string "")+    (Ast.padding Ast.wsNone Ast.wsBreak)+    (Ast.precedence $ int32 0)+    Ast.associativityNone)++noPaddingDef :: TBinding Padding+noPaddingDef = define "noPadding" $+  Ast.padding Ast.wsNone Ast.wsNone++noSepDef :: TBinding ([Expr] -> Expr)+noSepDef = define "noSep" $+  ref sepDef @@ (Ast.op+    (ref symDef @@ string "")+    (Ast.padding Ast.wsNone Ast.wsNone)+    (Ast.precedence $ int32 0)+    Ast.associativityNone)++numDef :: TBinding (Int -> Expr)+numDef = define "num" $+  lambda "i" $ ref cstDef @@ (Literals.showInt32 $ var "i")++opDef :: TBinding (String -> Int -> Associativity -> Op)+opDef = define "op" $+  lambdas ["s", "p", "assoc"] $+    Ast.op+      (ref symDef @@ var "s")+      (Ast.padding Ast.wsSpace Ast.wsSpace)+      (Ast.precedence $ var "p")+      (var "assoc")++orOpDef :: TBinding (Bool -> Op)+orOpDef = define "orOp" $+  lambda "newlines" $+    Ast.op+      (ref symDef @@ string "|")+      (Ast.padding Ast.wsSpace (Logic.ifElse (var "newlines") Ast.wsBreak Ast.wsSpace))+      (Ast.precedence $ int32 0)+      Ast.associativityNone++orSepDef :: TBinding (BlockStyle -> [Expr] -> Expr)+orSepDef = define "orSep" $+  lambdas ["style", "l"] $+    Logic.ifElse (Lists.null $ var "l")+      (ref cstDef @@ string "")+      (Logic.ifElse (Equality.equal (Lists.length $ var "l") (int32 1))+        (Lists.head $ var "l")+        (lets [+          "h">: Lists.head $ var "l",+          "r">: Lists.tail $ var "l",+          "newlines">: Ast.blockStyleNewlineBeforeContent $ var "style"]+          $ ref ifxDef @@ (ref orOpDef @@ var "newlines") @@ var "h" @@ (ref orSepDef @@ var "style" @@ var "r")))++parenListDef :: TBinding (Bool -> [Expr] -> Expr)+parenListDef = define "parenList" $+  lambdas ["newlines", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "()")+      (lets [+        "style">: Logic.ifElse (Logic.and (var "newlines") (Equality.gt (Lists.length $ var "els") (int32 1)))+          (ref halfBlockStyleDef)+          (ref inlineStyleDef)]+        $ ref bracketsDef @@ ref parenthesesDef @@ var "style" @@ (ref commaSepDef @@ var "style" @@ var "els"))++parensDef :: TBinding (Expr -> Expr)+parensDef = define "parens" $+  ref bracketsDef @@ ref parenthesesDef @@ ref inlineStyleDef++parenthesesDef :: TBinding Brackets+parenthesesDef = define "parentheses" $+  Ast.brackets (ref symDef @@ string "(") (ref symDef @@ string ")")++parenthesizeDef :: TBinding (Expr -> Expr)+parenthesizeDef = define "parenthesize" $+  lambda "exp" $ lets [+    "assocLeft">: lambda "a" $ cases _Associativity (var "a") (Just true) [+      _Associativity_right>>: constant false],+    "assocRight">: lambda "a" $ cases _Associativity (var "a") (Just true) [+      _Associativity_left>>: constant false]]+    $ cases _Expr (var "exp") Nothing [+      _Expr_brackets>>: lambda "bracketExpr" $+        Ast.exprBrackets $ Ast.bracketExpr+          (Ast.bracketExprBrackets $ var "bracketExpr")+          (ref parenthesizeDef @@ (Ast.bracketExprEnclosed $ var "bracketExpr"))+          (Ast.bracketExprStyle $ var "bracketExpr"),+      _Expr_const>>: lambda "ignored" $ var "exp",+      _Expr_indent>>: lambda "indentExpr" $+        Ast.exprIndent $ Ast.indentedExpression+          (Ast.indentedExpressionStyle $ var "indentExpr")+          (ref parenthesizeDef @@ (Ast.indentedExpressionExpr $ var "indentExpr")),+      _Expr_op>>: lambda "opExpr" $ lets [+        "op">: Ast.opExprOp $ var "opExpr",+        "prec">: Ast.unPrecedence $ Ast.opPrecedence $ var "op",+        "assoc">: Ast.opAssociativity $ var "op",+        "lhs">: Ast.opExprLhs $ var "opExpr",+        "rhs">: Ast.opExprRhs $ var "opExpr",+        "lhs'">: ref parenthesizeDef @@ var "lhs",+        "rhs'">: ref parenthesizeDef @@ var "rhs",+        "lhs2">: cases _Expr (var "lhs'") (Just $ var "lhs'") [+          _Expr_op>>: lambda "lopExpr" $ lets [+            "lop">: Ast.opExprOp $ var "lopExpr",+            "lprec">: Ast.unPrecedence $ Ast.opPrecedence $ var "lop",+            "lassoc">: Ast.opAssociativity $ var "lop",+            "comparison">: Equality.compare (var "prec") (var "lprec")]+            $ cases _Comparison (var "comparison") Nothing [+              _Comparison_lessThan>>: constant $ var "lhs'",+              _Comparison_greaterThan>>: constant (ref parensDef @@ var "lhs'"),+              _Comparison_equalTo>>: constant $ Logic.ifElse+                (Logic.and (var "assocLeft" @@ var "assoc") (var "assocLeft" @@ var "lassoc"))+                (var "lhs'")+                (ref parensDef @@ var "lhs'")]],+        "rhs2">: cases _Expr (var "rhs'") (Just $ var "rhs'") [+          _Expr_op>>: lambda "ropExpr" $ lets [+            "rop">: Ast.opExprOp $ var "ropExpr",+            "rprec">: Ast.unPrecedence $ Ast.opPrecedence $ var "rop",+            "rassoc">: Ast.opAssociativity $ var "rop",+            "comparison">: Equality.compare (var "prec") (var "rprec")]+            $ cases _Comparison (var "comparison") Nothing [+              _Comparison_lessThan>>: constant $ var "rhs'",+              _Comparison_greaterThan>>: constant (ref parensDef @@ var "rhs'"),+              _Comparison_equalTo>>: constant $ Logic.ifElse+                (Logic.and (var "assocRight" @@ var "assoc") (var "assocRight" @@ var "rassoc"))+                (var "rhs'")+                (ref parensDef @@ var "rhs'")]]]+        $ Ast.exprOp $ Ast.opExpr (var "op") (var "lhs2") (var "rhs2")]++prefixDef :: TBinding (String -> Expr -> Expr)+prefixDef = define "prefix" $+  lambdas ["p", "expr"] $ lets [+    "preOp">: Ast.op+      (ref symDef @@ var "p")+      (Ast.padding Ast.wsNone Ast.wsNone)+      (Ast.precedence $ int32 0)+      Ast.associativityNone]+    $ ref ifxDef @@ var "preOp" @@ (ref cstDef @@ string "") @@ var "expr"++printExprDef :: TBinding (Expr -> String)+printExprDef = define "printExpr" $+  lambda "e" $ lets [+    "pad">: lambda "ws" $ cases _Ws (var "ws") Nothing [+      _Ws_none>>: constant $ string "",+      _Ws_space>>: constant $ string " ",+      _Ws_break>>: constant $ string "\n",+      _Ws_breakAndIndent>>: lambda "ignored" $ string "\n",+      _Ws_doubleBreak>>: constant $ string "\n\n"],+    "idt">: lambdas ["ws", "s"] $ cases _Ws (var "ws") (Just $ var "s") [+      _Ws_breakAndIndent>>: lambda "indentStr" $ ref customIndentDef @@ var "indentStr" @@ var "s"]]+    $ cases _Expr (var "e") Nothing [+      _Expr_const>>: lambda "symbol" $ Ast.unSymbol $ var "symbol",+      _Expr_indent>>: lambda "indentExpr" $ lets [+        "style">: Ast.indentedExpressionStyle $ var "indentExpr",+        "expr">: Ast.indentedExpressionExpr $ var "indentExpr",+        "lns">: Strings.lines $ ref printExprDef @@ var "expr"]+        $ Strings.intercalate (string "\n") $ cases _IndentStyle (var "style") Nothing [+          _IndentStyle_allLines>>: lambda "idt" $ Lists.map (lambda "line" $ var "idt" ++ var "line") (var "lns"),+          _IndentStyle_subsequentLines>>: lambda "idt" $+            Logic.ifElse (Equality.equal (Lists.length $ var "lns") (int32 1))+              (var "lns")+              (Lists.cons (Lists.head $ var "lns") $ Lists.map (lambda "line" $ var "idt" ++ var "line") $ Lists.tail $ var "lns")],+      _Expr_op>>: lambda "opExpr" $ lets [+        "op">: Ast.opExprOp $ var "opExpr",+        "sym">: Ast.unSymbol $ Ast.opSymbol $ var "op",+        "padding">: Ast.opPadding $ var "op",+        "padl">: Ast.paddingLeft $ var "padding",+        "padr">: Ast.paddingRight $ var "padding",+        "l">: Ast.opExprLhs $ var "opExpr",+        "r">: Ast.opExprRhs $ var "opExpr",+        "lhs">: var "idt" @@ var "padl" @@ (ref printExprDef @@ var "l"),+        "rhs">: var "idt" @@ var "padr" @@ (ref printExprDef @@ var "r")]+        $ var "lhs" ++ (var "pad" @@ var "padl") ++ var "sym" ++ (var "pad" @@ var "padr") ++ var "rhs",+      _Expr_brackets>>: lambda "bracketExpr" $ lets [+        "brackets">: Ast.bracketExprBrackets $ var "bracketExpr",+        "l">: Ast.unSymbol $ Ast.bracketsOpen $ var "brackets",+        "r">: Ast.unSymbol $ Ast.bracketsClose $ var "brackets",+        "e">: Ast.bracketExprEnclosed $ var "bracketExpr",+        "style">: Ast.bracketExprStyle $ var "bracketExpr",+        "body">: ref printExprDef @@ var "e",+        "doIndent">: Ast.blockStyleIndent $ var "style",+        "nlBefore">: Ast.blockStyleNewlineBeforeContent $ var "style",+        "nlAfter">: Ast.blockStyleNewlineAfterContent $ var "style",+        "ibody">: Optionals.maybe (var "body") (lambda "idt" $ ref customIndentDef @@ var "idt" @@ var "body") (var "doIndent"),+        "pre">: Logic.ifElse (var "nlBefore") (string "\n") (string ""),+        "suf">: Logic.ifElse (var "nlAfter") (string "\n") (string "")]+        $ var "l" ++ var "pre" ++ var "ibody" ++ var "suf" ++ var "r"]++semicolonSepDef :: TBinding ([Expr] -> Expr)+semicolonSepDef = define "semicolonSep" $+  ref symbolSepDef @@ string ";" @@ ref inlineStyleDef++sepDef :: TBinding (Op -> [Expr] -> Expr)+sepDef = define "sep" $+  lambdas ["op", "els"] $+    Logic.ifElse (Lists.null $ var "els")+      (ref cstDef @@ string "")+      (Logic.ifElse (Equality.equal (Lists.length $ var "els") (int32 1))+        (Lists.head $ var "els")+        (lets [+          "h">: Lists.head $ var "els",+          "r">: Lists.tail $ var "els"]+          $ ref ifxDef @@ var "op" @@ var "h" @@ (ref sepDef @@ var "op" @@ var "r")))++spaceSepDef :: TBinding ([Expr] -> Expr)+spaceSepDef = define "spaceSep" $+  ref sepDef @@ (Ast.op+    (ref symDef @@ string "")+    (Ast.padding Ast.wsSpace Ast.wsNone)+    (Ast.precedence $ int32 0)+    Ast.associativityNone)++squareBracketsDef :: TBinding Brackets+squareBracketsDef = define "squareBrackets" $+  Ast.brackets (ref symDef @@ string "[") (ref symDef @@ string "]")++symDef :: TBinding (String -> Symbol)+symDef = define "sym" $+  lambda "s" $ Ast.symbol $ var "s"++symbolSepDef :: TBinding (String -> BlockStyle -> [Expr] -> Expr)+symbolSepDef = define "symbolSep" $+  lambdas ["symb", "style", "l"] $+    Logic.ifElse (Lists.null $ var "l")+      (ref cstDef @@ string "")+      (Logic.ifElse (Equality.equal (Lists.length $ var "l") (int32 1))+        (Lists.head $ var "l")+        (lets [+          "h">: Lists.head $ var "l",+          "r">: Lists.tail $ var "l",+          "breakCount">: Lists.length $ Lists.filter identity $ list [+            Ast.blockStyleNewlineBeforeContent $ var "style",+            Ast.blockStyleNewlineAfterContent $ var "style"],+          "break">: Logic.ifElse (Equality.equal (var "breakCount") (int32 0))+            Ast.wsSpace+            (Logic.ifElse (Equality.equal (var "breakCount") (int32 1))+              Ast.wsBreak+              Ast.wsDoubleBreak),+          "commaOp">: Ast.op+            (ref symDef @@ var "symb")+            (Ast.padding Ast.wsNone (var "break"))+            (Ast.precedence $ int32 0)+            Ast.associativityNone]+          $ ref ifxDef @@ var "commaOp" @@ var "h" @@ (ref symbolSepDef @@ var "symb" @@ var "style" @@ var "r")))++tabIndentDef :: TBinding (Expr -> Expr)+tabIndentDef = define "tabIndent" $+  lambda "e" $ Ast.exprIndent $ Ast.indentedExpression+    (Ast.indentStyleAllLines $ string "    ")+    (var "e")++tabIndentDoubleSpaceDef :: TBinding ([Expr] -> Expr)+tabIndentDoubleSpaceDef = define "tabIndentDoubleSpace" $+  lambda "exprs" $ ref tabIndentDef @@ (ref doubleNewlineSepDef @@ var "exprs")++tabIndentSingleSpaceDef :: TBinding ([Expr] -> Expr)+tabIndentSingleSpaceDef = define "tabIndentSingleSpace" $+  lambda "exprs" $ ref tabIndentDef @@ (ref newlineSepDef @@ var "exprs")++unsupportedTypeDef :: TBinding (String -> Expr)+unsupportedTypeDef = define "unsupportedType" $+  lambda "label" $ ref cstDef @@ ("[" ++ var "label" ++ "]")++unsupportedVariantDef :: TBinding (String -> a -> Expr)+unsupportedVariantDef = define "unsupportedVariant" $+  lambdas ["label", "obj"] $ ref cstDef @@+    ("[unsupported " ++ var "label" ++ ": " ++ (Literals.showString $ var "obj") ++ "]")++withCommaDef :: TBinding (Expr -> Expr)+withCommaDef = define "withComma" $+  lambda "e" $ ref noSepDef @@ list [var "e", ref cstDef @@ string ","]++withSemiDef :: TBinding (Expr -> Expr)+withSemiDef = define "withSemi" $+  lambda "e" $ ref noSepDef @@ list [var "e", ref cstDef @@ string ";"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Show/Accessors.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Show.Accessors where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Names as Names+import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+++module_ :: Module+module_ = Module (Namespace "hydra.show.accessors") elements+    [Names.module_, Rewriting.module_]+    kernelTypesModules $+    Just ("Utilities for working with term accessors.")+  where+   elements = [+     el termAccessorDef,+     el termToAccessorGraphDef] -- TODO: move out of hydra.show.accessors++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++termAccessorDef :: TBinding (TermAccessor -> Maybe String)+termAccessorDef = define "termAccessor" $+  doc "Convert a term accessor to a string representation" $+  lambda "accessor" $ lets [+    "idx">: lambda "i" nothing,  -- TODO: restore index functionality+    "idxSuff">: lambda "suffix" $ lambda "i" $+      Optionals.map (lambda "s" $ Strings.cat2 (var "s") (var "suffix")) (var "idx" @@ var "i")]+    $ match _TermAccessor Nothing [+      _TermAccessor_annotatedSubject>>: constant nothing,+      _TermAccessor_applicationFunction>>: constant $ just $ string "fun",+      _TermAccessor_applicationArgument>>: constant $ just $ string "arg",+      _TermAccessor_lambdaBody>>: constant $ just $ string "body",+      _TermAccessor_unionCasesDefault>>: constant $ just $ string "default",+      _TermAccessor_unionCasesBranch>>: lambda "name" $ just $+        Strings.cat2 (string ".") (Core.unName $ var "name"),+      _TermAccessor_letEnvironment>>: constant $ just $ string "in",+      _TermAccessor_letBinding>>: lambda "name" $ just $+        Strings.cat2 (Core.unName $ var "name") (string "="),+      _TermAccessor_listElement>>: lambda "i" $ var "idx" @@ var "i",+      _TermAccessor_mapKey>>: lambda "i" $ var "idxSuff" @@ string ".key" @@ var "i",+      _TermAccessor_mapValue>>: lambda "i" $ var "idxSuff" @@ string ".value" @@ var "i",+      _TermAccessor_optionalTerm>>: constant $ just $ string "just",+      _TermAccessor_productTerm>>: lambda "i" $ var "idx" @@ var "i",+      _TermAccessor_recordField>>: lambda "name" $ just $+        Strings.cat2 (string ".") (Core.unName $ var "name"),+      _TermAccessor_setElement>>: lambda "i" $ var "idx" @@ var "i",+      _TermAccessor_sumTerm>>: constant nothing,+      _TermAccessor_typeLambdaBody>>: constant nothing,+      _TermAccessor_typeApplicationTerm>>: constant nothing,+      _TermAccessor_injectionTerm>>: constant nothing,+      _TermAccessor_wrappedTerm>>: constant nothing] @@ var "accessor"++termToAccessorGraphDef :: TBinding (M.Map Namespace String -> Term -> AccessorGraph)+termToAccessorGraphDef = define "termToAccessorGraph" $+  doc "Build an accessor graph from a term" $+  lambda "namespaces" $ lambda "term" $ lets [+    "dontCareAccessor">: Mantle.termAccessorAnnotatedSubject,+    "helper">: lambdas ["ids", "mroot", "path", "state", "accessorTerm"] $ lets [+      "accessor">: first $ var "accessorTerm",+      "currentTerm">: second $ var "accessorTerm",+      "nodesEdges">: first $ var "state",+      "visited">: second $ var "state",+      "nodes">: first $ var "nodesEdges",+      "edges">: second $ var "nodesEdges",+      "nextPath">: Lists.cons (var "accessor") (var "path")]+      $ match _Term (Just $+          Lists.foldl+            (var "helper" @@ var "ids" @@ var "mroot" @@ var "nextPath")+            (var "state")+            (ref Rewriting.subtermsWithAccessorsDef @@ var "currentTerm")) [+        _Term_let>>: lambda "letExpr" $ lets [+          "bindings">: Core.letBindings $ var "letExpr",+          "env">: Core.letEnvironment $ var "letExpr",+          "bindingNames">: Lists.map (unaryFunction Core.bindingName) (var "bindings"),+          -- First fold: build nodes and update ids for each binding name+          "addBindingName">: lambdas ["nodesVisitedIds", "name"] $ lets [+            "currentNodesVisited">: first $ var "nodesVisitedIds",+            "currentIds">: second $ var "nodesVisitedIds",+            "currentNodes">: first $ var "currentNodesVisited",+            "currentVisited">: second $ var "currentNodesVisited",+            "rawLabel">: ref Names.compactNameDef @@ var "namespaces" @@ var "name",+            "uniqueLabel">: ref Names.uniqueLabelDef @@ var "currentVisited" @@ var "rawLabel",+            "node">: Accessors.accessorNode (var "name") (var "rawLabel") (var "uniqueLabel"),+            "newVisited">: Sets.insert (var "uniqueLabel") (var "currentVisited"),+            "newNodes">: Lists.cons (var "node") (var "currentNodes"),+            "newIds">: Maps.insert (var "name") (var "node") (var "currentIds")]+            $ pair (pair (var "newNodes") (var "newVisited")) (var "newIds"),+          "nodesVisitedIds1">: Lists.foldl+            (var "addBindingName")+            (pair (pair (list []) (var "visited")) (var "ids"))+            (var "bindingNames"),+          "nodes1">: first $ first $ var "nodesVisitedIds1",+          "visited1">: second $ first $ var "nodesVisitedIds1",+          "ids1">: second $ var "nodesVisitedIds1",+          -- Second fold: process each binding term+          "addBindingTerm">: lambdas ["currentState", "nodeBinding"] $ lets [+            "root">: first $ var "nodeBinding",+            "binding">: second $ var "nodeBinding",+            "term1">: Core.bindingTerm $ var "binding"]+            $ var "helper" @@ var "ids1" @@ just (var "root") @@ list [] @@ var "currentState" @@+              pair (var "dontCareAccessor") (var "term1"),+          "nodeBindingPairs">: Lists.zip (var "nodes1") (var "bindings"),+          "stateAfterBindings">: Lists.foldl+            (var "addBindingTerm")+            (pair (pair (Lists.concat2 (var "nodes1") (var "nodes")) (var "edges")) (var "visited1"))+            (var "nodeBindingPairs")]+          $ var "helper" @@ var "ids1" @@ var "mroot" @@ var "nextPath" @@ var "stateAfterBindings" @@+            pair Mantle.termAccessorLetEnvironment (var "env"),+        _Term_variable>>: lambda "name" $+          Optionals.maybe (var "state")+            (lambda "root" $+              Optionals.maybe (var "state")+                (lambda "node" $ lets [+                  "edge">: Accessors.accessorEdge (var "root")+                    (Accessors.accessorPath $ Lists.reverse $ var "nextPath") (var "node"),+                  "newEdges">: Lists.cons (var "edge") (var "edges")]+                  $ pair (pair (var "nodes") (var "newEdges")) (var "visited"))+                (Maps.lookup (var "name") (var "ids")))+            (var "mroot")]+      @@ var "currentTerm",+    "initialState">: pair (pair (list []) (list [])) Sets.empty,+    "result">: var "helper" @@ Maps.empty @@ nothing @@ list [] @@ var "initialState" @@+      pair (var "dontCareAccessor") (var "term"),+    "finalNodesEdges">: first $ var "result",+    "finalNodes">: first $ var "finalNodesEdges",+    "finalEdges">: second $ var "finalNodesEdges"]+    $ Accessors.accessorGraph (var "finalNodes") (var "finalEdges")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Show/Core.hs view
@@ -0,0 +1,484 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Show.Core where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.show.core") elements+    []+    kernelTypesModules $+    Just "String representations of hydra.core types"+  where+   elements = [+     el readTermDef, -- TODO: move this to hydra.read.core+     el bindingDef,+     el eliminationDef,+     el fieldsDef,+     el floatValueDef,+     el floatTypeDef,+     el functionDef,+     el injectionDef,+     el integerValueDef,+     el integerTypeDef,+     el lambdaDef,+     el listDef,+     el literalDef,+     el literalTypeDef,+     el termDef,+     el typeDef,+     el typeSchemeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++readTermDef :: TBinding (String -> Maybe Term)+readTermDef = define "readTerm" $+  doc "A placeholder for reading terms from their serialized form. Not implemented." $+  constant nothing++bindingDef :: TBinding (Binding -> String)+bindingDef = define "binding" $+  doc "Show a binding as a string" $+  lambda "el" $ lets [+    "name">: unwrap _Name @@ (Core.bindingName $ var "el"),+    "t">: Core.bindingTerm $ var "el",+    "typeStr">: Optionals.maybe+      (string "")+      (lambda "ts" $ Strings.cat2 (string " : ") (ref typeSchemeDef @@ var "ts"))+      (Core.bindingType $ var "el")] $+    Strings.cat $ list [+      var "name",+      string " = ",+      ref termDef @@ var "t",+      var "typeStr"]+      +eliminationDef :: TBinding (Elimination -> String)+eliminationDef = define "elimination" $+  doc "Show an elimination as a string" $+  lambda "elm" $ cases _Elimination (var "elm") Nothing [+    _Elimination_product>>: lambda "tp" $ lets [+      "arity">: Core.tupleProjectionArity $ var "tp",+      "index">: Core.tupleProjectionIndex $ var "tp",+      "domain">: Core.tupleProjectionDomain $ var "tp"] $ -- TODO: show domain if present+      Strings.cat $ list [+        string "[",+        Literals.showInt32 $ var "index",+        string "/",+        Literals.showInt32 $ var "arity",+        string "]"],+    _Elimination_record>>: lambda "proj" $ lets [+      "tname">: unwrap _Name @@ (Core.projectionTypeName $ var "proj"),+      "fname">: unwrap _Name @@ (Core.projectionField $ var "proj")] $+      Strings.cat $ list [+        string "project(",+        var "tname",+        string "){",+        var "fname",+        string "}"],+    _Elimination_union>>: lambda "cs" $ lets [+      "tname">: unwrap _Name @@ (Core.caseStatementTypeName $ var "cs"),+      "mdef">: Core.caseStatementDefault $ var "cs",+      "cases">: Core.caseStatementCases $ var "cs",+      "defaultField">: Optionals.maybe+        (list [])+        (lambda "d" $ list [Core.field (Core.name $ string "[default]") (var "d")])+        (var "mdef"),+      "allFields">: Lists.concat $ list [var "cases", var "defaultField"]] $+      Strings.cat $ list [+        string "case(",+        var "tname",+        string ")",+        ref fieldsDef @@ var "allFields"],+    _Elimination_wrap>>: lambda "tname" $ Strings.cat $ list [+      string "unwrap(",+      unwrap _Name @@ var "tname",+      string ")"]]++fieldsDef :: TBinding ([Field] -> String)+fieldsDef = define "fields" $+  doc "Show a list of fields as a string" $+  lambda "flds" $ lets [+    "showField">: lambda "field" $ lets [+      "fname">: unwrap _Name @@ (Core.fieldName $ var "field"),+      "fterm">: Core.fieldTerm $ var "field"] $+      Strings.cat2 (var "fname") $ Strings.cat2 (string "=") (ref termDef @@ var "fterm"),+    "fieldStrs">: Lists.map (var "showField") (var "flds")] $+    Strings.cat $ list [+      string "{",+      Strings.intercalate (string ", ") (var "fieldStrs"),+      string "}"]++floatValueDef :: TBinding (FloatValue -> String)+floatValueDef = define "float" $+  doc "Show a float value as a string" $+  lambda "fv" $ cases _FloatValue (var "fv") Nothing [+    _FloatValue_bigfloat>>: "v" ~> Literals.showBigfloat (var "v") ++ ":bigfloat",+    _FloatValue_float32>>: "v" ~> Literals.showFloat32 (var "v") ++ ":float32",+    _FloatValue_float64>>: "v" ~> Literals.showFloat64 (var "v") ++ ":float64"]++floatTypeDef :: TBinding (FloatType -> String)+floatTypeDef = define "floatType" $+  doc "Show a float type as a string" $+  lambda "ft" $ cases _FloatType (var "ft") Nothing [+    _FloatType_bigfloat>>: constant $ string "bigfloat",+    _FloatType_float32>>: constant $ string "float32",+    _FloatType_float64>>: constant $ string "float64"]++functionDef :: TBinding (Function -> String)+functionDef = define "function" $+  doc "Show a function as a string" $+  lambda "f" $ cases _Function (var "f") Nothing [+    _Function_elimination>>: ref eliminationDef,+    _Function_lambda>>: ref lambdaDef,+    _Function_primitive>>: lambda "name" $ Strings.cat2 (unwrap _Name @@ var "name") (string "!")]++injectionDef :: TBinding (Injection -> String)+injectionDef = define "injection" $+  doc "Show an injection as a string" $+  "inj" ~>+  "tname" <~ Core.injectionTypeName (var "inj") $+  "f" <~ Core.injectionField (var "inj") $+  Strings.cat $ list [+    string "inject(",+    unwrap _Name @@ var "tname",+    string ")",+    ref fieldsDef @@ (list [var "f"])]++integerValueDef :: TBinding (IntegerValue -> String)+integerValueDef = define "integer" $+  doc "Show an integer value as a string" $+  lambda "iv" $ cases _IntegerValue (var "iv") Nothing [+    _IntegerValue_bigint>>: "v" ~> Literals.showBigint (var "v") ++ ":bigint",+    _IntegerValue_int8>>: "v" ~> Literals.showInt8 (var "v") ++ ":int8",+    _IntegerValue_int16>>: "v" ~> Literals.showInt16 (var "v") ++ ":int16",+    _IntegerValue_int32>>: "v" ~> Literals.showInt32 (var "v") ++ ":int32",+    _IntegerValue_int64>>: "v" ~> Literals.showInt64 (var "v") ++ ":int64",+    _IntegerValue_uint8>>: "v" ~> Literals.showUint8 (var "v") ++ ":uint8",+    _IntegerValue_uint16>>: "v" ~> Literals.showUint16 (var "v") ++ ":uint16",+    _IntegerValue_uint32>>: "v" ~> Literals.showUint32 (var "v") ++ ":uint32",+    _IntegerValue_uint64>>: "v" ~> Literals.showUint64 (var "v") ++ ":uint64"]++integerTypeDef :: TBinding (IntegerType -> String)+integerTypeDef = define "integerType" $+  doc "Show an integer type as a string" $+  lambda "it" $ cases _IntegerType (var "it") Nothing [+    _IntegerType_bigint>>: constant $ string "bigint",+    _IntegerType_int8>>: constant $ string "int8",+    _IntegerType_int16>>: constant $ string "int16",+    _IntegerType_int32>>: constant $ string "int32",+    _IntegerType_int64>>: constant $ string "int64",+    _IntegerType_uint8>>: constant $ string "uint8",+    _IntegerType_uint16>>: constant $ string "uint16",+    _IntegerType_uint32>>: constant $ string "uint32",+    _IntegerType_uint64>>: constant $ string "uint64"]++lambdaDef :: TBinding (Lambda -> String)+lambdaDef = define "lambda" $+  doc "Show a lambda as a string" $+  lambda "l" $ lets [+    "v">: unwrap _Name @@ (Core.lambdaParameter $ var "l"),+    "mt">: Core.lambdaDomain $ var "l",+    "body">: Core.lambdaBody $ var "l",+    "typeStr">: Optionals.maybe+      (string "")+      (lambda "t" $ Strings.cat2 (string ":") (ref typeDef @@ var "t"))+      (var "mt")] $+    Strings.cat $ list [+      string "λ",+      var "v",+      var "typeStr",+      string ".",+      ref termDef @@ var "body"]++listDef :: TBinding ((a -> String) -> [a] -> String)+listDef = define "list" $+  doc "Show a list using a given function to show each element" $+  lambdas ["f", "xs"] $ lets [+    "elementStrs">: Lists.map (var "f") (var "xs")] $+    Strings.cat $ list [+      string "[",+      Strings.intercalate (string ", ") (var "elementStrs"),+      string "]"]++literalDef :: TBinding (Literal -> String)+literalDef = define "literal" $+  doc "Show a literal as a string" $+  lambda "l" $ cases _Literal (var "l") Nothing [+    _Literal_binary>>: constant $ string "[binary]",+    _Literal_boolean>>: lambda "b" $ Logic.ifElse (var "b") (string "true") (string "false"),+    _Literal_float>>: lambda "fv" $ ref floatValueDef @@ var "fv",+    _Literal_integer>>: lambda "iv" $ ref integerValueDef @@ var "iv",+    _Literal_string>>: lambda "s" $ Literals.showString $ var "s"]++literalTypeDef :: TBinding (LiteralType -> String)+literalTypeDef = define "literalType" $+  doc "Show a literal type as a string" $+  lambda "lt" $ cases _LiteralType (var "lt") Nothing [+    _LiteralType_binary>>: constant $ string "binary",+    _LiteralType_boolean>>: constant $ string "boolean",+    _LiteralType_float>>: lambda "ft" $ ref floatTypeDef @@ var "ft",+    _LiteralType_integer>>: lambda "it" $ ref integerTypeDef @@ var "it",+    _LiteralType_string>>: constant $ string "string"]++termDef :: TBinding (Term -> String)+termDef = define "term" $+  doc "Show a term as a string" $+  lambda "t" $ lets [+    "gatherTerms">: lambdas ["prev", "app"] $ lets [+      "lhs">: Core.applicationFunction $ var "app",+      "rhs">: Core.applicationArgument $ var "app"] $+      cases _Term (var "lhs")+        (Just $ Lists.cons (var "lhs") (Lists.cons (var "rhs") (var "prev"))) [+        _Term_application>>: lambda "app2" $ var "gatherTerms" @@ (Lists.cons (var "rhs") (var "prev")) @@ var "app2"]] $+    cases _Term (var "t") Nothing [+      _Term_annotated>>: lambda "at" $ ref termDef @@ (Core.annotatedTermSubject $ var "at"),+      _Term_application>>: lambda "app" $ lets [+        "terms">: var "gatherTerms" @@ (list []) @@ var "app",+        "termStrs">: Lists.map (ref termDef) (var "terms")] $+        Strings.cat $ list [+          string "(",+          Strings.intercalate (string " @ ") (var "termStrs"),+          string ")"],+      _Term_function>>: ref functionDef,+      _Term_let>>: lambda "l" $ lets [+        "bindings">: Core.letBindings $ var "l",+        "env">: Core.letEnvironment $ var "l",+        "bindingStrs">: Lists.map (ref bindingDef) (var "bindings")] $+        Strings.cat $ list [+          string "let ",+          Strings.intercalate (string ", ") (var "bindingStrs"),+          string " in ",+          ref termDef @@ var "env"],+      _Term_list>>: lambda "els" $ lets [+        "termStrs">: Lists.map (ref termDef) (var "els")] $+        Strings.cat $ list [+          string "[",+          Strings.intercalate (string ", ") (var "termStrs"),+          string "]"],+      _Term_literal>>: lambda "lit" $ ref literalDef @@ var "lit",+      _Term_map>>: lambda "m" $ lets [+        "entry">: lambda "p" $ Strings.cat $ list [+          ref termDef @@ (first $ var "p"),+          string "=",+          ref termDef @@ (second $ var "p")]] $+        Strings.cat $ list [+          string "{",+          Strings.intercalate (string ", ") $ Lists.map (var "entry") $ Maps.toList $ var "m",+          string "}"],+      _Term_optional>>: lambda "mt" $ Optionals.maybe+        (string "nothing")+        (lambda "t" $ Strings.cat $ list [+          string "just(",+          ref termDef @@ var "t",+          string ")"])+        (var "mt"),+      _Term_product>>: lambda "els" $ lets [+        "termStrs">: Lists.map (ref termDef) (var "els")] $+        Strings.cat $ list [+          string "(",+          Strings.intercalate (string ", ") (var "termStrs"),+          string ")"],+      _Term_record>>: lambda "rec" $ lets [+        "tname">: unwrap _Name @@ (Core.recordTypeName $ var "rec"),+        "flds">: Core.recordFields $ var "rec"] $+        Strings.cat $ list [+          string "record(",+          var "tname",+          string ")",+          ref fieldsDef @@ var "flds"],+      _Term_set>>: lambda "s" $+        Strings.cat $ list [+          string "{",+          Strings.intercalate (string ", ") (Lists.map (ref termDef) $ Sets.toList $ var "s"),+          string "}"],+      _Term_sum>>: lambda "s" $ lets [+        "index">: Core.sumIndex $ var "s",+        "size">: Core.sumSize $ var "s",+        "t2">: Core.sumTerm $ var "s"] $+        Strings.cat $ list [+          string "(",+          Literals.showInt32 $ var "index",+          string "/",+          Literals.showInt32 $ var "size",+          string "=",+          ref termDef @@ var "t2",+          string ")"],+      _Term_typeLambda>>: lambda "ta" $ lets [+        "param">: unwrap _Name @@ (Core.typeLambdaParameter $ var "ta"),+        "body">: Core.typeLambdaBody $ var "ta"] $+        Strings.cat $ list [+          string "Λ",+          var "param",+          string ".",+          ref termDef @@ var "body"],+      _Term_typeApplication>>: lambda "tt" $ lets [+        "t2">: Core.typedTermTerm $ var "tt",+        "typ">: Core.typedTermType $ var "tt"] $+        Strings.cat $ list [+          ref termDef @@ var "t2",+          string "⟨",+          ref typeDef @@ var "typ",+          string "⟩"],+      _Term_union>>: ref injectionDef,+      _Term_unit>>: constant $ string "unit",+      _Term_variable>>: lambda "name" $ unwrap _Name @@ var "name",+      _Term_wrap>>: lambda "wt" $ lets [+        "tname">: unwrap _Name @@ (Core.wrappedTermTypeName $ var "wt"),+        "term1">: Core.wrappedTermObject $ var "wt"] $+        Strings.cat $ list [+          string "wrap(",+          var "tname",+          string "){",+          ref termDef @@ var "term1",+          string "}"]]++typeDef :: TBinding (Type -> String)+typeDef = define "type" $+  doc "Show a type as a string" $+  lambda "typ" $ lets [+    "showFieldType">: lambda "ft" $ lets [+      "fname">: unwrap _Name @@ (Core.fieldTypeName $ var "ft"),+      "ftyp">: Core.fieldTypeType $ var "ft"] $+      Strings.cat $ list [+        var "fname",+        string ":",+        ref typeDef @@ var "ftyp"],+    "showRowType">: lambda "rt" $ lets [+      "flds">: Core.rowTypeFields $ var "rt",+      "fieldStrs">: Lists.map (var "showFieldType") (var "flds")] $+      Strings.cat $ list [+        string "{",+        Strings.intercalate (string ", ") (var "fieldStrs"),+        string "}"],+    "gatherTypes">: lambdas ["prev", "app"] $ lets [+      "lhs">: Core.applicationTypeFunction $ var "app",+      "rhs">: Core.applicationTypeArgument $ var "app"] $+      cases _Type (var "lhs")+        (Just $ Lists.cons (var "lhs") (Lists.cons (var "rhs") (var "prev"))) [+        _Type_application>>: lambda "app2" $ var "gatherTypes" @@ (Lists.cons (var "rhs") (var "prev")) @@ var "app2"],+    "gatherFunctionTypes">: lambdas ["prev", "t"] $+      cases _Type (var "t")+        (Just $ Lists.reverse $ Lists.cons (var "t") (var "prev")) [+          _Type_function>>: lambda "ft" $ lets [+            "dom">: Core.functionTypeDomain $ var "ft",+            "cod">: Core.functionTypeCodomain $ var "ft"] $+            var "gatherFunctionTypes" @@ (Lists.cons (var "dom") (var "prev")) @@ var "cod"]] $+    cases _Type (var "typ") Nothing [+      _Type_annotated>>: lambda "at" $ ref typeDef @@ (Core.annotatedTypeSubject $ var "at"),+      _Type_application>>: lambda "app" $ lets [+        "types">: var "gatherTypes" @@ (list []) @@ var "app",+        "typeStrs">: Lists.map (ref typeDef) (var "types")] $+        Strings.cat $ list [+          string "(",+          Strings.intercalate (string " @ ") (var "typeStrs"),+          string ")"],+      _Type_forall>>: lambda "ft" $ lets [+        "var">: unwrap _Name @@ (Core.forallTypeParameter $ var "ft"),+        "body">: Core.forallTypeBody $ var "ft"] $+        Strings.cat $ list [+          string "(∀",+          var "var",+          string ".",+          ref typeDef @@ var "body",+          string ")"],+      _Type_function>>: lambda "ft" $ lets [+        "types">: var "gatherFunctionTypes" @@ (list []) @@ var "typ",+        "typeStrs">: Lists.map (ref typeDef) (var "types")] $+        Strings.cat $ list [+          string "(",+          Strings.intercalate (string " → ") (var "typeStrs"),+          string ")"],+      _Type_list>>: lambda "etyp" $ Strings.cat $ list [+        string "list<",+        ref typeDef @@ var "etyp",+        string ">"],+      _Type_literal>>: lambda "lt" $ ref literalTypeDef @@ var "lt",+      _Type_map>>: lambda "mt" $ lets [+        "keyTyp">: Core.mapTypeKeys $ var "mt",+        "valTyp">: Core.mapTypeValues $ var "mt"] $+        Strings.cat $ list [+          string "map<",+          ref typeDef @@ var "keyTyp",+          string ", ",+          ref typeDef @@ var "valTyp",+          string ">"],+      _Type_optional>>: lambda "etyp" $ Strings.cat $ list [+        string "optional<",+        ref typeDef @@ var "etyp",+        string ">"],+      _Type_product>>: lambda "types" $ lets [+        "typeStrs">: Lists.map (ref typeDef) (var "types")] $+        Strings.intercalate (string "×") (var "typeStrs"),+      _Type_record>>: lambda "rt" $ Strings.cat2 (string "record") (var "showRowType" @@ var "rt"),+      _Type_set>>: lambda "etyp" $ Strings.cat $ list [+        string "set<",+        ref typeDef @@ var "etyp",+        string ">"],+      _Type_sum>>: lambda "types" $ lets [+        "typeStrs">: Lists.map (ref typeDef) (var "types")] $+        Strings.intercalate (string "+") (var "typeStrs"),+      _Type_union>>: lambda "rt" $ Strings.cat2 (string "union") (var "showRowType" @@ var "rt"),+      _Type_unit>>: constant $ string "unit",+      _Type_variable>>: lambda "name" $ unwrap _Name @@ var "name",+      _Type_wrap>>: lambda "wt" $ lets [+        "tname">: unwrap _Name @@ (Core.wrappedTypeTypeName $ var "wt"),+        "typ1">: Core.wrappedTypeObject $ var "wt"] $+        Strings.cat $ list [string "wrap[", var "tname", string "](", ref typeDef @@ var "typ1", string ")"]]++typeSchemeDef :: TBinding (TypeScheme -> String)+typeSchemeDef = define "typeScheme" $+  doc "Show a type scheme as a string" $+  lambda "ts" $ lets [+    "vars">: Core.typeSchemeVariables $ var "ts",+    "body">: Core.typeSchemeType $ var "ts",+    "varNames">: Lists.map (unwrap _Name) (var "vars"),+    "fa">: Logic.ifElse (Lists.null $ var "vars")+      (string "")+      (Strings.cat $ list [+        string "∀[",+        Strings.intercalate (string ",") (var "varNames"),+        string "]."])] $+    Strings.cat $ list [+      string "(",+      var "fa",+      ref typeDef @@ var "body",+      string ")"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Show/Graph.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Show.Graph where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+++module_ :: Module+module_ = Module (Namespace "hydra.show.graph") elements+    [Annotations.module_, ShowCore.module_]+    kernelTypesModules $+    Just "String representations of hydra.graph types"+  where+   elements = [+     el graphDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++graphDef :: TBinding (Graph -> String)+graphDef = define "graph" $+  doc "Show a graph as a string" $+  lambda "graph" $ lets [+    "elements">: Maps.elems $ Graph.graphElements $ var "graph",+    "elementStrs">: Lists.map (ref ShowCore.bindingDef) (var "elements")] $+    Strings.cat $ list [+      string "{",+      Strings.intercalate (string ", ") (var "elementStrs"),+      string "}"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Show/Mantle.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Show.Mantle where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+++module_ :: Module+module_ = Module (Namespace "hydra.show.mantle") elements+    [Annotations.module_]+    kernelTypesModules $+    Just "String representations of hydra.mantle types"+  where+   elements = [+     el termVariantDef,+     el typeVariantDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++termVariantDef :: TBinding (TermVariant -> String)+termVariantDef = define "termVariant" $+  doc "Show a term variant as a string" $+  match _TermVariant Nothing [+    _TermVariant_annotated>>: constant $ string "annotated",+    _TermVariant_application>>: constant $ string "application",+    _TermVariant_function>>: constant $ string "function",+    _TermVariant_let>>: constant $ string "let",+    _TermVariant_list>>: constant $ string "list",+    _TermVariant_literal>>: constant $ string "literal",+    _TermVariant_map>>: constant $ string "map",+    _TermVariant_optional>>: constant $ string "optional",+    _TermVariant_product>>: constant $ string "product",+    _TermVariant_record>>: constant $ string "record",+    _TermVariant_set>>: constant $ string "set",+    _TermVariant_sum>>: constant $ string "sum",+    _TermVariant_typeLambda>>: constant $ string "typeLambda",+    _TermVariant_typeApplication>>: constant $ string "typeApplication",+    _TermVariant_union>>: constant $ string "union",+    _TermVariant_unit>>: constant $ string "unit",+    _TermVariant_variable>>: constant $ string "variable",+    _TermVariant_wrap>>: constant $ string "wrap"]++typeVariantDef :: TBinding (TypeVariant -> String)+typeVariantDef = define "typeVariant" $+  doc "Show a type variant as a string" $+  match _TypeVariant Nothing [+    _TypeVariant_annotated>>: constant $ string "annotated",+    _TypeVariant_application>>: constant $ string "application",+    _TypeVariant_forall>>: constant $ string "forall",+    _TypeVariant_function>>: constant $ string "function",+    _TypeVariant_list>>: constant $ string "list",+    _TypeVariant_literal>>: constant $ string "literal",+    _TypeVariant_map>>: constant $ string "map",+    _TypeVariant_optional>>: constant $ string "optional",+    _TypeVariant_product>>: constant $ string "product",+    _TypeVariant_record>>: constant $ string "record",+    _TypeVariant_set>>: constant $ string "set",+    _TypeVariant_sum>>: constant $ string "sum",+    _TypeVariant_union>>: constant $ string "union",+    _TypeVariant_unit>>: constant $ string "unit",+    _TypeVariant_variable>>: constant $ string "variable",+    _TypeVariant_wrap>>: constant $ string "wrap"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Show/Typing.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Show.Typing where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+++module_ :: Module+module_ = Module (Namespace "hydra.show.typing") elements+    [Annotations.module_, ShowCore.module_]+    kernelTypesModules $+    Just "String representations of hydra.typing types"+  where+   elements = [+     el typeConstraintDef,+     el typeSubstDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++typeConstraintDef :: TBinding (TypeConstraint -> String)+typeConstraintDef = define "typeConstraint" $+  doc "Show a type constraint as a string" $+  lambda "tc" $ lets [+    "ltyp">: Typing.typeConstraintLeft $ var "tc",+    "rtyp">: Typing.typeConstraintRight $ var "tc"] $+    Strings.cat $ list [+      ref ShowCore.typeDef @@ var "ltyp",+      string "≡",+      ref ShowCore.typeDef @@ var "rtyp"]++typeSubstDef :: TBinding (TypeSubst -> String)+typeSubstDef = define "typeSubst" $+  doc "Show a type substitution as a string" $+  lambda "ts" $ lets [+    "subst">: Typing.unTypeSubst $ var "ts",+    "pairs">: Maps.toList $ var "subst",+    "showPair">: lambda "pair" $ lets [+      "name">: unwrap _Name @@ (first $ var "pair"),+      "typ">: second $ var "pair"] $+      Strings.cat $ list [+        var "name",+        string "↦",+        ref ShowCore.typeDef @@ var "typ"],+    "pairStrs">: Lists.map (var "showPair") (var "pairs")] $+    Strings.cat $ list [+      string "{",+      Strings.intercalate (string ",") (var "pairStrs"),+      string "}"]
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Sorting.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Sorting where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Tarjan as Tarjan++import qualified Hydra.Topology as Topo+++module_ :: Module+module_ = Module (Namespace "hydra.sorting") elements+    [Tarjan.module_]+    kernelTypesModules $+    Just ("Utilities for sorting.")+  where+   elements = [+     el createOrderingIsomorphismDef,+     el topologicalSortDef,+     el topologicalSortComponentsDef,+     el topologicalSortNodesDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++createOrderingIsomorphismDef :: TBinding ([a] -> [a] -> Topo.OrderingIsomorphism b)+createOrderingIsomorphismDef = define "createOrderingIsomorphism" $+  withOrd "t0" $ "sourceOrd" ~> "targetOrd" ~>+  "sourceToTargetMapping" <~ ("els" ~>+    "mp" <~ Maps.fromList (Lists.zip (var "sourceOrd") (var "els")) $+    Optionals.cat $ Lists.map ("n" ~> Maps.lookup (var "n") (var "mp")) (var "targetOrd")) $+  "targetToSourceMapping" <~ ("els" ~>+    "mp" <~ Maps.fromList (Lists.zip (var "targetOrd") (var "els")) $+    Optionals.cat $ Lists.map ("n" ~> Maps.lookup (var "n") (var "mp")) (var "sourceOrd")) $+  Topology.orderingIsomorphism (var "sourceToTargetMapping") (var "targetToSourceMapping")++topologicalSortDef :: TBinding ([(a, [a])] -> Either [[a]] [a])+topologicalSortDef = define "topologicalSort" $+  doc ("Sort a directed acyclic graph (DAG) based on an adjacency list."+    <> " Yields a list of nontrivial strongly connected components if the graph has cycles, otherwise a simple list.") $+  withOrd "t0" $ "pairs" ~>+  "sccs" <~ ref topologicalSortComponentsDef @@ var "pairs" $+  "isCycle" <~ ("scc" ~> Logic.not $ Lists.null $ Lists.tail $ var "scc") $+  "withCycles" <~ Lists.filter (var "isCycle") (var "sccs") $+  Logic.ifElse (Lists.null $ var "withCycles")+    (Mantle.eitherRight $ Lists.concat $ var "sccs")+    (Mantle.eitherLeft $ var "withCycles")++topologicalSortComponentsDef :: TBinding ([(a, [a])] -> [[a]])+topologicalSortComponentsDef = define "topologicalSortComponents" $+  doc ("Find the strongly connected components (including cycles and isolated vertices) of a graph,"+    <> " in (reverse) topological order, i.e. dependencies before dependents") $+  withOrd "t0" $ "pairs" ~>+  "graphResult" <~ ref Tarjan.adjacencyListsToGraphDef @@ var "pairs" $+  "g" <~ first (var "graphResult") $+  "getKey" <~ second (var "graphResult") $+  Lists.map ("comp" ~> Lists.map (var "getKey") (var "comp")) $+    ref Tarjan.stronglyConnectedComponentsDef @@ var "g"++topologicalSortNodesDef :: TBinding ((x -> a) -> (x -> [a]) -> [x] -> [[x]])+topologicalSortNodesDef = define "topologicalSortNodes" $+  doc ("Sort a directed acyclic graph (DAG) of nodes using two helper functions:"+    <> " one for node keys, and one for the adjacency list of connected node keys."+    <> " The result is a list of strongly-connected components (cycles), in which singleton lists represent acyclic nodes.") $+  withOrd "t1" $ "getKey" ~> "getAdj" ~> "nodes" ~>+  "nodesByKey" <~ Maps.fromList (Lists.map ("n" ~> pair (var "getKey" @@ var "n") (var "n")) (var "nodes")) $+  "pairs" <~ Lists.map ("n" ~> pair (var "getKey" @@ var "n") (var "getAdj" @@ var "n")) (var "nodes") $+  "comps" <~ ref topologicalSortComponentsDef @@ var "pairs" $+  Lists.map ("c" ~> Optionals.cat $ Lists.map ("k" ~> Maps.lookup (var "k") (var "nodesByKey")) (var "c")) (var "comps")
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Substitution.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Substitution where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting++module_ :: Module+module_ = Module (Namespace "hydra.substitution") elements+    [Rewriting.module_]+    kernelTypesModules $+    Just ("Variable substitution in type and term expressions.")+  where+   elements = [+     el composeTypeSubstDef,+     el composeTypeSubstListDef,+     el idTypeSubstDef,+     el singletonTypeSubstDef,+     el substituteInConstraintDef,+     el substituteInConstraintsDef,+     el substInContextDef,+     el substituteInTermDef,+     el substInTypeDef,+     el substInTypeSchemeDef,+     el substTypesInTermDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++composeTypeSubstDef :: TBinding (TypeSubst -> TypeSubst -> TypeSubst)+composeTypeSubstDef = define "composeTypeSubst" $+  lambdas ["s1", "s2"] $ lets [+    "isExtra">: lambdas ["k", "v"] $ Optionals.isNothing (Maps.lookup (var "k") (Typing.unTypeSubst $ var "s1")),+    "withExtra">: Maps.filterWithKey (var "isExtra") (Typing.unTypeSubst $ var "s2")] $+    Typing.typeSubst $ Maps.union (var "withExtra") $ Maps.map (ref substInTypeDef @@ var "s2") $ Typing.unTypeSubst $ var "s1"++composeTypeSubstListDef :: TBinding ([TypeSubst] -> TypeSubst)+composeTypeSubstListDef = define "composeTypeSubstList" $+  Phantoms.fold (ref composeTypeSubstDef) @@ ref idTypeSubstDef++idTypeSubstDef :: TBinding TypeSubst+idTypeSubstDef = define "idTypeSubst" $+  Typing.typeSubst Maps.empty++singletonTypeSubstDef :: TBinding (Name -> Type -> TypeSubst)+singletonTypeSubstDef = define "singletonTypeSubst" $+  lambdas ["v", "t"] $ Typing.typeSubst $ Maps.singleton (var "v") (var "t")++substituteInConstraintDef :: TBinding (TypeSubst -> TypeConstraint -> TypeConstraint)+substituteInConstraintDef = define "substituteInConstraint" $+  lambdas ["subst", "c"] $ Typing.typeConstraint+    (ref substInTypeDef @@ var "subst" @@ (Typing.typeConstraintLeft $ var "c"))+    (ref substInTypeDef @@ var "subst" @@ (Typing.typeConstraintRight $ var "c"))+    (Typing.typeConstraintComment $ var "c")++substituteInConstraintsDef :: TBinding (TypeSubst -> [TypeConstraint] -> [TypeConstraint])+substituteInConstraintsDef = define "substituteInConstraints" $+  lambdas ["subst", "cs"] $ Lists.map (ref substituteInConstraintDef @@ var "subst") (var "cs")++substInContextDef :: TBinding (TypeSubst -> InferenceContext -> InferenceContext)+substInContextDef = define "substInContext" $+  lambdas ["subst", "cx"] $ Typing.inferenceContextWithDataTypes+    (var "cx")+    (Maps.map (ref substInTypeSchemeDef @@ var "subst") (Typing.inferenceContextDataTypes $ var "cx"))++substituteInTermDef :: TBinding (TermSubst -> Term -> Term)+substituteInTermDef = define "substituteInTerm" $+  lambda "subst" $ lets [+    "s">: Typing.unTermSubst $ var "subst",+    "rewrite">: lambdas ["recurse", "term"] $ lets [+      "withLambda">: lambda "l" $ lets [+        "v">: Core.lambdaParameter $ var "l",+        "subst2">: Typing.termSubst $ Maps.remove (var "v") (var "s")] $+        Core.termFunction $ Core.functionLambda $+          Core.lambda (var "v") (Core.lambdaDomain $ var "l") (ref substituteInTermDef @@ var "subst2" @@ (Core.lambdaBody $ var "l")),+      "withLet">: lambda "lt" $ lets [+        "bindings">: Core.letBindings $ var "lt",+        "names">: Sets.fromList $ Lists.map (unaryFunction Core.bindingName) (var "bindings"),+        "subst2">: Typing.termSubst $ Maps.filterWithKey (lambdas ["k", "v"] $ Logic.not $ Sets.member (var "k") (var "names")) (var "s"),+        "rewriteBinding">: lambda "b" $ Core.binding+          (Core.bindingName $ var "b")+          (ref substituteInTermDef @@ var "subst2" @@ (Core.bindingTerm $ var "b"))+          (Core.bindingType $ var "b")] $+        Core.termLet $ Core.let_+          (Lists.map (var "rewriteBinding") (var "bindings"))+          (ref substituteInTermDef @@ var "subst2" @@ (Core.letEnvironment $ var "lt"))] $+      cases _Term (var "term")+        (Just $ var "recurse" @@ var "term") [+        _Term_function>>: lambda "fun" $ cases _Function (var "fun")+          (Just $ var "recurse" @@ var "term") [+          _Function_lambda>>: var "withLambda"],+        _Term_let>>: var "withLet",+        _Term_variable>>: lambda "name" $ Optionals.maybe+          (var "recurse" @@ var "term")+          (lambda "sterm" $ var "sterm")+          (Maps.lookup (var "name") (var "s"))]] $+    ref Rewriting.rewriteTermDef @@ var "rewrite"++-- W: subst'+substInTypeDef :: TBinding (TypeSubst -> Type -> Type)+substInTypeDef = define "substInType" $+  lambda "subst" $ lets [+    "rewrite">: lambdas ["recurse", "typ"] $ cases _Type (var "typ") (Just $ var "recurse" @@ var "typ") [+      _Type_forall>>: lambda "lt" $ Optionals.maybe+        (var "recurse" @@ var "typ")+        (lambda "styp" $ Core.typeForall $ Core.forallType+          (Core.forallTypeParameter $ var "lt")+          (ref substInTypeDef+            @@ (var "removeVar" @@ (Core.forallTypeParameter $ var "lt"))+            @@ (Core.forallTypeBody $ var "lt")))+        (Maps.lookup (Core.forallTypeParameter $ var "lt") (Typing.unTypeSubst $ var "subst")),+      _Type_variable>>: lambda "v" $ Optionals.maybe+        (var "typ")+        (lambda "styp" $ var "styp")+        (Maps.lookup (var "v") (Typing.unTypeSubst $ var "subst"))],+    "removeVar">: lambdas ["v"] $ Typing.typeSubst $ Maps.remove (var "v") (Typing.unTypeSubst $ var "subst")] $+    (ref Rewriting.rewriteTypeDef) @@ var "rewrite"++substInTypeSchemeDef :: TBinding (TypeSubst -> TypeScheme -> TypeScheme)+substInTypeSchemeDef = define "substInTypeScheme" $+  lambdas ["subst", "ts"] $ Core.typeScheme+    (Core.typeSchemeVariables $ var "ts")+    (ref substInTypeDef @@ var "subst" @@ (Core.typeSchemeType $ var "ts"))++substTypesInTermDef :: TBinding (TypeSubst -> Term -> Term)+substTypesInTermDef = define "substTypesInTerm" $+  lambda "subst" $ lets [+    "rewrite">: lambdas ["recurse", "term"] $ lets [+      "forElimination">: lambda "elm" $ cases _Elimination (var "elm")+        (Just $ var "recurse" @@ var "term") [+        _Elimination_product>>: var "forTupleProjection"],+      "forFunction">: lambda "f" $ cases _Function (var "f")+        -- TODO: injections and case statements need a domain field as well, similar to lambdas+        (Just $ var "recurse" @@ var "term") [+        _Function_elimination>>: var "forElimination",+        _Function_lambda>>: var "forLambda"],+      "forLambda">: lambda "l" $ var "recurse" @@ (Core.termFunction $ Core.functionLambda $ Core.lambda+        (Core.lambdaParameter $ var "l")+        (Optionals.map (ref substInTypeDef @@ var "subst") $ Core.lambdaDomain $ var "l")+        (Core.lambdaBody $ var "l")),+      "forLet">: lambda "l" $ lets [+        "rewriteBinding">: lambda "b" $ Core.binding+          (Core.bindingName $ var "b")+          (Core.bindingTerm $ var "b")+          (Optionals.map (ref substInTypeSchemeDef @@ var "subst") (Core.bindingType $ var "b"))] $+        var "recurse" @@ (Core.termLet $ Core.let_+          (Lists.map (var "rewriteBinding") (Core.letBindings $ var "l"))+          (Core.letEnvironment $ var "l")),+      "forTupleProjection">: lambda "tp" $ var "recurse" @@ (Core.termFunction $ Core.functionElimination $ Core.eliminationProduct $ Core.tupleProjection+        (Core.tupleProjectionArity $ var "tp")+        (Core.tupleProjectionIndex $ var "tp")+        (Optionals.map (lambda "types" $ Lists.map (ref substInTypeDef @@ var "subst") (var "types")) (Core.tupleProjectionDomain $ var "tp"))),+      "forTypeLambda">: lambda "ta" $ lets [+        "param">: Core.typeLambdaParameter $ var "ta",+        "subst2">: Typing.typeSubst $ Maps.remove (var "param") (Typing.unTypeSubst $ var "subst")] $+        Core.termTypeLambda $ Core.typeLambda+          (var "param")+          (ref substTypesInTermDef @@ var "subst2" @@ (Core.typeLambdaBody $ var "ta"))] $+      cases _Term (var "term") (Just $ var "recurse" @@ var "term") [+        _Term_function>>: var "forFunction",+        _Term_let>>: var "forLet",+        _Term_typeLambda>>: var "forTypeLambda",+        _Term_typeApplication>>: lambda "tt" $ var "recurse" @@ (Core.termTypeApplication $ Core.typedTerm+          (Core.typedTermTerm $ var "tt")+          (ref substInTypeDef @@ var "subst" @@ (Core.typedTermType $ var "tt")))]] $+    ref Rewriting.rewriteTermDef @@ var "rewrite"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Tarjan.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Tarjan where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Constants as Constants+import qualified Hydra.Sources.Kernel.Terms.Monads as Monads++import qualified Hydra.Topology as Topo+++module_ :: Module+module_ = Module (Namespace "hydra.tarjan") elements+    [Constants.module_, Monads.module_]+    kernelTypesModules $+    Just ("This implementation of Tarjan's algorithm was originally based on GraphSCC by Iavor S. Diatchki:"+      <> " https://hackage.haskell.org/package/GraphSCC.")+  where+   elements = [+     el adjacencyListsToGraphDef,+     el stronglyConnectedComponentsDef,+     el initialStateDef,+     el popStackUntilDef,+     el strongConnectDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++adjacencyListsToGraphDef :: TBinding ([(key, [key])] -> (Topo.Graph, Topo.Vertex -> key))+adjacencyListsToGraphDef = define "adjacencyListsToGraph" $+  doc ("Given a list of adjacency lists represented as (key, [key]) pairs,"+    <> " construct a graph along with a function mapping each vertex (an Int)"+    <> " back to its original key.") $+  withOrd "t0" $+  lambda "edges0" $ lets [+    "sortedEdges">: Lists.sortOn (unaryFunction first) (var "edges0"),+    "indexedEdges">: Lists.zip (Math.range (int32 0) (Lists.length $ var "sortedEdges")) (var "sortedEdges"),+    "keyToVertex">: Maps.fromList $ Lists.map+      (lambda "vkNeighbors" $ lets [+        "v">: first $ var "vkNeighbors",+        "kNeighbors">: second $ var "vkNeighbors",+        "k">: first $ var "kNeighbors"]+        $ pair (var "k") (var "v"))+      (var "indexedEdges"),+    "vertexMap">: Maps.fromList $ Lists.map+      (lambda "vkNeighbors" $ lets [+        "v">: first $ var "vkNeighbors",+        "kNeighbors">: second $ var "vkNeighbors",+        "k">: first $ var "kNeighbors"]+        $ pair (var "v") (var "k"))+      (var "indexedEdges"),+    "graph">: Maps.fromList $ Lists.map+      (lambda "vkNeighbors" $ lets [+        "v">: first $ var "vkNeighbors",+        "kNeighbors">: second $ var "vkNeighbors",+        "neighbors">: second $ var "kNeighbors"]+        $ pair (var "v") (Optionals.mapMaybe (lambda "k" $ Maps.lookup (var "k") (var "keyToVertex")) (var "neighbors")))+      (var "indexedEdges"),+    "vertexToKey">: lambda "v" $ Optionals.fromJust $ Maps.lookup (var "v") (var "vertexMap")]+    $ pair (var "graph") (var "vertexToKey")++initialStateDef :: TBinding Topo.TarjanState+initialStateDef = define "initialState" $+  doc "Initial state for Tarjan's algorithm" $+  Topology.tarjanState (int32 0) Maps.empty Maps.empty (list []) Sets.empty (list [])++popStackUntilDef :: TBinding (Topo.Vertex -> Flow Topo.TarjanState [Topo.Vertex])+popStackUntilDef = define "popStackUntil" $+  doc "Pop vertices off the stack until the given vertex is reached, collecting the current strongly connected component" $+  lambda "v" $ lets [+    "go">: lambda "acc" $+      Flows.bind (ref Monads.getStateDef) $+        lambda "st" $+          Logic.ifElse (Lists.null $ Topology.tarjanStateStack $ var "st")+            (Flows.fail $ string "popStackUntil: empty stack")+            (lets [+              "x">: Lists.head $ Topology.tarjanStateStack $ var "st",+              "xs">: Lists.tail $ Topology.tarjanStateStack $ var "st",+              "newSt">: Topology.tarjanStateWithStack (var "st") (var "xs"),+              "newSt2">: Topology.tarjanStateWithOnStack (var "newSt") (Sets.delete (var "x") (Topology.tarjanStateOnStack $ var "st")),+              "acc'">: Lists.cons (var "x") (var "acc")]+              $ Flows.bind (ref Monads.putStateDef @@ var "newSt2") $+                lambda "_" $+                  Logic.ifElse (Equality.equal (var "x") (var "v"))+                    (Flows.pure $ Lists.reverse $ var "acc'")+                    (var "go" @@ var "acc'"))]+    $ var "go" @@ list []++strongConnectDef :: TBinding (Topo.Graph -> Topo.Vertex -> Flow Topo.TarjanState ())+strongConnectDef = define "strongConnect" $+  doc "Visit a vertex and recursively explore its successors" $+  lambdas ["graph", "v"] $+    Flows.bind (ref Monads.getStateDef) $+      lambda "st" $ lets [+        "i">: Topology.tarjanStateCounter $ var "st",+        "newSt">: Topology.tarjanState+          (Math.add (var "i") (int32 1))+          (Maps.insert (var "v") (var "i") (Topology.tarjanStateIndices $ var "st"))+          (Maps.insert (var "v") (var "i") (Topology.tarjanStateLowLinks $ var "st"))+          (Lists.cons (var "v") (Topology.tarjanStateStack $ var "st"))+          (Sets.insert (var "v") (Topology.tarjanStateOnStack $ var "st"))+          (Topology.tarjanStateSccs $ var "st"),+        "neighbors">: Maps.findWithDefault (list []) (var "v") (var "graph"),+        "processNeighbor">: lambda "w" $+          Flows.bind (ref Monads.getStateDef) $+            lambda "st'" $+              Logic.ifElse (Logic.not $ Maps.member (var "w") (Topology.tarjanStateIndices $ var "st'"))+                (Flows.bind (ref strongConnectDef @@ var "graph" @@ var "w") $+                  lambda "_" $+                    Flows.bind (ref Monads.getStateDef) $+                      lambda "stAfter" $ lets [+                        "low_v">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "v") (Topology.tarjanStateLowLinks $ var "stAfter"),+                        "low_w">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "w") (Topology.tarjanStateLowLinks $ var "stAfter")]+                        $ Flows.bind (ref Monads.modifyDef @@ (lambda "s" $+                            Topology.tarjanStateWithLowLinks (var "s")+                              (Maps.insert (var "v") (Equality.min (var "low_v") (var "low_w")) (Topology.tarjanStateLowLinks $ var "s")))) $+                          lambda "_" $ Flows.pure unit)+                (Logic.ifElse (Sets.member (var "w") (Topology.tarjanStateOnStack $ var "st'"))+                  (lets [+                    "low_v">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "v") (Topology.tarjanStateLowLinks $ var "st'"),+                    "idx_w">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "w") (Topology.tarjanStateIndices $ var "st'")]+                    $ Flows.bind (ref Monads.modifyDef @@ (lambda "s" $+                        Topology.tarjanStateWithLowLinks (var "s")+                          (Maps.insert (var "v") (Equality.min (var "low_v") (var "idx_w")) (Topology.tarjanStateLowLinks $ var "s")))) $+                      lambda "_" $ Flows.pure unit)+                  (Flows.pure unit))]+        $ Flows.bind (ref Monads.putStateDef @@ var "newSt") $+          lambda "_" $+            Flows.bind (Flows.mapList (var "processNeighbor") (var "neighbors")) $+              lambda "_" $+                Flows.bind (ref Monads.getStateDef) $+                  lambda "stFinal" $ lets [+                    "low_v">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "v") (Topology.tarjanStateLowLinks $ var "stFinal"),+                    "idx_v">: Maps.findWithDefault (ref Constants.maxInt32Def) (var "v") (Topology.tarjanStateIndices $ var "stFinal")]+                    $ Logic.ifElse (Equality.equal (var "low_v") (var "idx_v"))+                        (Flows.bind (ref popStackUntilDef @@ var "v") $+                          lambda "comp" $+                            Flows.bind (ref Monads.modifyDef @@ (lambda "s" $+                              Topology.tarjanStateWithSccs (var "s") (Lists.cons (var "comp") (Topology.tarjanStateSccs $ var "s")))) $+                              lambda "_" $ Flows.pure unit)+                        (Flows.pure unit)++stronglyConnectedComponentsDef :: TBinding (Topo.Graph -> [[Topo.Vertex]])+stronglyConnectedComponentsDef = define "stronglyConnectedComponents" $+  doc "Compute the strongly connected components of the given graph. The components are returned in reverse topological order" $+  lambda "graph" $ lets [+    "verts">: Maps.keys $ var "graph",+    "processVertex">: lambda "v" $+      Flows.bind (Flows.map (lambda "st" $ Maps.member (var "v") (Topology.tarjanStateIndices $ var "st")) $ ref Monads.getStateDef) $+        lambda "visited" $+          Logic.ifElse (Logic.not $ var "visited")+            (ref strongConnectDef @@ var "graph" @@ var "v")+            (Flows.pure unit),+    "finalState">: ref Monads.execDef @@ (Flows.mapList (var "processVertex") (var "verts")) @@ ref initialStateDef]+    $ Lists.reverse $ Lists.map (unaryFunction Lists.sort) $ Topology.tarjanStateSccs $ var "finalState"
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Templates.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Templates where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Decode.Core as DecodeCore+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+++module_ :: Module+module_ = Module (Namespace "hydra.templates") elements+    [DecodeCore.module_, ShowCore.module_]+    kernelTypesModules $+    Just "A utility which instantiates a nonrecursive type with default values"+  where+   elements = [+     el graphToSchemaDef,+     el instantiateTemplateDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++graphToSchemaDef :: TBinding (Graph -> Flow Graph (M.Map Name Type))+graphToSchemaDef = define "graphToSchema" $+  doc "Create a graph schema from a graph which contains nothing but encoded type definitions" $+  lambda "g" $ lets [+    "toPair">: lambda "nameAndEl" $ lets [+      "name">: first $ var "nameAndEl",+      "el">: second $ var "nameAndEl"]+      $ Flows.bind (ref DecodeCore.typeDef @@ (Core.bindingTerm $ var "el")) $+        lambda "t" $ Flows.pure $ pair (var "name") (var "t")]+    $ Flows.bind (Flows.mapList (var "toPair") $ Maps.toList $ Graph.graphElements $ var "g") $+      lambda "pairs" $ Flows.pure $ Maps.fromList $ var "pairs"++instantiateTemplateDef :: TBinding (Bool -> M.Map Name Type -> Type -> Flow s Term)+instantiateTemplateDef = define "instantiateTemplate" $+  doc ("Given a graph schema and a nonrecursive type, instantiate it with default values."+    <> " If the minimal flag is set, the smallest possible term is produced; otherwise, exactly one subterm"+    <> " is produced for constructors which do not otherwise require one, e.g. in lists and optionals") $+  lambdas ["minimal", "schema", "t"] $ lets [+    "inst">: ref instantiateTemplateDef @@ var "minimal" @@ var "schema",+    "noPoly">: Flows.fail $ string "Polymorphic and function types are not currently supported"]+    $ match _Type Nothing [+      _Type_annotated>>: lambda "at" $ var "inst" @@ (Core.annotatedTypeSubject $ var "at"),+      _Type_application>>: constant $ var "noPoly",+      _Type_function>>: constant $ var "noPoly",+      _Type_forall>>: constant $ var "noPoly",+      _Type_list>>: lambda "et" $ Logic.ifElse (var "minimal")+        (Flows.pure $ Core.termList $ list [])+        (Flows.bind (var "inst" @@ var "et") $+          lambda "e" $ Flows.pure $ Core.termList $ list [var "e"]),+      _Type_literal>>: lambda "lt" $ Flows.pure $ Core.termLiteral $+        cases _LiteralType (var "lt") Nothing [+          _LiteralType_binary>>: constant $ Core.literalString $ string "",+          _LiteralType_boolean>>: constant $ Core.literalBoolean false,+          _LiteralType_integer>>: lambda "it" $ Core.literalInteger $+            match _IntegerType Nothing [+              _IntegerType_bigint>>: constant $ Core.integerValueBigint $ bigint 0,+              _IntegerType_int8>>: constant $ Core.integerValueInt8 $ int8 0,+              _IntegerType_int16>>: constant $ Core.integerValueInt16 $ int16 0,+              _IntegerType_int32>>: constant $ Core.integerValueInt32 $ int32 0,+              _IntegerType_int64>>: constant $ Core.integerValueInt64 $ int64 0,+              _IntegerType_uint8>>: constant $ Core.integerValueUint8 $ uint8 0,+              _IntegerType_uint16>>: constant $ Core.integerValueUint16 $ uint16 0,+              _IntegerType_uint32>>: constant $ Core.integerValueUint32 $ uint32 0,+              _IntegerType_uint64>>: constant $ Core.integerValueUint64 $ uint64 0] @@ var "it",+          _LiteralType_float>>: lambda "ft" $ Core.literalFloat $+            cases _FloatType (var "ft") Nothing [+              _FloatType_bigfloat>>: constant $ Core.floatValueBigfloat $ bigfloat 0.0,+              _FloatType_float32>>: constant $ Core.floatValueFloat32 $ float32 0.0,+              _FloatType_float64>>: constant $ Core.floatValueFloat64 $ float64 0.0],+          _LiteralType_string>>: constant $ Core.literalString $ string ""],+      _Type_map>>: lambda "mt" $ lets [+        "kt">: Core.mapTypeKeys $ var "mt",+        "vt">: Core.mapTypeValues $ var "mt"]+        $ Logic.ifElse (var "minimal")+          (Flows.pure $ Core.termMap Maps.empty)+          (Flows.bind (var "inst" @@ var "kt") $+            lambda "ke" $+              Flows.bind (var "inst" @@ var "vt") $+                lambda "ve" $ Flows.pure $ Core.termMap $ Maps.singleton (var "ke") (var "ve")),+      _Type_optional>>: lambda "ot" $ Logic.ifElse (var "minimal")+        (Flows.pure $ Core.termOptional nothing)+        (Flows.bind (var "inst" @@ var "ot") $+          lambda "e" $ Flows.pure $ Core.termOptional $ just $ var "e"),+      _Type_product>>: lambda "types" $+        Flows.bind (Flows.mapList (var "inst") (var "types")) $+          lambda "es" $ Flows.pure $ Core.termProduct $ var "es",+      _Type_record>>: lambda "rt" $ lets [+        "tname">: Core.rowTypeTypeName $ var "rt",+        "fields">: Core.rowTypeFields $ var "rt",+        "toField">: lambda "ft" $+          Flows.bind (var "inst" @@ (Core.fieldTypeType $ var "ft")) $+            lambda "e" $ Flows.pure $ Core.field (Core.fieldTypeName $ var "ft") (var "e")]+        $ Flows.bind (Flows.mapList (var "toField") (var "fields")) $+          lambda "dfields" $ Flows.pure $ Core.termRecord $ Core.record (var "tname") (var "dfields"),+      _Type_set>>: lambda "et" $ Logic.ifElse (var "minimal")+        (Flows.pure $ Core.termSet Sets.empty)+        (Flows.bind (var "inst" @@ var "et") $+          lambda "e" $ Flows.pure $ Core.termSet $ Sets.fromList $ list [var "e"]),+      -- TODO: _Type_sum+      -- TODO: _Type_union+      -- TODO: _Type_unit>>: constant $ Flows.pure Core.termUnit,+      _Type_variable>>: lambda "tname" $+        Optionals.maybe+          (Flows.fail $ Strings.cat2 (string "Type variable ") $ Strings.cat2 (ref ShowCore.termDef @@ (Core.termVariable $ var "tname")) (string " not found in schema"))+          (var "inst")+          (Maps.lookup (var "tname") (var "schema")),+      _Type_wrap>>: lambda "wt" $ lets [+        "tname">: Core.wrappedTypeTypeName $ var "wt",+        "t'">: Core.wrappedTypeObject $ var "wt"]+        $ Flows.bind (var "inst" @@ var "t'") $+          lambda "e" $ Flows.pure $ Core.termWrap $ Core.wrappedTerm (var "tname") (var "e")] @@ var "t"++{-++-- Example of type-to-term instantiation which creates a YAML-based template out of the OpenCypher feature model.++import Hydra.Staging.Yaml.Model as Yaml+import Hydra.Monads+import Data.Map as M+import Data.Maybe as Y++ff = flowToIo bootstrapGraph++schema <- ff $ graphToSchema $ modulesToGraph [openCypherFeaturesModule]++typ <- ff $ inlineType schema $ Y.fromJust $ M.lookup _CypherFeatures schema+term <- ff $ insantiateTemplate False schema typ++encoder <- ff (coderEncode <$> yamlCoder typ)+yaml <- ff $ encoder term+putStrLn $ hydraYamlToString yaml++-}
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Unification.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Unification where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Sources.Kernel.Terms.Rewriting as Rewriting+import qualified Hydra.Sources.Kernel.Terms.Show.Core as ShowCore+import qualified Hydra.Sources.Kernel.Terms.Annotations as Annotations+import qualified Hydra.Sources.Kernel.Terms.Substitution as Substitution+++module_ :: Module+module_ = Module (Namespace "hydra.unification") elements+    [ShowCore.module_, Substitution.module_]+    kernelTypesModules $+    Just ("Utilities for type unification.")+  where+   elements = [+     el joinTypesDef,+     el unifyTypeConstraintsDef,+     el unifyTypeListsDef,+     el unifyTypesDef,+     el variableOccursInTypeDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++joinTypesDef :: TBinding (Type -> Type -> String -> Flow s [TypeConstraint])+joinTypesDef = define "joinTypes" $+  doc ("Join two types, producing a list of type constraints."+    <> "The comment is used to provide context for the constraints.") $+  lambdas ["left", "right", "comment"] $ lets [+    "sleft">: ref Rewriting.deannotateTypeDef @@ var  "left",+    "sright">: ref Rewriting.deannotateTypeDef @@ var "right",+    "joinOne">: lambdas ["l", "r"] $ Typing.typeConstraint (var "l") (var "r") ("join types; " ++ var "comment"),+    "cannotUnify">: Flows.fail ("cannot unify " ++ (ref ShowCore.typeDef @@ var "sleft") ++ " with " ++ (ref ShowCore.typeDef @@ var "sright")),+    "assertEqual">: Logic.ifElse+      (Equality.equal (var "sleft") (var "sright"))+      (Flows.pure $ list [])+      (var "cannotUnify"),+    "joinList">: lambdas ["lefts", "rights"] $ Logic.ifElse+      (Equality.equal (Lists.length (var "lefts")) (Lists.length (var "rights")))+      (Flows.pure $ Lists.zipWith (var "joinOne") (var "lefts") (var "rights"))+      (var "cannotUnify"),+    "joinRowTypes">: lambdas ["left", "right"] $ Logic.ifElse+      (Logic.and+        (Core.equalName_ (Core.rowTypeTypeName $ var "left") (Core.rowTypeTypeName $ var "right"))+        (Core.equalNameList_+          (Lists.map (unaryFunction Core.fieldTypeName) $ Core.rowTypeFields $ var "left")+          (Lists.map (unaryFunction Core.fieldTypeName) $ Core.rowTypeFields $ var "right")))+      (var "joinList"+        @@ (Lists.map (unaryFunction Core.fieldTypeType) $ Core.rowTypeFields $ var "left")+        @@ (Lists.map (unaryFunction Core.fieldTypeType) $ Core.rowTypeFields $ var "right"))+      (var "cannotUnify")] $+    cases _Type (var "sleft") (Just $ var "cannotUnify") [+      _Type_application>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_application>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (Core.applicationTypeFunction $ var "l") @@ (Core.applicationTypeFunction $ var "r"),+          var "joinOne" @@ (Core.applicationTypeArgument $ var "l") @@ (Core.applicationTypeArgument $ var "r")]],+      _Type_function>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_function>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (Core.functionTypeDomain $ var "l") @@ (Core.functionTypeDomain $ var "r"),+          var "joinOne" @@ (Core.functionTypeCodomain $ var "l") @@ (Core.functionTypeCodomain $ var "r")]],+      _Type_list>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_list>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (var "l") @@ (var "r")]],+      _Type_literal>>: constant $ var "assertEqual",+      _Type_map>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_map>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (Core.mapTypeKeys $ var "l") @@ (Core.mapTypeKeys $ var "r"),+          var "joinOne" @@ (Core.mapTypeValues $ var "l") @@ (Core.mapTypeValues $ var "r")]],+      _Type_optional>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_optional>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (var "l") @@ (var "r")]],+      _Type_product>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_product>>: lambda "r" $ var "joinList" @@ (var "l") @@ (var "r")],+      _Type_record>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_record>>: lambda "r" $ var "joinRowTypes" @@ (var "l") @@ (var "r")],+      _Type_set>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_set>>: lambda "r" $ Flows.pure $ list [+          var "joinOne" @@ (var "l") @@ (var "r")]],+      _Type_sum>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_sum>>: lambda "r" $ var "joinList" @@ (var "l") @@ (var "r")],+      _Type_union>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_union>>: lambda "r" $ var "joinRowTypes" @@ (var "l") @@ (var "r")],+      _Type_unit>>: constant $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_unit>>: constant $ Flows.pure $ list []],+      _Type_wrap>>: lambda "l" $ cases _Type (var "sright") (Just $ var "cannotUnify") [+        _Type_wrap>>: lambda "r" $ Logic.ifElse+          (Core.equalName_ (Core.wrappedTypeTypeName $ var "l") (Core.wrappedTypeTypeName $ var "r"))+          (Flows.pure $ list [+            var "joinOne" @@ (Core.wrappedTypeObject $ var "l") @@ (Core.wrappedTypeObject $ var "r")])+          (var "cannotUnify")]]++unifyTypeConstraintsDef :: TBinding (M.Map Name TypeScheme -> [TypeConstraint] -> Flow s TypeSubst)+unifyTypeConstraintsDef = define "unifyTypeConstraints" $+  doc (""+    <> "Robinson's algorithm, following https://www.cs.cornell.edu/courses/cs6110/2017sp/lectures/lec23.pdf\n"+    <> "Specifically this is an implementation of the following rules:\n"+    <> "  * Unify({(x, t)} ∪ E) = {t/x} Unify(E{t/x}) if x ∉ FV(t)\n"+    <> "  * Unify(∅) = I (the identity substitution x ↦ x)\n"+    <> "  * Unify({(x, x)} ∪ E) = Unify(E)\n"+    <> "  * Unify({(f(s1, ..., sn), f(t1, ..., tn))} ∪ E) = Unify({(s1, t1), ..., (sn, tn)} ∪ E))") $+  lambdas ["schemaTypes", "constraints"] $ lets [+    "withConstraint">: lambdas ["c", "rest"] $ lets [+      "sleft">: ref Rewriting.deannotateTypeDef @@ (Typing.typeConstraintLeft $ var "c"),+      "sright">: ref Rewriting.deannotateTypeDef @@ (Typing.typeConstraintRight $ var "c"),+      "comment">: Typing.typeConstraintComment $ var "c",+      -- TODO: this occurrence check is expensive; consider delaying it until the time of substitution+      "tryBinding">: lambdas ["v", "t"] $ Logic.ifElse (ref variableOccursInTypeDef @@ var "v" @@ var "t")+        (Flows.fail $ "Variable " ++ (Core.unName $ var "v") ++ " appears free in type " ++ (ref ShowCore.typeDef @@ var "t")+          ++ " (" ++ var "comment" ++ ")")+        (var "bind" @@ var "v" @@ var "t"),+      "bind">: lambdas ["v", "t"] $ lets [+        "subst">: ref Substitution.singletonTypeSubstDef @@ var "v" @@ var "t",+        "withResult">: lambda "s" $ ref Substitution.composeTypeSubstDef @@ var "subst" @@ var "s"] $+        Flows.map (var "withResult") (ref unifyTypeConstraintsDef @@ var "schemaTypes" @@ (ref Substitution.substituteInConstraintsDef @@ var "subst" @@ var "rest")),+      "noVars">: lets [+        "withConstraints">: lambda "constraints2" $ ref unifyTypeConstraintsDef @@ var "schemaTypes" @@ (Lists.concat2 (var "constraints2") (var "rest"))] $+        Flows.bind (ref joinTypesDef @@ var "sleft" @@ var "sright" @@ var "comment") (var "withConstraints")] $+      cases _Type (var "sleft")+        (Just $ cases _Type (var "sright")+          (Just $ var "noVars") [+          _Type_variable>>: lambda "name" $ var "tryBinding" @@ var "name" @@ var "sleft"]) [+        _Type_variable>>: lambda "name" $ cases _Type (var "sright")+          (Just $ var "tryBinding" @@ var "name" @@ var "sright") [+          _Type_variable>>: lambda "name2" $ Logic.ifElse (Core.equalName_ (var "name") (var "name2"))+            (ref unifyTypeConstraintsDef @@ var "schemaTypes" @@ var "rest")+            -- Avoid replacing schema type references with temporary type variables.+            (Logic.ifElse (Optionals.isJust $ Maps.lookup (var "name") (var "schemaTypes"))+              (Logic.ifElse (Optionals.isJust $ Maps.lookup (var "name2") (var "schemaTypes"))+                (Flows.fail $ "Attempted to unify schema names " ++ (Core.unName $ var "name") ++ " and " ++ (Core.unName $ var "name2")+                  ++ " (" ++ var "comment" ++ ")")+                (var "bind" @@ var "name2" @@ var "sleft"))+              (var "bind" @@ var "name" @@ var "sright"))]]] $+    Logic.ifElse+      (Lists.null $ var "constraints")+      (Flows.pure $ ref Substitution.idTypeSubstDef)+      (var "withConstraint" @@ (Lists.head $ var "constraints") @@ (Lists.tail $ var "constraints"))++unifyTypeListsDef :: TBinding (M.Map Name TypeScheme -> [Type] -> [Type] -> String -> Flow s TypeSubst)+unifyTypeListsDef = define "unifyTypeLists" $+  lambdas ["schemaTypes", "l", "r", "comment"] $ lets [+    "toConstraint">: lambdas ["l", "r"] $ Typing.typeConstraint (var "l") (var "r") (var "comment")] $+    ref unifyTypeConstraintsDef @@ var "schemaTypes" @@ (Lists.zipWith (var "toConstraint") (var "l") (var "r"))++unifyTypesDef :: TBinding (M.Map Name TypeScheme -> Type -> Type -> String -> Flow s TypeSubst)+unifyTypesDef = define "unifyTypes" $+  lambdas ["schemaTypes", "l", "r", "comment"] $+    ref unifyTypeConstraintsDef @@ var "schemaTypes" @@ list [Typing.typeConstraint (var "l") (var "r") (var "comment")]++variableOccursInTypeDef :: TBinding (Name -> Type -> Bool)+variableOccursInTypeDef = define "variableOccursInType" $+  doc ("Determine whether a type variable appears within a type expression."+    <> "No distinction is made between free and bound type variables.") $+  lambda "var" $ lets [+    "tryType">: lambdas ["b", "typ"] $ match _Type (Just $ var "b") [+      _Type_variable>>: lambda "v" $ Logic.or (var "b") (Core.equalName_ (var "v") (var "var"))]+      @@ var "typ"] $+    ref Rewriting.foldOverTypeDef @@ Coders.traversalOrderPre @@ var "tryType" @@ false
+ src/main/haskell/Hydra/Sources/Kernel/Terms/Variants.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Terms.Variants where++-- Standard imports for term-level kernel modules+import Hydra.Kernel+import Hydra.Sources.Libraries+import qualified Hydra.Dsl.Accessors     as Accessors+import qualified Hydra.Dsl.Ast           as Ast+import qualified Hydra.Dsl.Coders        as Coders+import qualified Hydra.Dsl.Compute       as Compute+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Grammar       as Grammar+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Json          as Json+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Flows     as Flows+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import           Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Mantle        as Mantle+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.TTerms        as TTerms+import qualified Hydra.Dsl.TTypes        as TTypes+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Topology      as Topology+import qualified Hydra.Dsl.Types         as Types+import qualified Hydra.Dsl.Typing        as Typing+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.Int                as I+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y+++module_ :: Module+module_ = Module (Namespace "hydra.variants") elements+    []+    kernelTypesModules $+    Just ("Functions for working with term, type, and literal type variants, as well as numeric precision.")+  where+    elements = [+      el eliminationVariantDef,+      el eliminationVariantsDef,+      el floatTypePrecisionDef,+      el floatTypesDef,+      el floatValueTypeDef,+      el functionVariantDef,+      el functionVariantsDef,+      el integerTypeIsSignedDef,+      el integerTypePrecisionDef,+      el integerTypesDef,+      el integerValueTypeDef,+      el literalTypeDef,+      el literalTypeVariantDef,+      el literalTypesDef,+      el literalVariantDef,+      el literalVariantsDef,+      el termVariantDef,+      el termVariantsDef,+      el typeVariantDef,+      el typeVariantsDef]++define :: String -> TTerm a -> TBinding a+define = definitionInModule module_++eliminationVariantDef :: TBinding (Elimination -> EliminationVariant)+eliminationVariantDef = define "eliminationVariant" $+  doc "Find the elimination variant (constructor) for a given elimination term" $+  match _Elimination Nothing [+    _Elimination_product>>: constant Mantle.eliminationVariantProduct,+    _Elimination_record>>: constant Mantle.eliminationVariantRecord,+    _Elimination_union>>: constant Mantle.eliminationVariantUnion,+    _Elimination_wrap>>: constant Mantle.eliminationVariantWrap]++eliminationVariantsDef :: TBinding [EliminationVariant]+eliminationVariantsDef = define "eliminationVariants" $+  doc "All elimination variants (constructors), in a canonical order" $+  list $ unitVariant _EliminationVariant <$> [+    _EliminationVariant_product,+    _EliminationVariant_record,+    _EliminationVariant_union,+    _EliminationVariant_wrap]++floatTypePrecisionDef :: TBinding (FloatType -> Precision)+floatTypePrecisionDef = define "floatTypePrecision" $+  doc "Find the precision of a given floating-point type" $+  match _FloatType Nothing [+    _FloatType_bigfloat>>: constant Mantle.precisionArbitrary,+    _FloatType_float32>>: constant $ Mantle.precisionBits $ int32 32,+    _FloatType_float64>>: constant $ Mantle.precisionBits $ int32 64]++floatTypesDef :: TBinding [FloatType]+floatTypesDef = define "floatTypes" $+  doc "All floating-point types in a canonical order" $+  list $ unitVariant _FloatType <$> [+    _FloatType_bigfloat,+    _FloatType_float32,+    _FloatType_float64]++floatValueTypeDef :: TBinding (FloatValue -> FloatType)+floatValueTypeDef = define "floatValueType" $+  doc "Find the float type for a given floating-point value" $+  match _FloatValue Nothing [+    _FloatValue_bigfloat>>: constant Core.floatTypeBigfloat,+    _FloatValue_float32>>: constant Core.floatTypeFloat32,+    _FloatValue_float64>>: constant Core.floatTypeFloat64]++functionVariantDef :: TBinding (Function -> FunctionVariant)+functionVariantDef = define "functionVariant" $+  doc "Find the function variant (constructor) for a given function" $+  match _Function Nothing [+    _Function_elimination>>: constant Mantle.functionVariantElimination,+    _Function_lambda>>: constant Mantle.functionVariantLambda,+    _Function_primitive>>: constant Mantle.functionVariantPrimitive]++functionVariantsDef :: TBinding [FunctionVariant]+functionVariantsDef = define "functionVariants" $+  doc "All function variants (constructors), in a canonical order" $+  list $ unitVariant _FunctionVariant <$> [+    _FunctionVariant_elimination,+    _FunctionVariant_lambda,+    _FunctionVariant_primitive]++integerTypeIsSignedDef :: TBinding (IntegerType -> Bool)+integerTypeIsSignedDef = define "integerTypeIsSigned" $+  doc "Find whether a given integer type is signed (true) or unsigned (false)" $+  match _IntegerType Nothing [+    _IntegerType_bigint>>: constant true,+    _IntegerType_int8>>:   constant true,+    _IntegerType_int16>>:  constant true,+    _IntegerType_int32>>:  constant true,+    _IntegerType_int64>>:  constant true,+    _IntegerType_uint8>>:  constant false,+    _IntegerType_uint16>>: constant false,+    _IntegerType_uint32>>: constant false,+    _IntegerType_uint64>>: constant false]++integerTypePrecisionDef :: TBinding (IntegerType -> Precision)+integerTypePrecisionDef = define "integerTypePrecision" $+  doc "Find the precision of a given integer type" $+  match _IntegerType Nothing [+    _IntegerType_bigint>>: constant Mantle.precisionArbitrary,+    _IntegerType_int8>>: constant $ Mantle.precisionBits $ int32 8,+    _IntegerType_int16>>: constant $ Mantle.precisionBits $ int32 16,+    _IntegerType_int32>>: constant $ Mantle.precisionBits $ int32 32,+    _IntegerType_int64>>: constant $ Mantle.precisionBits $ int32 64,+    _IntegerType_uint8>>: constant $ Mantle.precisionBits $ int32 8,+    _IntegerType_uint16>>: constant $ Mantle.precisionBits $ int32 16,+    _IntegerType_uint32>>: constant $ Mantle.precisionBits $ int32 32,+    _IntegerType_uint64>>: constant $ Mantle.precisionBits $ int32 64]++integerTypesDef :: TBinding [IntegerType]+integerTypesDef = define "integerTypes" $+  doc "All integer types, in a canonical order" $+  list $ unitVariant _IntegerType <$> [+    _IntegerType_bigint,+    _IntegerType_int8,+    _IntegerType_int16,+    _IntegerType_int32,+    _IntegerType_int64,+    _IntegerType_uint8,+    _IntegerType_uint16,+    _IntegerType_uint32,+    _IntegerType_uint64]++integerValueTypeDef :: TBinding (IntegerValue -> IntegerType)+integerValueTypeDef = define "integerValueType" $+  doc "Find the integer type for a given integer value" $+  match _IntegerValue Nothing [+    _IntegerValue_bigint>>: constant Core.integerTypeBigint,+    _IntegerValue_int8>>: constant Core.integerTypeInt8,+    _IntegerValue_int16>>: constant Core.integerTypeInt16,+    _IntegerValue_int32>>: constant Core.integerTypeInt32,+    _IntegerValue_int64>>: constant Core.integerTypeInt64,+    _IntegerValue_uint8>>: constant Core.integerTypeUint8,+    _IntegerValue_uint16>>: constant Core.integerTypeUint16,+    _IntegerValue_uint32>>: constant Core.integerTypeUint32,+    _IntegerValue_uint64>>: constant Core.integerTypeUint64]++literalTypeDef :: TBinding (Literal -> LiteralType)+literalTypeDef = define "literalType" $+  doc "Find the literal type for a given literal value" $+  match _Literal Nothing [+    _Literal_binary>>: constant $ variant _LiteralType _LiteralType_binary unit,+    _Literal_boolean>>: constant $ variant _LiteralType _LiteralType_boolean unit,+    _Literal_float>>: injectLambda _LiteralType _LiteralType_float <.> ref floatValueTypeDef,+    _Literal_integer>>: injectLambda _LiteralType _LiteralType_integer <.> ref integerValueTypeDef,+    _Literal_string>>: constant $ variant _LiteralType _LiteralType_string unit]++literalTypeVariantDef :: TBinding (LiteralType -> LiteralVariant)+literalTypeVariantDef = define "literalTypeVariant" $+  doc "Find the literal type variant (constructor) for a given literal value" $+  match _LiteralType Nothing [+    _LiteralType_binary>>:  constant $ Mantle.literalVariantBinary,+    _LiteralType_boolean>>: constant $ Mantle.literalVariantBoolean,+    _LiteralType_float>>:   constant $ Mantle.literalVariantFloat,+    _LiteralType_integer>>: constant $ Mantle.literalVariantInteger,+    _LiteralType_string>>:  constant $ Mantle.literalVariantString]++literalTypesDef :: TBinding [LiteralType]+literalTypesDef = define "literalTypes" $+  doc "All literal types, in a canonical order" $+  Lists.concat $ list [+    list [+      Core.literalTypeBinary,+      Core.literalTypeBoolean],+    Lists.map (unaryFunction Core.literalTypeFloat) (ref floatTypesDef),+    Lists.map (unaryFunction Core.literalTypeInteger) (ref integerTypesDef),+    list [+      Core.literalTypeString]]++literalVariantDef :: TBinding (Literal -> LiteralVariant)+literalVariantDef = define "literalVariant" $+  doc "Find the literal variant (constructor) for a given literal value" $+  ref literalTypeVariantDef <.> ref literalTypeDef++literalVariantsDef :: TBinding [LiteralVariant]+literalVariantsDef = define "literalVariants" $+  doc "All literal variants, in a canonical order" $+  list $ unitVariant _LiteralVariant <$> [+    _LiteralVariant_binary,+    _LiteralVariant_boolean,+    _LiteralVariant_float,+    _LiteralVariant_integer,+    _LiteralVariant_string]++termVariantDef :: TBinding (Term -> TermVariant)+termVariantDef = define "termVariant" $+  doc "Find the term variant (constructor) for a given term" $+  match _Term Nothing [+    _Term_annotated>>: constant Mantle.termVariantAnnotated,+    _Term_application>>: constant Mantle.termVariantApplication,+    _Term_function>>: constant Mantle.termVariantFunction,+    _Term_let>>: constant Mantle.termVariantLet,+    _Term_list>>: constant Mantle.termVariantList,+    _Term_literal>>: constant Mantle.termVariantLiteral,+    _Term_map>>: constant Mantle.termVariantMap,+    _Term_optional>>: constant Mantle.termVariantOptional,+    _Term_product>>: constant Mantle.termVariantProduct,+    _Term_record>>: constant Mantle.termVariantRecord,+    _Term_set>>: constant Mantle.termVariantSet,+    _Term_sum>>: constant Mantle.termVariantSum,+    _Term_typeApplication>>: constant Mantle.termVariantTypeApplication,+    _Term_typeLambda>>: constant Mantle.termVariantTypeLambda,+    _Term_union>>: constant Mantle.termVariantUnion,+    _Term_unit>>: constant Mantle.termVariantUnit,+    _Term_variable>>: constant Mantle.termVariantVariable,+    _Term_wrap>>: constant Mantle.termVariantWrap]++termVariantsDef :: TBinding [TermVariant]+termVariantsDef = define "termVariants" $+  doc "All term (expression) variants, in a canonical order" $+  list $ unitVariant _TermVariant <$> [+    _TermVariant_annotated,+    _TermVariant_application,+    _TermVariant_literal,+    _TermVariant_function,+    _TermVariant_list,+    _TermVariant_map,+    _TermVariant_optional,+    _TermVariant_product,+    _TermVariant_record,+    _TermVariant_set,+    _TermVariant_sum,+    _TermVariant_typeLambda,+    _TermVariant_typeApplication,+    _TermVariant_union,+    _TermVariant_unit,+    _TermVariant_variable,+    _TermVariant_wrap]++typeVariantDef :: TBinding (Type -> TypeVariant)+typeVariantDef = define "typeVariant" $+  doc "Find the type variant (constructor) for a given type" $+  match _Type Nothing [+    _Type_annotated>>: constant Mantle.typeVariantAnnotated,+    _Type_application>>: constant Mantle.typeVariantApplication,+    _Type_function>>: constant Mantle.typeVariantFunction,+    _Type_forall>>: constant Mantle.typeVariantForall,+    _Type_list>>: constant Mantle.typeVariantList,+    _Type_literal>>: constant Mantle.typeVariantLiteral,+    _Type_map>>: constant Mantle.typeVariantMap,+    _Type_optional>>: constant Mantle.typeVariantOptional,+    _Type_product>>: constant Mantle.typeVariantProduct,+    _Type_record>>: constant Mantle.typeVariantRecord,+    _Type_set>>: constant Mantle.typeVariantSet,+    _Type_sum>>: constant Mantle.typeVariantSum,+    _Type_union>>: constant Mantle.typeVariantUnion,+    _Type_unit>>: constant Mantle.typeVariantUnit,+    _Type_variable>>: constant Mantle.typeVariantVariable,+    _Type_wrap>>: constant Mantle.typeVariantWrap]++typeVariantsDef :: TBinding [TypeVariant]+typeVariantsDef = define "typeVariants" $+  doc "All type variants, in a canonical order" $+  list $ unitVariant _TypeVariant <$> [+    _TypeVariant_annotated,+    _TypeVariant_application,+    _TypeVariant_function,+    _TypeVariant_forall,+    _TypeVariant_list,+    _TypeVariant_literal,+    _TypeVariant_map,+    _TypeVariant_wrap,+    _TypeVariant_optional,+    _TypeVariant_product,+    _TypeVariant_record,+    _TypeVariant_set,+    _TypeVariant_sum,+    _TypeVariant_union,+    _TypeVariant_unit,+    _TypeVariant_variable]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Accessors.hs view
@@ -0,0 +1,69 @@+module Hydra.Sources.Kernel.Types.Accessors where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just "A model for term access patterns"+  where+    ns = Namespace "hydra.accessors"+    def = datatype ns+    accessors = typeref ns+    core = typeref $ moduleNamespace Core.module_++    elements = [++      def "AccessorEdge" $+        record [+          "source">: accessors "AccessorNode",+          "path">: accessors "AccessorPath",+          "target">: accessors "AccessorNode"],++      def "AccessorGraph" $+        record [+          "nodes">: list $ accessors "AccessorNode",+          "edges">: list $ accessors "AccessorEdge"],++      def "AccessorNode" $+        record [+          "name">: core "Name",+          "label">: string,+          "id" >: string],++      def "AccessorPath" $+        wrap $ list $ accessors "TermAccessor",++      def "TermAccessor" $+        doc "A function which maps from a term to a particular immediate subterm" $+        union [+          "annotatedSubject">: unit,+          "applicationFunction">: unit,+          "applicationArgument">: unit,+          "lambdaBody">: unit,+          "unionCasesDefault">: unit,+          "unionCasesBranch">: core "Name",+          "letEnvironment">: unit,+          "letBinding">: core "Name",+          "listElement">: int32,+          "mapKey">: int32,+          "mapValue">: int32,+          "optionalTerm">: unit,+          "productTerm">: int32,+          "recordField">: core "Name",+          "setElement">: int32,+          "sumTerm">: unit,+          "typeLambdaBody">: unit,+          "typeApplicationTerm">: unit,+          "injectionTerm">: unit,+          "wrappedTerm">: unit]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/All.hs view
@@ -0,0 +1,47 @@+-- | All of Hydra's type-level kernel modules+module Hydra.Sources.Kernel.Types.All where++import Hydra.Kernel++import qualified Hydra.Sources.Kernel.Types.Accessors   as Accessors+import qualified Hydra.Sources.Kernel.Types.Ast         as Ast+import qualified Hydra.Sources.Kernel.Types.Coders      as Coders+import qualified Hydra.Sources.Kernel.Types.Compute     as Compute+import qualified Hydra.Sources.Kernel.Types.Constraints as Constraints+import qualified Hydra.Sources.Kernel.Types.Core        as Core+import qualified Hydra.Sources.Kernel.Types.Grammar     as Grammar+import qualified Hydra.Sources.Kernel.Types.Graph       as Graph+import qualified Hydra.Sources.Kernel.Types.Json        as Json+import qualified Hydra.Sources.Kernel.Types.Mantle      as Mantle+import qualified Hydra.Sources.Kernel.Types.Module      as Module+import qualified Hydra.Sources.Kernel.Types.Phantoms    as Phantoms+import qualified Hydra.Sources.Kernel.Types.Query       as Query+import qualified Hydra.Sources.Kernel.Types.Relational  as Relational+import qualified Hydra.Sources.Kernel.Types.Tabular     as Tabular+import qualified Hydra.Sources.Kernel.Types.Testing     as Testing+import qualified Hydra.Sources.Kernel.Types.Topology    as Topology+import qualified Hydra.Sources.Kernel.Types.Typing      as Typing+import qualified Hydra.Sources.Kernel.Types.Workflow    as Workflow+++kernelTypesModules :: [Module]+kernelTypesModules = [+  Accessors.module_,+  Ast.module_,+  Coders.module_,+  Compute.module_,+  Constraints.module_,+  Core.module_,+  Grammar.module_,+  Graph.module_,+  Json.module_,+  Mantle.module_,+  Module.module_,+  Phantoms.module_,+  Query.module_,+  Relational.module_,+  Tabular.module_,+  Testing.module_,+  Topology.module_,+  Typing.module_,+  Workflow.module_]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Ast.hs view
@@ -0,0 +1,106 @@+module Hydra.Sources.Kernel.Types.Ast where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just "A model which provides a common syntax tree for Hydra serializers"+  where+    ns = Namespace "hydra.ast"+    def = datatype ns+    ast = typeref ns++    elements = [++      def "Associativity" $+        doc "Operator associativity" $+        enum ["none", "left", "right", "both"],++      def "BlockStyle" $+        doc "Formatting option for code blocks" $+        record [+          "indent">: optional string,+          "newlineBeforeContent">: boolean,+          "newlineAfterContent">: boolean],++      def "BracketExpr" $+        doc "An expression enclosed by brackets" $+        record [+          "brackets">: ast "Brackets",+          "enclosed">: ast "Expr",+          "style">: ast "BlockStyle"],++      def "Brackets" $+        doc "Matching open and close bracket symbols" $+        record [+          "open">: ast "Symbol",+          "close">: ast "Symbol"],++      def "Expr" $+        doc "An abstract expression" $+        union [+          "const">: ast "Symbol",+          "indent">: ast "IndentedExpression",+          "op">: ast "OpExpr",+          "brackets">: ast "BracketExpr"],++      def "IndentedExpression" $+        doc "An expression indented in a certain style" $+        record [+          "style">: ast "IndentStyle",+          "expr">: ast "Expr"],++      def "IndentStyle" $+        doc "Any of several indentation styles" $+        union [+          "allLines">: string,+          "subsequentLines">: string],++      def "Op" $+        doc "An operator symbol" $+        record [+          "symbol">: ast "Symbol",+          "padding">: ast "Padding",+          "precedence">: ast "Precedence",+          "associativity">: ast "Associativity"],++      def "OpExpr" $+        doc "An operator expression" $+        record [+          "op">: ast "Op",+          "lhs">: ast "Expr",+          "rhs">: ast "Expr"],++      def "Padding" $+        doc "Left and right padding for an operator" $+        record [+          "left">: ast "Ws",+          "right">: ast "Ws"],++      def "Precedence" $+        doc "Operator precedence" $+        wrap int32,++      def "Symbol" $+        doc "Any symbol" $+        wrap string,++      def "Ws" $+        doc "One of several classes of whitespace" $+        union [+          "none">: unit,+          "space">: unit,+          "break">: unit,+          "breakAndIndent">: string,+          "doubleBreak">: unit]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Coders.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Coders where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Compute as Compute+import qualified Hydra.Sources.Kernel.Types.Graph as Graph+import qualified Hydra.Sources.Kernel.Types.Mantle as Mantle+++module_ :: Module+module_ = Module ns elements [Graph.module_, Compute.module_] [Core.module_] $+    Just "Abstractions for paired transformations between languages"+  where+    ns = Namespace "hydra.coders"+    core = typeref $ moduleNamespace Core.module_+    compute = typeref $ moduleNamespace Compute.module_+    graph = typeref $ moduleNamespace Graph.module_+    mantle = typeref $ moduleNamespace Mantle.module_+    coders = typeref ns++    def = datatype ns++    elements = [++      def "AdapterContext" $+        doc "An evaluation context together with a source language and a target language" $+        record [+          "graph">: graph "Graph",+          "language">: coders "Language",+          "adapters">: Types.map (core "Name") (compute "Adapter"+            @@ coders "AdapterContext" @@ coders "AdapterContext"+            @@ core "Type" @@ core "Type"+            @@ core "Term" @@ core "Term")],++      def "CoderDirection" $+        doc "Indicates either the 'out' or the 'in' direction of a coder" $+        enum [+          "encode",+          "decode"],++      def "Language" $+        doc "A named language together with language-specific constraints" $+        record [+          "name">: coders "LanguageName",+          "constraints">: coders "LanguageConstraints"],++      def "LanguageConstraints" $+        doc "A set of constraints on valid type and term expressions, characterizing a language" $+        record [+          "eliminationVariants">:+            doc "All supported elimination variants" $+            Types.set $ mantle "EliminationVariant",+          "literalVariants">:+            doc "All supported literal variants" $+            Types.set $ mantle "LiteralVariant",+          "floatTypes">:+            doc "All supported float types" $+            Types.set $ core "FloatType",+          "functionVariants">:+            doc "All supported function variants" $+            Types.set $ mantle "FunctionVariant",+          "integerTypes">:+            doc "All supported integer types" $+            Types.set $ core "IntegerType",+          "termVariants">:+            doc "All supported term variants" $+            Types.set $ mantle "TermVariant",+          "typeVariants">:+            doc "All supported type variants" $+            Types.set $ mantle "TypeVariant",+          "types">:+            doc "A logical set of types, as a predicate which tests a type for inclusion" $+            core "Type" --> boolean],++      def "LanguageName" $+        doc "The unique name of a language" $+        wrap string,++      def "SymmetricAdapter" $+        doc "A bidirectional encoder which maps between the same type and term languages on either side" $+        forAlls ["s", "t", "v"] $ compute "Adapter" @@ "s" @@ "s" @@ "t" @@ "t" @@ "v" @@ "v",++      def "TraversalOrder" $+        doc "Specifies either a pre-order or post-order traversal" $+        union [+          "pre">: doc "Pre-order traversal" unit,+          "post">: doc "Post-order traversal" unit],++      def "TypeAdapter" $+        doc "A function which maps a Hydra type to a symmetric adapter between types and terms" $+        core "Type" --> compute "Flow" @@ coders "AdapterContext" @@+          (coders "SymmetricAdapter" @@ coders "AdapterContext" @@ core "Type" @@ core "Term")]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Compute.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Compute where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just "Abstractions for single- and bidirectional transformations"+  where+    ns = Namespace "hydra.compute"+    core = typeref $ moduleNamespace Core.module_+    compute = typeref ns++    def = datatype ns++    elements = [++      def "Adapter" $+        doc "A two-level bidirectional encoder which adapts types to types and terms to terms" $+        forAlls ["s1", "s2", "t1", "t2", "v1", "v2"] $ record [+          "isLossy">: boolean,+          "source">: var "t1",+          "target">: var "t2",+          "coder">: compute "Coder" @@ "s1" @@ "s2" @@ "v1" @@ "v2"],++      def "Bicoder" $+        doc "A two-level encoder and decoder, operating both at a type level and an instance (data) level" $+        forAlls ["s1", "s2", "t1", "t2", "v1", "v2"] $ record [+          "encode">: "t1" --> compute "Adapter" @@ "s1" @@ "s2" @@ "t1" @@ "t2" @@ "v1" @@ "v2",+          "decode">: "t2" --> compute "Adapter" @@ "s2" @@ "s1" @@ "t2" @@ "t1" @@ "v2" @@ "v1"],++      def "Coder" $+        doc "An encoder and decoder; a bidirectional flow between two types" $+        forAlls ["s1", "s2", "v1", "v2"] $ record [+          "encode">: ("v1" --> compute "Flow" @@ "s1" @@ "v2"),+          "decode">: ("v2" --> compute "Flow" @@ "s2" @@ "v1")],++      def "Flow" $+        doc "A variant of the State monad with built-in logging and error handling" $+        forAlls ["s", "v"] $ wrap $+        function "s" (compute "Trace" --> compute "FlowState" @@ "s" @@ "v"),++      def "FlowState" $+        doc "The result of evaluating a Flow" $+        forAlls ["s", "v"] $ record [+          "value">: optional "v",+          "state">: "s",+          "trace">: compute "Trace"],++      def "Trace" $+        doc "A container for logging and error information" $+        record [+          "stack">: list string,+          "messages">: list string,+          "other">:+            doc "A map of string keys to arbitrary terms as values, for application-specific use" $+            Types.map (core "Name") (core "Term")]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Constraints.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Constraints where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Query as Query+++module_ :: Module+module_ = Module ns elements [Query.module_] [Core.module_] $+    Just "A model for path- and pattern-based graph constraints, which may be considered as part of the schema of a graph"+  where+    ns = Namespace "hydra.constraints"+    core = typeref $ moduleNamespace Core.module_+    query = typeref $ moduleNamespace Query.module_+    constraints = typeref ns+    def = datatype ns++    elements = [++      def "PathEquation" $+        doc "A declared equivalence between two abstract paths in a graph" $+        record [+          "left">: query "Path",+          "right">: query "Path"],++      def "PatternImplication" $+        doc "A pattern which, if it matches in a given graph, implies that another pattern must also match. Query variables are shared between the two patterns." $+        record [+          "antecedent">: query "Pattern",+          "consequent">: query "Pattern"]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Core.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Core where++import Hydra.Kernel+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types+++hydraCoreGraph :: Graph+hydraCoreGraph = elementsToGraph bootstrapGraph Nothing (moduleElements module_)++module_ :: Module+module_ = Module ns elements [] [module_] $ -- Note: hydra.core uniquely takes itself as a type-level dependency+    Just "Hydra's core data model, consisting of the fundamental hydra.core.Term type and all of its dependencies."+  where+    ns = Namespace "hydra.core"+    core = typeref ns+    def = datatype ns+    doc s = setTypeDescription (Just s)++    elements = [++      def "AnnotatedTerm" $+        doc "A term together with an annotation" $+        record [+          "subject">: core "Term",+          "annotation">: Types.map (core "Name") $ core "Term"],++      def "AnnotatedType" $+        doc "A type together with an annotation" $+        record [+          "subject">: core "Type",+          "annotation">: Types.map (core "Name") $ core "Term"],++      def "Application" $+        doc "A term which applies a function to an argument" $+        record [+          "function">:+            doc "The left-hand side of the application" $+            core "Term",+          "argument">:+            doc "The right-hand side of the application" $+            core "Term"],++      def "ApplicationType" $+        doc "The type-level analog of an application term" $+        record [+          "function">:+            doc "The left-hand side of the application" $+            core "Type",+          "argument">:+            doc "The right-hand side of the application" $+            core "Type"],++      def "CaseStatement" $+        doc "A union elimination; a case statement" $+        record [+          "typeName">: core "Name",+          "default">: optional (core "Term"),+          "cases">: list $ core "Field"],++      def "Elimination" $+        doc "A corresponding elimination for an introduction term" $+        union [+          "product">:+            doc "Eliminates a tuple by projecting the component at a given 0-indexed offset" $+            core "TupleProjection",+          "record">:+            doc "Eliminates a record by projecting a given field" $+            core "Projection",+          "union">:+            doc "Eliminates a union term by matching over the fields of the union. This is a case statement." $+            core "CaseStatement",+          "wrap">:+            doc "Unwrap a wrapped term" $+            core "Name"],++      def "Field" $+        doc "A name/term pair" $+        record [+          "name">: core "Name",+          "term">: core "Term"],++      def "FieldType" $+        doc "A name/type pair" $+        record [+          "name">: core "Name",+          "type">: core "Type"],++      def "FloatType" $+        doc "A floating-point type" $+        enum [+          "bigfloat",+          "float32",+          "float64"],++      def "FloatValue" $+        doc "A floating-point literal value" $+        union [+          "bigfloat">:+            doc "An arbitrary-precision floating-point value" bigfloat,+          "float32">:+            doc "A 32-bit floating-point value" float32,+          "float64">:+            doc "A 64-bit floating-point value" float64],++      def "ForallType" $+        doc "A universally quantified type; the System F equivalent of a type scheme, and the type-level equivalent of a lambda term." $+        record [+          "parameter">:+            doc "The variable which is bound by the lambda" $+            core "Name",+          "body">:+            doc "The body of the lambda" $+            core "Type"],++      def "Function" $+        doc "A function" $+        union [+          "elimination">:+            doc "An elimination for any of a few term variants" $+            core "Elimination",+          "lambda">:+            doc "A function abstraction (lambda)" $+            core "Lambda",+          "primitive">:+            doc "A reference to a built-in (primitive) function" $+            core "Name"],++      def "FunctionType" $+        doc "A function type, also known as an arrow type" $+        record [+          "domain">: core "Type",+          "codomain">: core "Type"],++      def "Injection" $+        doc "An instance of a union type; i.e. a string-indexed generalization of inl() or inr()" $+        record [+          "typeName">: core "Name",+          "field">: core "Field"],++      def "IntegerType" $+        doc "An integer type" $+        enum [+          "bigint",+          "int8",+          "int16",+          "int32",+          "int64",+          "uint8",+          "uint16",+          "uint32",+          "uint64"],++      def "IntegerValue" $+        doc "An integer literal value" $+        union [+          "bigint">:+            doc "An arbitrary-precision integer value" bigint,+          "int8">:+            doc "An 8-bit signed integer value" int8,+          "int16">:+            doc "A 16-bit signed integer value (short value)" int16,+          "int32">:+            doc "A 32-bit signed integer value (int value)" int32,+          "int64">:+            doc "A 64-bit signed integer value (long value)" int64,+          "uint8">:+            doc "An 8-bit unsigned integer value (byte)" uint8,+          "uint16">:+            doc "A 16-bit unsigned integer value" uint16,+          "uint32">:+            doc "A 32-bit unsigned integer value (unsigned int)" uint32,+          "uint64">:+            doc "A 64-bit unsigned integer value (unsigned long)" uint64],++      def "Lambda" $+        doc "A function abstraction (lambda)" $+        record [+          "parameter">:+            doc "The parameter of the lambda" $+            core "Name",+          "domain">:+            doc "An optional domain type for the lambda" $+            optional $ core "Type",+          "body">:+            doc "The body of the lambda" $+            core "Term"],++      def "Let" $+        doc "A set of (possibly recursive) 'let' bindings together with an environment in which they are bound" $+        record [+          "bindings">: list $ core "Binding",+          "environment">: core "Term"],++      def "Binding" $+        doc "A field with an optional type scheme, used to bind variables to terms in a 'let' expression" $+        record [+          "name">: core "Name",+          "term">: core "Term",+          "type">: optional $ core "TypeScheme"],++      def "Literal" $+        doc "A term constant; an instance of a literal type" $+        union [+          "binary">:+            doc "A binary literal" binary,+          "boolean">:+            doc "A boolean literal" boolean,+          "float">:+            doc "A floating-point literal" $ core "FloatValue",+          "integer">:+            doc "An integer literal" $+            core "IntegerValue",+          "string">:+            doc "A string literal" string],++      def "LiteralType" $+        doc "Any of a fixed set of literal types, also called atomic types, base types, primitive types, or type constants" $+        union [+          "binary">:+             doc "The type of a binary (byte string) value" unit,+          "boolean">:+            doc "The type of a boolean (true/false) value" unit,+          "float">:+            doc "The type of a floating-point value" $+            core "FloatType",+          "integer">:+            doc "The type of an integer value" $+            core "IntegerType",+          "string">:+            doc "The type of a string value" unit],++      def "MapType" $+        doc "A map type" $+        record [+          "keys">: core "Type",+          "values">: core "Type"],++      def "Name" $+        doc "A unique identifier in some context; a string-valued key"+        $ wrap string,++      def "Projection" $+        doc "A record elimination; a projection" $+        record [+          "typeName">:+            doc "The name of the record type" $+            core "Name",+          "field">:+            doc "The name of the projected field" $+            core "Name"],++      def "Record" $+        doc "A record, or labeled tuple; a map of field names to terms" $+        record [+          "typeName">: core "Name",+          "fields">: list $ core "Field"],++      def "RowType" $+        doc "A labeled record or union type" $+        record [+          "typeName">:+            doc "The name of the row type, which must correspond to the name of a Type element" $+            core "Name",+          "fields">:+            doc "The fields of this row type, excluding any inherited fields" $+            list $ core "FieldType"],++      def "Sum" $+        doc "The unlabeled equivalent of an Injection term" $+        record [+          "index">: int32,+          "size">: int32,+          "term">: core "Term"],++      def "Term" $+        doc "A data term" $+        union [+          "annotated">:+            doc "A term annotated with metadata" $+            core "AnnotatedTerm",+          "application">:+            doc "A function application" $+            core "Application",+          "function">:+            doc "A function term" $+            core "Function",+          "let">:+            doc "A 'let' term, which binds variables to terms" $+            core "Let",+          "list">:+            doc "A list" $+            list $ core "Term",+          "literal">:+            doc "A literal value" $+            core "Literal",+          "map">:+            doc "A map of keys to values" $+            Types.map (core "Term") (core "Term"),+          "optional">:+            doc "An optional value" $+            optional $ core "Term",+          "product">:+            doc "A tuple" $+            list (core "Term"),+          "record">:+            doc "A record term" $+            core "Record",+          "set">:+            doc "A set of values" $+            set $ core "Term",+          "sum">:+            doc "A variant tuple" $+            core "Sum",+          "typeApplication">:+            doc "A System F type application term" $+            core "TypedTerm",+          "typeLambda">:+            doc "A System F type abstraction term" $+            core "TypeLambda",+          "union">:+            doc "An injection; an instance of a union type" $+            core "Injection",+          "unit">:+            doc "A unit value; a term with no value" $+            unit,+          "variable">:+            doc "A variable reference" $+            core "Name",+          "wrap">:+            doc "A wrapped term; an instance of a wrapper type (newtype)" $+            core "WrappedTerm"],++      def "TupleProjection" $+        doc "A tuple elimination; a projection from an integer-indexed product" $+        record [+          "arity">:+            doc "The arity of the tuple"+            int32,+          "index">:+            doc "The 0-indexed offset from the beginning of the tuple"+            int32,+          "domain">:+            doc "An optional domain for the projection; this is a list of component types" $+            optional $ list $ core "Type"],++      def "Type" $+        doc "A data type" $+        union [+          "annotated">: core "AnnotatedType",+          "application">: core "ApplicationType",+          "forall">: core "ForallType",+          "function">: core "FunctionType",+          "list">: core "Type",+          "literal">: core "LiteralType",+          "map">: core "MapType",+          "optional">: core "Type",+          "product">: list (core "Type"),+          "record">: core "RowType",+          "set">: core "Type",+          "sum">: list (core "Type"),+          "union">: core "RowType",+          "unit">: unit,+          "variable">: core "Name",+          "wrap">: core "WrappedType"],++      def "TypeLambda" $+        doc "A System F type abstraction term" $+        record [+          "parameter">:+            doc "The type variable introduced by the abstraction" $+            core "Name",+          "body">:+            doc "The body of the abstraction" $+            core "Term"],++      def "TypedTerm" $+        doc "A term applied to a type; a type application" $+        record [+          "term">: core "Term",+          "type">: core "Type"],++      def "TypeScheme" $+        doc "A type expression together with free type variables occurring in the expression" $+        record [+          "variables">: list $ core "Name",+          "type">: core "Type"],++      def "WrappedTerm" $+        doc "A term wrapped in a type name" $+        record [+          "typeName">: core "Name",+          "object">: core "Term"],++      def "WrappedType" $+        doc "A type wrapped in a type name; a newtype" $+        record [+          "typeName">: core "Name",+          "object">: core "Type"]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Grammar.hs view
@@ -0,0 +1,73 @@+-- | A model for Hydra labeled-BNF grammars++module Hydra.Sources.Kernel.Types.Grammar where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just "A common API for BNF-based grammars, specifying context-free languages"+  where+    ns = Namespace "hydra.grammar"+    grammar = typeref ns+    def = datatype ns++    elements = [++      def "Constant" $+        doc "A constant pattern" $+        wrap string,++      def "Grammar" $+        doc "An enhanced Backus-Naur form (BNF) grammar" $+        wrap $ list $ grammar "Production",++      def "Label" $+        doc "A name for a pattern" $+        wrap string,++      def "LabeledPattern" $+        doc "A pattern together with a name (label)" $+        record [+        "label">: grammar "Label",+        "pattern">: grammar "Pattern"],++      def "Pattern" $+        doc "A pattern which matches valid expressions in the language" $+        union [+          "alternatives">: list $ grammar "Pattern",+          "constant">: grammar "Constant",+          "ignored">: grammar "Pattern",+          "labeled">: grammar "LabeledPattern",+          "nil">: unit,+          "nonterminal">: grammar "Symbol",+          "option">: grammar "Pattern",+          "plus">: grammar "Pattern",+          "regex">: grammar "Regex",+          "sequence">: list $ grammar "Pattern",+          "star">: grammar "Pattern"],++      def "Production" $+        doc "A BNF production" $+        record [+          "symbol">: grammar "Symbol",+          "pattern">: grammar "Pattern"],++      def "Regex" $+        doc "A regular expression" $+        wrap string,++      def "Symbol" $+        doc "A nonterminal symbol" $+        wrap string]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Graph.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Graph where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Compute as Compute+++module_ :: Module+module_ = Module ns elements [Compute.module_] [Core.module_] $+    Just "The extension to graphs of Hydra's core type system (hydra.core)"+  where+    ns = Namespace "hydra.graph"+    core = typeref $ moduleNamespace Core.module_+    compute = typeref $ moduleNamespace Compute.module_+    graph = typeref ns+    def = datatype ns++    elements = [++      def "Graph" $+        doc "A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph" $+        record [++          -- TODO: remove this; replace it with 'environment'+          "elements">:+            doc "All of the elements in the graph" $+            Types.map (core "Name") (core "Binding"),++          "environment">:+            doc "The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term)" $+            Types.map (core "Name") (optional $ core "Term"),+          "types">:+            doc "The typing environment of the graph" $+            Types.map (core "Name") (core "TypeScheme"),+          "body">:+            doc "The body of the term which generated this context" $+            core "Term",+          "primitives">:+            doc "All supported primitive constants and functions, by name" $+            Types.map (core "Name") (graph "Primitive"),+          "schema">:+            doc "The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph." $+            optional $ graph "Graph"],++      def "Primitive" $+        doc "A built-in function" $+        record [+          "name">:+            doc "The unique name of the primitive function" $+            core "Name",+          "type">:+            doc "The type signature of the primitive function" $+            core "TypeScheme",+          "implementation">:+            doc "A concrete implementation of the primitive function" $+            list (core "Term") --> compute "Flow" @@ graph "Graph" @@ core "Term"],++      def "TermCoder" $+        doc "A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms" $+        forAll "a" $ record [+          "type">: core "Type",+          "coder">: compute "Coder" @@ graph "Graph" @@ graph "Graph" @@ core "Term" @@ "a"]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Json.hs view
@@ -0,0 +1,48 @@+-- | A simple JSON model. This model is part of the Hydra kernel, despite JSON being an external language; JSON support is built in to Hydra++module Hydra.Sources.Kernel.Types.Json where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just "A JSON syntax model. See the BNF at https://www.json.org"+  where+    ns = Namespace "hydra.json"+    def = datatype ns+    json = typeref ns++    elements = [++      def "Value" $+        doc "A JSON value" $+        union [+          "array">:+            doc "A JSON array" $+            list $ json "Value",+          "boolean">:+            doc "A boolean value"+            boolean,+          "null">:+            doc "JSON's null value"+            unit,+          "number">:+            doc "A numeric value"+            bigfloat, -- TODO: JSON numbers are decimal-encoded+          "object">:+            doc "A JSON object as a set of key/value pairs" $+            Types.map string (json "Value"),+          "string">:+            doc "A string value"+            string]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Mantle.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Mantle where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just ("A set of types which supplement hydra.core, but are not referenced by hydra.core.")+  where+    ns = Namespace "hydra.mantle"+    core = typeref $ moduleNamespace Core.module_+    mantle = typeref ns+    def = datatype ns++    elements = [++      -- TODO: find another home for CaseConvention; it doesn't really belong in hydra.mantle+      def "CaseConvention" $+        Types.enum ["camel", "pascal", "lowerSnake", "upperSnake"],++      def "Comparison" $+        doc "An equality judgement: less than, equal to, or greater than" $+        enum [+          "lessThan",+          "equalTo",+          "greaterThan"],++      def "Either" $+        doc "A disjoint union between a 'left' type and a 'right' type" $+        forAlls ["a", "b"] $ union [+          "left">: "a",+          "right">: "b"],++      def "EliminationVariant" $+        doc "The identifier of an elimination constructor" $+        enum [+          "product",+          "record",+          "union",+          "wrap"],++      def "FunctionVariant" $+        doc "The identifier of a function constructor" $+        enum [+          "elimination",+          "lambda",+          "primitive"],++      def "LiteralVariant" $+        doc "The identifier of a literal constructor" $+        enum [+          "binary",+          "boolean",+          "float",+          "integer",+          "string"],++      def "Precision" $+        doc "Numeric precision: arbitrary precision, or precision to a specified number of bits" $+        union [+          "arbitrary">: unit,+          "bits">: int32],++      def "TermVariant" $+        doc "The identifier of a term expression constructor" $+        enum [+          "annotated",+          "application",+          "function",+          "let",+          "list",+          "literal",+          "map",+          "optional",+          "product",+          "record",+          "set",+          "sum",+          "typeApplication",+          "typeLambda",+          "union",+          "unit",+          "variable",+          "wrap"],++      def "TypeClass" $+        doc "Any of a small number of built-in type classes" $+        enum [+          "equality",+          "ordering"],++      def "TypeVariant" $+        doc "The identifier of a type constructor" $+        enum [+          "annotated",+          "application",+          "forall",+          "function",+          "list",+          "literal",+          "map",+          "optional",+          "product",+          "record",+          "set",+          "sum",+          "union",+          "unit",+          "variable",+          "wrap"]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Module.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Module where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Graph as Graph+++module_ :: Module+module_ = Module ns elements [Graph.module_] [Core.module_] $+    Just "A model for Hydra namespaces and modules"+  where+    ns = Namespace "hydra.module"+    core = typeref $ moduleNamespace Core.module_+    graph = typeref $ moduleNamespace Graph.module_+    mod = typeref ns+    def = datatype ns++    elements = [++      def "Definition" $+        doc "A definition, which may be either a term or type definition" $+        union [+          "term">: mod "TermDefinition",+          "type">: mod "TypeDefinition"],++      def "FileExtension" $+        doc "A file extension (without the dot), e.g. \"json\" or \"py\"" $+        wrap string,++      def "Library" $+        doc "A library of primitive functions" $+        record [+          "namespace">:+            doc "A common prefix for all primitive function names in the library" $+            mod "Namespace",+          "prefix">:+            doc "A preferred namespace prefix for function names in the library"+            string,+          "primitives">:+            doc "The primitives defined in this library" $+            list $ graph "Primitive"],++      def "Module" $+        doc "A logical collection of elements in the same namespace, having dependencies on zero or more other modules" $+        record [+          "namespace">:+            doc "A common prefix for all element names in the module" $+            mod "Namespace",+          "elements">:+            doc "The elements defined in this module" $+            list $ core "Binding",+          "termDependencies">:+            doc "Any modules which the term expressions of this module directly depend upon" $+            list $ mod "Module",+          "typeDependencies">:+            doc "Any modules which the type expressions of this module directly depend upon" $+            list $ mod "Module",+          "description">:+            doc "An optional human-readable description of the module" $+            optional string],++      def "Namespace" $+        doc "A prefix for element names" $+        wrap string,++      def "Namespaces" $+        doc "A mapping from namespaces to values of type n, with a focus on one namespace" $+        forAll "n" $ record [+          "focus">: pair (mod "Namespace") (var "n"),+          "mapping">: Types.map (mod "Namespace") (var "n")],++      def "QualifiedName" $+        doc "A qualified name consisting of an optional namespace together with a mandatory local name" $+        record [+          "namespace">: optional $ mod "Namespace",+          "local">: string],++      def "TermDefinition" $+        doc "A term-level definition, including a name, a term, and the type of the term" $+        record [+          "name">: core "Name",+          "term">: core "Term",+          "type">: core "Type"],++     def "TypeDefinition" $+        doc "A type-level definition, including a name and the type" $+        record [+          "name">: core "Name",+          -- TODO: consider using TypeScheme here instead of Type+          "type">: core "Type"]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Phantoms.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Phantoms where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just "Phantom types for use with Hydra DSLs"+  where+    ns = Namespace "hydra.phantoms"+    core = typeref $ moduleNamespace Core.module_+    phantoms = typeref ns+    def = datatype ns++    elements = [++      def "TBinding" $+        doc "An association of a named term (element) with a phantom type" $+        forAll "a" $ record [+          "name">: core "Name",+          "term">: phantoms "TTerm" @@ "a"],++      def "TTerm" $+        doc "An association of a term with a phantom type" $+        forAll "a" $ wrap $ core "Term"]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Query.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Query where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just "A model for language-agnostic graph pattern queries"+  where+    ns = Namespace "hydra.query"+    core = typeref $ moduleNamespace Core.module_+    query = typeref ns+    def = datatype ns++    elements = [+      def "ComparisonConstraint" $+        doc "One of several comparison operators" $+        enum ["equal", "notEqual", "lessThan", "greaterThan", "lessThanOrEqual", "greaterThanOrEqual"],++      def "Edge" $+        doc "An abstract edge based on a record type" $+        record [+          "type">:+            doc "The name of a record type, for which the edge also specifies an out- and an in- projection" $+            core "Name",+          "out">:+            doc "The field representing the out-projection of the edge. Defaults to 'out'." $+            optional $ core "Name",+          "in">:+            doc "The field representing the in-projection of the edge. Defaults to 'in'." $+            optional $ core "Name"],++      def "GraphPattern" $+        doc "A query pattern which matches within a designated component subgraph" $+        record [+          "graph">:+            doc "The name of the component graph" $+            core "Name",+          "patterns">:+            doc "The patterns to match within the subgraph" $+            list (query "Pattern")],++      def "Node" $+        doc "A node in a query expression; it may be a term, a variable, or a wildcard" $+        union [+          "term">:+            doc "A graph term; an expression which is valid in the graph being matched" $+            core "Term",+          "variable">:+            doc "A query variable, not to be confused with a variable term" $+            query "Variable",+          "wildcard">:+            doc "An anonymous variable which we do not care to join across patterns" unit],++      def "Path" $+        doc "A query path" $+        union [+          "step">:+            doc "A path given by a single step" $+            query "Step",+          "regex">:+            doc "A path given by a regular expression quantifier applied to another path" $+            query "RegexSequence",+          "inverse">:+            doc "A path given by the inverse of another path" $+            query "Path"],++      def "Pattern" $+        doc "A query pattern" $+        union [+          "triple">:+            doc "A subject/predicate/object pattern" $+            query "TriplePattern",+          "negation">:+            doc "The negation of another pattern" $+            query "Pattern",+          "conjunction">:+            doc "The conjunction ('and') of several other patterns" $+            list (query "Pattern"),+          "disjunction">:+            doc "The disjunction (inclusive 'or') of several other patterns" $+            list (query "Pattern"),+          "graph">:+            doc "A pattern which matches within a named subgraph" $+            query "GraphPattern"],++      def "Query" $+        doc "A SELECT-style graph pattern matching query" $+        record [+          "variables">:+            doc "The variables selected by the query" $+            list $ query "Variable",+          "patterns">:+            doc "The patterns to be matched" $+            list (query "Pattern")],++      def "Range" $+        doc "A range from min to max, inclusive" $+        record [+          "min">: int32,+          "max">: int32],++      def "RegexQuantifier" $+        doc "A regular expression quantifier" $+        union [+          "one">: doc "No quantifier; matches a single occurrence" unit,+          "zeroOrOne">: doc "The ? quanifier; matches zero or one occurrence" unit,+          "zeroOrMore">: doc "The * quantifier; matches any number of occurrences" unit,+          "oneOrMore">: doc "The + quantifier; matches one or more occurrences" unit,+          "exactly">: doc "The {n} quantifier; matches exactly n occurrences" int32,+          "atLeast">: doc "The {n,} quantifier; matches at least n occurrences" int32,+          "range">: doc "The {n, m} quantifier; matches between n and m (inclusive) occurrences" $ query "Range"],++      def "RegexSequence" $+        doc "A path with a regex quantifier" $+        record [+          "path">: query "Path",+          "quantifier">: query "RegexQuantifier"],++      def "Step" $+        doc "An atomic function as part of a query. When applied to a graph, steps are typed by function types." $+        union [+          "edge">:+            doc "An out-to-in traversal of an abstract edge" $+            query "Edge",+          "project">:+            doc "A projection from a record through one of its fields" $+            core "Projection",+          "compare">:+            doc "A comparison of two terms" $+            query "ComparisonConstraint"],++      def "TriplePattern" $+        doc "A subject/predicate/object pattern" $+        record [+          "subject">: query "Node",+          "predicate">: query "Path",+          "object">: query "Node"],++      def "Variable" $+        doc "A query variable" $+        wrap string]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Relational.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Relational where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just ("An interpretation of Codd's Relational Model, " +++      "as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). " +++      "Types ('domains') and values are parameterized so as to allow for application-specific implementations. " +++      "No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.")+  where+    ns = Namespace "hydra.relational"+    def = datatype ns+    rm = typeref ns++    elements = [+      def "ColumnName" $+        doc ("A name for a domain which serves to identify the role played by that domain in the given relation;"+          ++ " a 'role name' in Codd") $+        wrap string,++      def "ColumnSchema" $+        doc "An abstract specification of the domain represented by a column in a relation; a role" $+        forAll "t" $ record [+          "name">:+            doc "A unique name for the column" $+            rm "ColumnName",+          "domain">:+            doc "The domain (type) of the column" $+            "t"],++      def "ForeignKey" $+        doc "A mapping from certain columns of a source relation to primary key columns of a target relation" $+        record [+          "foreignRelation">:+            doc "The name of the target relation" $+            rm "RelationName",+          "keys">:+            doc ("The mapping of source column names to target column names."+               ++ " The target column names must together make up the primary key of the target relation.") $+            nonemptyMap (rm "ColumnName") (rm "ColumnName")],++      def "PrimaryKey" $+        doc "A primary key of a relation, specified either as a single column, or as a list of columns" $+        wrap $ nonemptyList $ rm "ColumnName",++      def "Relation" $+        doc "A set of distinct n-tuples; a table" $+        forAll "v" $ wrap $ list (rm "Row" @@ "v"),++      def "RelationName" $+        doc "A unique relation (table) name" $+        wrap string,++      def "RelationSchema" $ -- Note: this term is not in Codd+        doc "An abstract relation; the name and columns of a relation without its actual data" $+        forAll "t" $ record [+          "name">:+            doc "A unique name for the relation" $+            rm "RelationName",+          "columns">:+            doc "A list of column specifications" $+            nonemptyList $ rm "ColumnSchema" @@ "t",+          "primaryKeys">:+            doc "Any number of primary keys for the relation, each of which must be valid for this relation" $+            list $ rm "PrimaryKey",+          "foreignKeys">:+            doc "Any number of foreign keys, each of which must be valid for both this relation and the target relation" $+            list $ rm "ForeignKey"],++      def "Relationship" $+        doc "A domain-unordered (string-indexed, rather than position-indexed) relation" $+        forAll "v" $ wrap $ set $ Types.map (rm "ColumnName") "v",++      def "Row" $+        doc "An n-tuple which is an element of a given relation" $+        forAll "v" $ wrap $ nonemptyList "v"]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Tabular.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Tabular where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just ("A simple, untyped tabular data model, suitable for CSVs and TSVs")+  where+    ns = Namespace "hydra.tabular"+    def = datatype ns+    tabular = typeref ns++    elements = [++      def "DataRow" $+        doc "A data row, containing optional-valued cells; one per column" $+        forAll "v" $ wrap $ list $ optional "v",++      def "HeaderRow" $+        doc "A header row, containing column names (but no types or data)" $+        wrap $ list string,++      def "Table" $+        doc "A simple table as in a CSV file, having an optional header row and any number of data rows" $+        forAll "v" $ record [+          "header">:+            doc "The optional header row of the table. If present, the header must have the same number of cells as each data row." $+            optional $ tabular "HeaderRow",+          "data">:+            doc "The data rows of the table. Each row must have the same number of cells." $+            list (tabular "DataRow" @@ "v")]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Testing.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Testing where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Mantle as Mantle+++module_ :: Module+module_ = Module ns elements [Mantle.module_] [Core.module_] $+    Just "A model for unit testing"+  where+    ns = Namespace "hydra.testing"+    def = datatype ns+    core = typeref $ moduleNamespace Core.module_+    mantle = typeref $ moduleNamespace Mantle.module_+    testing = typeref ns++    elements = [++      def "EvaluationStyle" $+        doc "One of two evaluation styles: eager or lazy" $+        enum ["eager", "lazy"],++      def "CaseConversionTestCase" $+        doc "A test case which checks that strings are converted between different case conventions correctly" $+        record [+          "fromConvention">: mantle "CaseConvention",+          "toConvention">: mantle "CaseConvention",+          "fromString">: string,+          "toString">: string],++      def "EvaluationTestCase" $+        doc "A test case which evaluates (reduces) a given term and compares it with the expected result" $+        record [+          "evaluationStyle">: testing "EvaluationStyle",+          "input">: core "Term",+          "output">: core "Term"],++      def "InferenceFailureTestCase" $+        doc "A test case providing a term for which type inference is expected to fail" $+        record [+          "input">: core "Term"],++      def "InferenceTestCase" $+        doc "A test case which performs type inference on a given term and compares the result with an expected type scheme" $+        record [+          "input">: core "Term",+          "output">: core "TypeScheme"],++      def "Tag" $ wrap string,++      def "TestCase" $+        doc "A simple test case with an input and an expected output" $+        union [+          "caseConversion">: testing "CaseConversionTestCase",+          "evaluation">: testing "EvaluationTestCase",+          "inference">: testing "InferenceTestCase",+          "inferenceFailure">: testing "InferenceFailureTestCase"],++      def "TestCaseWithMetadata" $+        doc "One of a number of test case variants, together with metadata including a test name, an optional description, and optional tags" $+        record [+          "name">: string,+          "case">: testing "TestCase",+          "description">: optional string,+          "tags">: list $ testing "Tag"],++      def "TestGroup" $+        doc "A collection of test cases with a name and optional description" $+        record [+          "name">: string,+          "description">: optional string,+          "subgroups">: list (testing "TestGroup"),+          "cases">: list (testing "TestCaseWithMetadata")]]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Topology.hs view
@@ -0,0 +1,57 @@+module Hydra.Sources.Kernel.Types.Topology where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [] [Core.module_] $+    Just "A model for simple graphs as adjacency lists"+  where+    ns = Namespace "hydra.topology"+    topo = typeref ns+    def = datatype ns++    elements = [++      def "Graph" $ Types.map (topo "Vertex") (list $ topo "Vertex"),++      -- Note: useful, but currently unused+      def "OrderingIsomorphism" $ forAlls ["a"] $ record [+        "encode">:+          doc "Mapping from source ordering to target ordering" $+          list (var "a") --> list (var "a"),+        "decode">:+          doc "Mapping from target ordering to source ordering" $+          list (var "a") --> list (var "a")],++      def "TarjanState" $ record [+        "counter">:+          doc "Next available index for vertices in the DFS traversal"+          int32,+        "indices">:+          doc "Mapping from vertices to their indices in the DFS traversal" $+          Types.map (topo "Vertex") int32,+        "lowLinks">:+          doc "Mapping from vertices to their lowest reachable index in the DFS traversal" $+          Types.map (topo "Vertex") int32,+        "stack">:+          doc "Current DFS stack, with vertices in reverse order" $+          list $ topo "Vertex",+        "onStack">:+          doc "Set of vertices currently on the stack, for quick lookup" $+          Types.set (topo "Vertex"),+        "sccs">:+          doc "Accumulated strongly connected components, each a list of vertices" $+          list $ list $ topo "Vertex"],++      def "Vertex" $ int32]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Typing.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Typing where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y+++module_ :: Module+module_ = Module ns elements [Core.module_] [Core.module_] $+    Just ("Types supporting type inference and type reconstruction.")+  where+    ns = Namespace "hydra.typing"+    core = typeref $ moduleNamespace Core.module_+    typing = typeref ns+    def = datatype ns++    elements = [++      def "InferenceContext" $+        doc "The context provided to type inference, including various typing enviroments." $+        record [+          "schemaTypes">:+            doc "A fixed typing environment which is derived from the schema of the graph." $+            Types.map (core "Name") (core "TypeScheme"),+          "primitiveTypes">:+            doc "A fixed typing environment which is derived from the set of primitives in the graph." $+            Types.map (core "Name") (core "TypeScheme"),+          "dataTypes">:+            doc ("A mutable typing environment which is specific to the current graph being processed."+              ++ " This environment is (usually) smaller than the schema and primitive typing environments,"+              ++ " and is subject to global substitutions.") $+            Types.map (core "Name") (core "TypeScheme"),+          "debug">: boolean],++      def "InferenceResult" $+        doc "The result of applying inference rules to a term." $+        record [+          "term">: core "Term",+          "type">: core "Type",+          "subst">: typing "TypeSubst"],++      def "TermSubst" $+        doc "A substitution of term variables for terms" $+        wrap $ Types.map (core "Name") (core "Term"),++      def "TypeConstraint" $+        doc "An assertion that two types can be unified into a single type" $+        record [+          "left">: core "Type",+          "right">: core "Type",+          "comment">:+            doc "A description of the type constraint which may be used for tracing or debugging"+            string],++      def "TypeContext" $+        doc "A typing environment used for type reconstruction (typeOf) over System F terms" $+        record [+          "types">: Types.map (core "Name") (core "Type"),+          "variables">: Types.set (core "Name"),+          "inferenceContext">: typing "InferenceContext"],++      def "TypeSubst" $+        doc "A substitution of type variables for types" $+        wrap $ Types.map (core "Name") (core "Type")]
+ src/main/haskell/Hydra/Sources/Kernel/Types/Workflow.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}++module Hydra.Sources.Kernel.Types.Workflow where++-- Standard type-level kernel imports+import           Hydra.Kernel+import           Hydra.Dsl.Annotations+import           Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Terms                 as Terms+import           Hydra.Dsl.Types                 as Types+import qualified Hydra.Sources.Kernel.Types.Core as Core+import qualified Data.List                       as L+import qualified Data.Map                        as M+import qualified Data.Set                        as S+import qualified Data.Maybe                      as Y++import qualified Hydra.Sources.Kernel.Types.Compute as Compute+import qualified Hydra.Sources.Kernel.Types.Graph as Graph+import qualified Hydra.Sources.Kernel.Types.Module as Module+++module_ :: Module+module_ = Module ns elements [Compute.module_, Graph.module_, Module.module_] [Core.module_] $+    Just "A model for Hydra transformation workflows"+  where+    ns = Namespace "hydra.workflow"+    mod = typeref $ moduleNamespace Module.module_+    compute = typeref $ moduleNamespace Compute.module_+    core = typeref $ moduleNamespace Core.module_+    graph = typeref $ moduleNamespace Graph.module_+    wf = typeref ns+    def = datatype ns++    elements = [++      def "HydraSchemaSpec" $+        doc "The specification of a Hydra schema, provided as a set of modules and a distinguished type" $+        record [+          "modules">:+            doc "The modules to include in the schema graph" $+            list $ mod "Module",+          "typeName">:+            doc "The name of the top-level type; all data which passes through the workflow will be instances of this type" $+            core "Name"],++      def "LastMile" $+        doc "The last mile of a transformation, which encodes and serializes terms to a file" $+        forAlls ["s", "a"] $ record [+          "encoder">:+            doc "An encoder for terms to a list of output objects" $+            core "Type" --> compute "Flow" @@ "s"+              @@ (core "Term" --> graph "Graph" --> compute "Flow" @@ "s" @@ list "a"),+          "serializer">:+            doc "A function which serializes a list of output objects to a string representation" $+            list "a" --> compute "Flow" @@ "s" @@ string,+          "fileExtension">:+            doc "A file extension for the generated file(s)"+            string],++      def "SchemaSpec" $+        doc "The specification of a schema at the source end of a workflow" $+        union [+          "hydra">:+            doc "A native Hydra schema" $+            wf "HydraSchemaSpec",+          "file">:+            doc "A schema provided as a file, available at the given file path" $+            string,+          "provided">:+            doc "A schema which will be provided within the workflow" $+            unit],++      def "TransformWorkflow" $+        doc "The specification of a workflow which takes a schema specification, reads data from a directory, and writes data to another directory" $+        record [+          "name">:+            doc "A descriptive name for the workflow"+            string,+          "schemaSpec">:+            doc "The schema specification" $+            wf "SchemaSpec",+          "srcDir">:+            doc "The source directory"+            string,+          "destDir">:+            doc "The destination directory"+            string]]
src/main/haskell/Hydra/Sources/Libraries.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} +-- | Implementations of the Hydra standard libraries in Haskell module Hydra.Sources.Libraries where  import Hydra.Kernel-import qualified Hydra.Dsl.Expect as Expect+import qualified Hydra.Extract.Core as ExtractCore import Hydra.Dsl.Prims as Prims import qualified Hydra.Dsl.Terms as Terms import qualified Hydra.Dsl.Types as Types +import qualified Hydra.Lib.Chars as Chars import qualified Hydra.Lib.Equality as Equality import qualified Hydra.Lib.Flows as Flows-import qualified Hydra.Lib.Io as Io import qualified Hydra.Lib.Lists as Lists import qualified Hydra.Lib.Literals as Literals import qualified Hydra.Lib.Logic as Logic@@ -23,270 +24,389 @@ import qualified Data.List as L  +-- * Hydra standard library++standardLibrary :: Namespace -> [Primitive] -> Library+standardLibrary ns prims = Library {+  libraryNamespace = ns,+  libraryPrefix = L.drop (L.length ("hydra.lib." :: String)) $ unNamespace ns,+  libraryPrimitives = prims}++standardLibraries :: [Library]+standardLibraries = [+  hydraLibChars,+  hydraLibEquality,+  hydraLibFlows,+  hydraLibLists,+  hydraLibLiterals,+  hydraLibLogic,+  hydraLibMaps,+  hydraLibMathInt32,+  hydraLibOptionals,+  hydraLibSets,+  hydraLibStrings]++-- * hydra.lib.chars primitives++_hydra_lib_chars :: Namespace+_hydra_lib_chars = Namespace "hydra.lib.chars"++_chars_isAlphaNum = qname _hydra_lib_chars "isAlphaNum" :: Name+_chars_isLower    = qname _hydra_lib_chars "isLower" :: Name+_chars_isSpace    = qname _hydra_lib_chars "isSpace" :: Name+_chars_isUpper    = qname _hydra_lib_chars "isUpper" :: Name+_chars_toLower    = qname _hydra_lib_chars "toLower" :: Name+_chars_toUpper    = qname _hydra_lib_chars "toUpper" :: Name++hydraLibChars :: Library+hydraLibChars = standardLibrary _hydra_lib_strings [+  prim1 _chars_isAlphaNum Chars.isAlphaNum [] int32 boolean,+  prim1 _chars_isLower Chars.isLower [] int32 boolean,+  prim1 _chars_isSpace Chars.isSpace [] int32 boolean,+  prim1 _chars_isUpper Chars.isUpper [] int32 boolean,+  prim1 _chars_toLower Chars.toLower [] int32 int32,+  prim1 _chars_toUpper Chars.toUpper [] int32 int32]++-- * hydra.lib.equality primitives+ _hydra_lib_equality :: Namespace-_hydra_lib_equality = Namespace "hydra/lib/equality"+_hydra_lib_equality = Namespace "hydra.lib.equality" -_equality_equal = qname _hydra_lib_equality "equal" :: Name-_equality_equalBinary = qname _hydra_lib_equality "equalBinary" :: Name-_equality_equalBoolean = qname _hydra_lib_equality "equalBoolean" :: Name-_equality_equalBigfloat = qname _hydra_lib_equality "equalBigfloat" :: Name-_equality_equalFloat32 = qname _hydra_lib_equality "equalFloat32" :: Name-_equality_equalFloat64 = qname _hydra_lib_equality "equalFloat64" :: Name-_equality_equalBigint = qname _hydra_lib_equality "equalBigint" :: Name-_equality_equalInt8 = qname _hydra_lib_equality "equalInt8" :: Name-_equality_equalInt16 = qname _hydra_lib_equality "equalInt16" :: Name-_equality_equalInt32 = qname _hydra_lib_equality "equalInt32" :: Name-_equality_equalInt64 = qname _hydra_lib_equality "equalInt64" :: Name-_equality_equalTerm = qname _hydra_lib_equality "equalTerm" :: Name-_equality_equalType = qname _hydra_lib_equality "equalType" :: Name-_equality_equalUint8 = qname _hydra_lib_equality "equalUint8" :: Name-_equality_equalUint16 = qname _hydra_lib_equality "equalUint16" :: Name-_equality_equalUint32 = qname _hydra_lib_equality "equalUint32" :: Name-_equality_equalUint64 = qname _hydra_lib_equality "equalUint64" :: Name-_equality_equalString = qname _hydra_lib_equality "equalString" :: Name+_equality_compare  = qname _hydra_lib_equality "compare" :: Name+_equality_equal    = qname _hydra_lib_equality "equal" :: Name+_equality_gt       = qname _hydra_lib_equality "gt" :: Name+_equality_gte      = qname _hydra_lib_equality "gte" :: Name _equality_identity = qname _hydra_lib_equality "identity" :: Name-_equality_gtInt32 = qname _hydra_lib_equality "gtInt32" :: Name-_equality_gteInt32 = qname _hydra_lib_equality "gteInt32" :: Name-_equality_ltInt32 = qname _hydra_lib_equality "ltInt32" :: Name-_equality_lteInt32 = qname _hydra_lib_equality "lteInt32" :: Name+_equality_lt       = qname _hydra_lib_equality "lt" :: Name+_equality_lte      = qname _hydra_lib_equality "lte" :: Name+_equality_max      = qname _hydra_lib_equality "max" :: Name+_equality_min      = qname _hydra_lib_equality "min" :: Name  hydraLibEquality :: Library hydraLibEquality = standardLibrary _hydra_lib_equality [-    prim2 [] _equality_equal x x boolean Equality.equal,-    prim2 [] _equality_equalBinary binary binary boolean Equality.equalBinary,-    prim2 [] _equality_equalBoolean boolean boolean boolean Equality.equalBoolean,-    prim2 [] _equality_equalBigfloat bigfloat bigfloat boolean Equality.equalBigfloat,-    prim2 [] _equality_equalFloat32 float32 float32 boolean Equality.equalFloat32,-    prim2 [] _equality_equalFloat64 float64 float64 boolean Equality.equalFloat64,-    prim2 [] _equality_equalBigint bigint bigint boolean Equality.equalBigint,-    prim2 [] _equality_equalInt8 int8 int8 boolean Equality.equalInt8,-    prim2 [] _equality_equalInt16 int16 int16 boolean Equality.equalInt16,-    prim2 [] _equality_equalInt32 int32 int32 boolean Equality.equalInt32,-    prim2 [] _equality_equalInt64 int64 int64 boolean Equality.equalInt64,-    prim2 [] _equality_equalTerm term term boolean Equality.equalTerm,-    prim2 [] _equality_equalType type_ type_ boolean Equality.equalType,-    prim2 [] _equality_equalUint8 uint8 uint8 boolean Equality.equalUint8,-    prim2 [] _equality_equalUint16 uint16 uint16 boolean Equality.equalUint16,-    prim2 [] _equality_equalUint32 uint32 uint32 boolean Equality.equalUint32,-    prim2 [] _equality_equalUint64 uint64 uint64 boolean Equality.equalUint64,-    prim2 [] _equality_equalString string string boolean Equality.equalString,-    prim1 ["x"] _equality_identity x x Equality.identity,-    prim2 [] _equality_gtInt32 int32 int32 boolean Equality.gtInt32,-    prim2 [] _equality_gteInt32 int32 int32 boolean Equality.gteInt32,-    prim2 [] _equality_ltInt32 int32 int32 boolean Equality.ltInt32,-    prim2 [] _equality_lteInt32 int32 int32 boolean Equality.lteInt32]+    prim2 _equality_compare  Equality.compare  ["x"] x x comparison,+    prim2 _equality_equal    Equality.equal    ["x"] x x boolean,+    prim1 _equality_identity Equality.identity ["x"] x x,+    prim2 _equality_gt       Equality.gt       ["x"] x x boolean,+    prim2 _equality_gte      Equality.gte      ["x"] x x boolean,+    prim2 _equality_lt       Equality.lt       ["x"] x x boolean,+    prim2 _equality_lte      Equality.lte      ["x"] x x boolean,+    prim2 _equality_max      Equality.max      ["x"] x x x,+    prim2 _equality_min      Equality.min      ["x"] x x x]   where     x = variable "x" +-- * hydra.lib.flows primitives+ _hydra_lib_flows :: Namespace-_hydra_lib_flows = Namespace "hydra/lib/flows"+_hydra_lib_flows = Namespace "hydra.lib.flows" -_flows_apply = qname _hydra_lib_flows "apply" :: Name-_flows_bind = qname _hydra_lib_flows "bind" :: Name-_flows_fail = qname _hydra_lib_flows "fail" :: Name-_flows_map = qname _hydra_lib_flows "map" :: Name-_flows_mapList = qname _hydra_lib_flows "mapList" :: Name-_flows_pure = qname _hydra_lib_flows "pure" :: Name-_flows_sequence = qname _hydra_lib_flows "sequence" :: Name+_flows_apply       = qname _hydra_lib_flows "apply" :: Name+_flows_bind        = qname _hydra_lib_flows "bind" :: Name+_flows_fail        = qname _hydra_lib_flows "fail" :: Name+_flows_map         = qname _hydra_lib_flows "map" :: Name+_flows_mapElems    = qname _hydra_lib_flows "mapElems" :: Name+_flows_mapKeys     = qname _hydra_lib_flows "mapKeys" :: Name+_flows_mapList     = qname _hydra_lib_flows "mapList" :: Name+_flows_mapOptional = qname _hydra_lib_flows "mapOptional" :: Name+_flows_mapSet      = qname _hydra_lib_flows "mapSet" :: Name+_flows_pure        = qname _hydra_lib_flows "pure" :: Name+_flows_sequence    = qname _hydra_lib_flows "sequence" :: Name  hydraLibFlows :: Library hydraLibFlows = standardLibrary _hydra_lib_flows [-    prim2 ["s", "x", "y"] _flows_apply (flow s (function x y)) (flow s x) (flow s y) Flows.apply,-    prim2 ["s", "x", "y"] _flows_bind  (flow s x) (function x (flow s y)) (flow s y) Flows.bind,-    prim1 ["s", "x"]      _flows_fail  string (flow s x) Flows.fail,-    prim2 ["s", "x", "y"] _flows_map   (function x y) (flow s x) (flow s y) Flows.map,-    prim2 ["s", "x", "y"] _flows_mapList (function x (flow s y)) (list x) (flow s (list y)) Flows.mapList,-    prim1 ["s", "x"]      _flows_pure  x (flow s x) Flows.pure,-    prim1 ["s", "x"]      _flows_sequence (list (flow s x)) (flow s (list x)) Flows.sequence]+    prim2 _flows_apply       Flows.apply    ["s", "x", "y"]        (flow s (function x y)) (flow s x) (flow s y),+    prim2 _flows_bind        Flows.bind     ["s", "x", "y"]        (flow s x) (function x (flow s y)) (flow s y),+    prim1 _flows_fail        Flows.fail     ["s", "x"]             string (flow s x),+    prim2 _flows_map         Flows.map      ["s", "x", "y"]        (function x y) (flow s x) (flow s y),+    prim2 _flows_mapElems    Flows.mapElems ["s", "k", "v1", "v2"] (function v1 (flow s v2)) (Prims.map k v1) (flow s (Prims.map k v2)),+    prim2 _flows_mapKeys     Flows.mapKeys  ["s", "k1", "k2", "v"] (function k1 (flow s k2)) (Prims.map k1 v) (flow s (Prims.map k2 v)),+    prim2 _flows_mapList     Flows.mapList  ["s", "x", "y"]        (function x (flow s y)) (list x) (flow s (list y)),+    prim2 _flows_mapOptional Flows.mapOptional ["s", "x", "y"]     (function x $ flow s y) (optional x) (flow s $ optional y),+    prim2 _flows_mapSet      Flows.mapSet   ["s", "x", "y"]        (function x (flow s y)) (set x) (flow s (set y)),+    prim1 _flows_pure        Flows.pure     ["s", "x"]             x (flow s x),+    prim1 _flows_sequence    Flows.sequence ["s", "x"]             (list (flow s x)) (flow s (list x))]   where     s = variable "s"+    k = variable "k"+    k1 = variable "k1"+    k2 = variable "k2"     x = variable "x"+    v = variable "v"+    v1 = variable "v1"+    v2 = variable "v2"     y = variable "y" +-- * hydra.lib.lists primitives++_hydra_lib_lists :: Namespace+_hydra_lib_lists = Namespace "hydra.lib.lists"++_lists_apply       = qname _hydra_lib_lists "apply" :: Name+_lists_at          = qname _hydra_lib_lists "at" :: Name+_lists_bind        = qname _hydra_lib_lists "bind" :: Name+_lists_concat      = qname _hydra_lib_lists "concat" :: Name+_lists_concat2     = qname _hydra_lib_lists "concat2" :: Name+_lists_cons        = qname _hydra_lib_lists "cons" :: Name+_lists_drop        = qname _hydra_lib_lists "drop" :: Name+_lists_dropWhile   = qname _hydra_lib_lists "dropWhile" :: Name+_lists_elem        = qname _hydra_lib_lists "elem" :: Name+_lists_filter      = qname _hydra_lib_lists "filter" :: Name+_lists_foldl       = qname _hydra_lib_lists "foldl" :: Name+_lists_group       = qname _hydra_lib_lists "group" :: Name+_lists_head        = qname _hydra_lib_lists "head" :: Name+_lists_init        = qname _hydra_lib_lists "init" :: Name+_lists_intercalate = qname _hydra_lib_lists "intercalate" :: Name+_lists_intersperse = qname _hydra_lib_lists "intersperse" :: Name+_lists_last        = qname _hydra_lib_lists "last" :: Name+_lists_length      = qname _hydra_lib_lists "length" :: Name+_lists_map         = qname _hydra_lib_lists "map" :: Name+_lists_nub         = qname _hydra_lib_lists "nub" :: Name+_lists_null        = qname _hydra_lib_lists "null" :: Name+_lists_pure        = qname _hydra_lib_lists "pure" :: Name+_lists_replicate   = qname _hydra_lib_lists "replicate" :: Name+_lists_reverse     = qname _hydra_lib_lists "reverse" :: Name+_lists_safeHead    = qname _hydra_lib_lists "safeHead" :: Name+_lists_singleton   = qname _hydra_lib_lists "singleton" :: Name+_lists_sort        = qname _hydra_lib_lists "sort" :: Name+_lists_sortOn      = qname _hydra_lib_lists "sortOn" :: Name+_lists_span        = qname _hydra_lib_lists "span" :: Name+_lists_tail        = qname _hydra_lib_lists "tail" :: Name+_lists_take        = qname _hydra_lib_lists "take" :: Name+_lists_transpose   = qname _hydra_lib_lists "transpose" :: Name+_lists_zip         = qname _hydra_lib_lists "zip" :: Name+_lists_zipWith     = qname _hydra_lib_lists "zipWith" :: Name++hydraLibLists :: Library+hydraLibLists = standardLibrary _hydra_lib_lists [+    prim2Interp _lists_apply       (Just applyInterp) ["x", "y"] (list $ function x y) (list x) (list y),+    prim2       _lists_at          Lists.at           ["x"] int32 (list x) x,+    prim2Interp _lists_bind        (Just bindInterp)  ["x", "y"] (list x) (function x (list y)) (list y),+    prim1       _lists_concat      Lists.concat       ["x"] (list (list x)) (list x),+    prim2       _lists_concat2     Lists.concat2      ["x"] (list x) (list x) (list x),+    prim2       _lists_cons        Lists.cons         ["x"] x (list x) (list x),+    prim2       _lists_drop        Lists.drop         ["x"] int32 (list x) (list x),+    prim2Interp _lists_dropWhile   Nothing            ["x"] (function x boolean) (list x) (list x),+    prim2       _lists_elem        Lists.elem         ["x"] x (list x) boolean,+    prim2       _lists_filter      Lists.filter       ["x"] (function x boolean) (list x) (list x),+    prim3       _lists_foldl       Lists.foldl        ["x", "y"] (function y (function x y)) y (list x) y,+    prim1       _lists_group       Lists.group        ["x"] (list x) (list (list x)),+    prim1       _lists_head        Lists.head         ["x"] (list x) x,+    prim1       _lists_init        Lists.init         ["x"] (list x) (list x),+    prim2       _lists_intercalate Lists.intercalate  ["x"] (list x) (list (list x)) (list x),+    prim2       _lists_intersperse Lists.intersperse  ["x"] x (list x) (list x),+    prim1       _lists_last        Lists.last         ["x"] (list x) x,+    prim1       _lists_length      Lists.length       ["x"] (list x) int32,+    prim2Interp _lists_map         (Just mapInterp)   ["x", "y"] (function x y) (list x) (list y),+    prim1       _lists_nub         Lists.nub          ["x"] (list x) (list x),+    prim1       _lists_null        Lists.null         ["x"] (list x) boolean,+    prim1       _lists_pure        Lists.pure         ["x"] x (list x),+    prim2       _lists_replicate   Lists.replicate    ["x"] int32 x (list x),+    prim1       _lists_reverse     Lists.reverse      ["x"] (list x) (list x),+    prim1       _lists_safeHead    Lists.safeHead     ["x"] (list x) (optional x),+    prim1       _lists_singleton   Lists.singleton    ["x"] x (list x),+    prim2Interp _lists_sortOn      Nothing            ["x", "y"] (function x y) (list x) (list x),+    prim2Interp _lists_span        Nothing            ["x", "y"] (function x boolean) (list x) (pair (list x) (list x)),+    prim1       _lists_sort        Lists.sort         ["x"] (list x) (list x),+    prim1       _lists_tail        Lists.tail         ["x"] (list x) (list x),+    prim2       _lists_take        Lists.take         ["x"] int32 (list x) (list x),+    prim1       _lists_transpose   Lists.transpose    ["x"] (list (list x)) (list (list x)),+    prim2       _lists_zip         Lists.zip          ["x", "y"] (list x) (list y) (list (pair x y)),+    prim3       _lists_zipWith     Lists.zipWith      ["x", "y", "z"] (function x $ function y z) (list x) (list y) (list z)]+  where+    x = variable "x"+    y = variable "y"+    z = variable "z"++-- | Interpreted implementation of hydra.lib.lists.apply applyInterp :: Term -> Term -> Flow Graph Term applyInterp funs' args' = do-    funs <- Expect.list Prelude.pure funs'-    args <- Expect.list Prelude.pure args'+    funs <- ExtractCore.list funs'+    args <- ExtractCore.list args'     return $ Terms.list $ L.concat (helper args <$> funs)   where     helper args f = Terms.apply f <$> args +-- | Interpreted implementation of hydra.lib.lists.bind bindInterp :: Term -> Term -> Flow Graph Term bindInterp args' fun = do-    args <- Expect.list Prelude.pure args'-    return $ Terms.apply (Terms.primitive $ Name "hydra/lib/lists.concat") (Terms.list $ Terms.apply fun <$> args)+    args <- ExtractCore.list args'+    return $ Terms.apply (Terms.primitive _lists_concat) (Terms.list $ Terms.apply fun <$> args) +-- | Interpreted implementation of hydra.lib.lists.map mapInterp :: Term -> Term -> Flow Graph Term mapInterp fun args' = do-    args <- Expect.list Prelude.pure args'+    args <- ExtractCore.list args'     return $ Terms.list (Terms.apply fun <$> args) -_hydra_lib_io :: Namespace-_hydra_lib_io = Namespace "hydra/lib/io"--_io_showTerm = qname _hydra_lib_io "showTerm" :: Name-_io_showType = qname _hydra_lib_io "showType" :: Name--hydraLibIo :: Library-hydraLibIo = standardLibrary _hydra_lib_io [-    prim1 [] _io_showTerm term string Io.showTerm,-    prim1 [] _io_showType type_ string Io.showType]--_hydra_lib_lists :: Namespace-_hydra_lib_lists = Namespace "hydra/lib/lists"--_lists_apply = qname _hydra_lib_lists "apply" :: Name-_lists_at = qname _hydra_lib_lists "at" :: Name-_lists_bind = qname _hydra_lib_lists "bind" :: Name-_lists_concat = qname _hydra_lib_lists "concat" :: Name-_lists_concat2 = qname _hydra_lib_lists "concat2" :: Name-_lists_cons = qname _hydra_lib_lists "cons" :: Name-_lists_filter = qname _hydra_lib_lists "filter" :: Name-_lists_foldl = qname _hydra_lib_lists "foldl" :: Name-_lists_head = qname _hydra_lib_lists "head" :: Name-_lists_intercalate = qname _hydra_lib_lists "intercalate" :: Name-_lists_intersperse = qname _hydra_lib_lists "intersperse" :: Name-_lists_last = qname _hydra_lib_lists "last" :: Name-_lists_length = qname _hydra_lib_lists "length" :: Name-_lists_map = qname _hydra_lib_lists "map" :: Name-_lists_nub = qname _hydra_lib_lists "nub" :: Name-_lists_null = qname _hydra_lib_lists "null" :: Name-_lists_pure = qname _hydra_lib_lists "pure" :: Name-_lists_reverse = qname _hydra_lib_lists "reverse" :: Name-_lists_safeHead = qname _hydra_lib_lists "safeHead" :: Name-_lists_tail = qname _hydra_lib_lists "tail" :: Name--hydraLibLists :: Library-hydraLibLists = standardLibrary _hydra_lib_lists [-    prim2Interp ["x", "y"] _lists_apply (list $ function x y) (list x) (list y) applyInterp,-    prim2 ["x"] _lists_at int32 (list x) x Lists.at,-    prim2Interp ["x", "y"] _lists_bind (list x) (function x (list y)) (list y) bindInterp,-    prim1 ["x"] _lists_concat (list (list x)) (list x) Lists.concat,-    prim2 ["x"] _lists_concat2 (list x) (list x) (list x) Lists.concat2,-    prim2 ["x"] _lists_cons x (list x) (list x) Lists.cons,-    prim2 ["x"] _lists_filter (function x boolean) (list x) (list x) Lists.filter,-    prim3 ["x", "y"] _lists_foldl (function y (function x y)) y (list x) y Lists.foldl,-    prim1 ["x"] _lists_head (list x) x Lists.head,-    prim2 ["x"] _lists_intercalate (list x) (list (list x)) (list x) Lists.intercalate,-    prim2 ["x"] _lists_intersperse x (list x) (list x) Lists.intersperse,-    prim1 ["x"] _lists_last (list x) x Lists.last,-    prim1 ["x"] _lists_length (list x) int32 Lists.length,-    prim2Interp ["x", "y"] _lists_map (function x y) (list x) (list y) mapInterp,-    prim1 ["x"] _lists_nub (list x) (list x) Lists.nub,-    prim1 ["x"] _lists_null (list x) boolean Lists.null,-    prim1 ["x"] _lists_pure x (list x) Lists.pure,-    prim1 ["x"] _lists_reverse (list x) (list x) Lists.reverse,-    prim1 ["x"] _lists_safeHead (list x) (optional x) Lists.safeHead,-    prim1 ["x"] _lists_tail (list x) (list x) Lists.tail]-  where-    x = variable "x"-    y = variable "y"+-- * hydra.lib.literals primitives  _hydra_lib_literals :: Namespace-_hydra_lib_literals = Namespace "hydra/lib/literals"+_hydra_lib_literals = Namespace "hydra.lib.literals" -_literals_bigfloatToBigint = qname _hydra_lib_literals "bigfloatToBigint" :: Name+_literals_bigfloatToBigint  = qname _hydra_lib_literals "bigfloatToBigint" :: Name _literals_bigfloatToFloat32 = qname _hydra_lib_literals "bigfloatToFloat32" :: Name _literals_bigfloatToFloat64 = qname _hydra_lib_literals "bigfloatToFloat64" :: Name-_literals_bigintToBigfloat = qname _hydra_lib_literals "bigintToBigfloat" :: Name-_literals_bigintToInt8 = qname _hydra_lib_literals "bigintToInt8" :: Name-_literals_bigintToInt16 = qname _hydra_lib_literals "bigintToInt16" :: Name-_literals_bigintToInt32 = qname _hydra_lib_literals "bigintToInt32" :: Name-_literals_bigintToInt64 = qname _hydra_lib_literals "bigintToInt64" :: Name-_literals_bigintToUint8 = qname _hydra_lib_literals "bigintToUint8" :: Name-_literals_bigintToUint16 = qname _hydra_lib_literals "bigintToUint16" :: Name-_literals_bigintToUint32 = qname _hydra_lib_literals "bigintToUint32" :: Name-_literals_bigintToUint64 = qname _hydra_lib_literals "bigintToUint64" :: Name+_literals_bigintToBigfloat  = qname _hydra_lib_literals "bigintToBigfloat" :: Name+_literals_bigintToInt8      = qname _hydra_lib_literals "bigintToInt8" :: Name+_literals_bigintToInt16     = qname _hydra_lib_literals "bigintToInt16" :: Name+_literals_bigintToInt32     = qname _hydra_lib_literals "bigintToInt32" :: Name+_literals_bigintToInt64     = qname _hydra_lib_literals "bigintToInt64" :: Name+_literals_bigintToUint8     = qname _hydra_lib_literals "bigintToUint8" :: Name+_literals_bigintToUint16    = qname _hydra_lib_literals "bigintToUint16" :: Name+_literals_bigintToUint32    = qname _hydra_lib_literals "bigintToUint32" :: Name+_literals_bigintToUint64    = qname _hydra_lib_literals "bigintToUint64" :: Name+_literals_binaryToString    = qname _hydra_lib_literals "binaryToString" :: Name _literals_float32ToBigfloat = qname _hydra_lib_literals "float32ToBigfloat" :: Name _literals_float64ToBigfloat = qname _hydra_lib_literals "float64ToBigfloat" :: Name-_literals_int8ToBigint = qname _hydra_lib_literals "int8ToBigint" :: Name-_literals_int16ToBigint = qname _hydra_lib_literals "int16ToBigint" :: Name-_literals_int32ToBigint = qname _hydra_lib_literals "int32ToBigint" :: Name-_literals_int64ToBigint = qname _hydra_lib_literals "int64ToBigint" :: Name-_literals_showInt32 = qname _hydra_lib_literals "showInt32" :: Name-_literals_showString = qname _hydra_lib_literals "showString" :: Name-_literals_uint8ToBigint = qname _hydra_lib_literals "uint8ToBigint" :: Name-_literals_uint16ToBigint = qname _hydra_lib_literals "uint16ToBigint" :: Name-_literals_uint32ToBigint = qname _hydra_lib_literals "uint32ToBigint" :: Name-_literals_uint64ToBigint = qname _hydra_lib_literals "uint64ToBigint" :: Name+_literals_int8ToBigint      = qname _hydra_lib_literals "int8ToBigint" :: Name+_literals_int16ToBigint     = qname _hydra_lib_literals "int16ToBigint" :: Name+_literals_int32ToBigint     = qname _hydra_lib_literals "int32ToBigint" :: Name+_literals_int64ToBigint     = qname _hydra_lib_literals "int64ToBigint" :: Name+_literals_readBigfloat      = qname _hydra_lib_literals "readBigfloat" :: Name+_literals_readBoolean       = qname _hydra_lib_literals "readBoolean" :: Name+_literals_readFloat32       = qname _hydra_lib_literals "readFloat32" :: Name+_literals_readFloat64       = qname _hydra_lib_literals "readFloat64" :: Name+_literals_readInt32         = qname _hydra_lib_literals "readInt32" :: Name+_literals_readInt64         = qname _hydra_lib_literals "readInt64" :: Name+_literals_readString        = qname _hydra_lib_literals "readString" :: Name+_literals_showBigfloat      = qname _hydra_lib_literals "showBigfloat" :: Name+_literals_showBigint        = qname _hydra_lib_literals "showBigint" :: Name+_literals_showBoolean       = qname _hydra_lib_literals "show" :: Name+_literals_showFloat32       = qname _hydra_lib_literals "showFloat32" :: Name+_literals_showFloat64       = qname _hydra_lib_literals "showFloat64" :: Name+_literals_showInt8          = qname _hydra_lib_literals "showInt8" :: Name+_literals_showInt16         = qname _hydra_lib_literals "showInt16" :: Name+_literals_showInt32         = qname _hydra_lib_literals "showInt32" :: Name+_literals_showInt64         = qname _hydra_lib_literals "showInt64" :: Name+_literals_showUint8         = qname _hydra_lib_literals "showUint8" :: Name+_literals_showUint16        = qname _hydra_lib_literals "showUint16" :: Name+_literals_showUint32        = qname _hydra_lib_literals "showUint32" :: Name+_literals_showUint64        = qname _hydra_lib_literals "showUint64" :: Name+_literals_showString        = qname _hydra_lib_literals "showString" :: Name+_literals_stringToBinary    = qname _hydra_lib_literals "stringToBinary" :: Name+_literals_uint8ToBigint     = qname _hydra_lib_literals "uint8ToBigint" :: Name+_literals_uint16ToBigint    = qname _hydra_lib_literals "uint16ToBigint" :: Name+_literals_uint32ToBigint    = qname _hydra_lib_literals "uint32ToBigint" :: Name+_literals_uint64ToBigint    = qname _hydra_lib_literals "uint64ToBigint" :: Name  hydraLibLiterals :: Library hydraLibLiterals = standardLibrary _hydra_lib_literals [-  prim1 [] _literals_bigfloatToBigint bigfloat bigint Literals.bigfloatToBigint,-  prim1 [] _literals_bigfloatToFloat32 bigfloat float32 Literals.bigfloatToFloat32,-  prim1 [] _literals_bigfloatToFloat64 bigfloat float64 Literals.bigfloatToFloat64,-  prim1 [] _literals_bigintToBigfloat bigint bigfloat Literals.bigintToBigfloat,-  prim1 [] _literals_bigintToInt8 bigint int8 Literals.bigintToInt8,-  prim1 [] _literals_bigintToInt16 bigint int16 Literals.bigintToInt16,-  prim1 [] _literals_bigintToInt32 bigint int32 Literals.bigintToInt32,-  prim1 [] _literals_bigintToInt64 bigint int64 Literals.bigintToInt64,-  prim1 [] _literals_bigintToUint8 bigint uint8 Literals.bigintToUint8,-  prim1 [] _literals_bigintToUint16 bigint uint16 Literals.bigintToUint16,-  prim1 [] _literals_bigintToUint32 bigint uint32 Literals.bigintToUint32,-  prim1 [] _literals_bigintToUint64 bigint uint64 Literals.bigintToUint64,-  prim1 [] _literals_float32ToBigfloat float32 bigfloat Literals.float32ToBigfloat,-  prim1 [] _literals_float64ToBigfloat float64 bigfloat Literals.float64ToBigfloat,-  prim1 [] _literals_int8ToBigint int8 bigint Literals.int8ToBigint,-  prim1 [] _literals_int16ToBigint int16 bigint Literals.int16ToBigint,-  prim1 [] _literals_int32ToBigint int32 bigint Literals.int32ToBigint,-  prim1 [] _literals_int64ToBigint int64 bigint Literals.int64ToBigint,-  prim1 [] _literals_showInt32 int32 string Literals.showInt32,-  prim1 [] _literals_showString string string Literals.showString,-  prim1 [] _literals_uint8ToBigint uint8 bigint Literals.uint8ToBigint,-  prim1 [] _literals_uint16ToBigint uint16 bigint Literals.uint16ToBigint,-  prim1 [] _literals_uint32ToBigint uint32 bigint Literals.uint32ToBigint,-  prim1 [] _literals_uint64ToBigint uint64 bigint Literals.uint64ToBigint]+  prim1 _literals_bigfloatToBigint  Literals.bigfloatToBigint  [] bigfloat bigint,+  prim1 _literals_bigfloatToFloat32 Literals.bigfloatToFloat32 [] bigfloat float32,+  prim1 _literals_bigfloatToFloat64 Literals.bigfloatToFloat64 [] bigfloat float64,+  prim1 _literals_bigintToBigfloat  Literals.bigintToBigfloat  [] bigint bigfloat,+  prim1 _literals_bigintToInt8      Literals.bigintToInt8      [] bigint int8,+  prim1 _literals_bigintToInt16     Literals.bigintToInt16     [] bigint int16,+  prim1 _literals_bigintToInt32     Literals.bigintToInt32     [] bigint int32,+  prim1 _literals_bigintToInt64     Literals.bigintToInt64     [] bigint int64,+  prim1 _literals_bigintToUint8     Literals.bigintToUint8     [] bigint uint8,+  prim1 _literals_bigintToUint16    Literals.bigintToUint16    [] bigint uint16,+  prim1 _literals_bigintToUint32    Literals.bigintToUint32    [] bigint uint32,+  prim1 _literals_bigintToUint64    Literals.bigintToUint64    [] bigint uint64,+  prim1 _literals_binaryToString    Literals.binaryToString    [] binary string,+  prim1 _literals_float32ToBigfloat Literals.float32ToBigfloat [] float32 bigfloat,+  prim1 _literals_float64ToBigfloat Literals.float64ToBigfloat [] float64 bigfloat,+  prim1 _literals_int8ToBigint      Literals.int8ToBigint      [] int8 bigint,+  prim1 _literals_int16ToBigint     Literals.int16ToBigint     [] int16 bigint,+  prim1 _literals_int32ToBigint     Literals.int32ToBigint     [] int32 bigint,+  prim1 _literals_int64ToBigint     Literals.int64ToBigint     [] int64 bigint,+  prim1 _literals_readBigfloat      Literals.readBigfloat      [] string (optional bigfloat),+  prim1 _literals_readBoolean       Literals.readBoolean       [] string (optional boolean),+  prim1 _literals_readFloat32       Literals.readFloat32       [] string (optional float32),+  prim1 _literals_readFloat64       Literals.readFloat64       [] string (optional float64),+  prim1 _literals_readInt32         Literals.readInt32         [] string (optional int32),+  prim1 _literals_readInt64         Literals.readInt64         [] string (optional int64),+  prim1 _literals_readString        Literals.readString        [] string (optional string),+  prim1 _literals_showBigfloat      Literals.showBigfloat      [] bigfloat string,+  prim1 _literals_showBigint        Literals.showBigint        [] bigint string,+  prim1 _literals_showBoolean       Literals.showBoolean       [] boolean string,+  prim1 _literals_showFloat32       Literals.showFloat32       [] float32 string,+  prim1 _literals_showFloat64       Literals.showFloat64       [] float64 string,+  prim1 _literals_showInt8          Literals.showInt8          [] int8 string,+  prim1 _literals_showInt16         Literals.showInt16         [] int16 string,+  prim1 _literals_showInt32         Literals.showInt32         [] int32 string,+  prim1 _literals_showInt64         Literals.showInt64         [] int64 string,+  prim1 _literals_showUint8         Literals.showUint8         [] uint8 string,+  prim1 _literals_showUint16        Literals.showUint16        [] uint16 string,+  prim1 _literals_showUint32        Literals.showUint32        [] uint32 string,+  prim1 _literals_showUint64        Literals.showUint64        [] uint64 string,+  prim1 _literals_showString        Literals.showString        [] string string,+  prim1 _literals_stringToBinary    Literals.stringToBinary    [] string binary,+  prim1 _literals_uint8ToBigint     Literals.uint8ToBigint     [] uint8 bigint,+  prim1 _literals_uint16ToBigint    Literals.uint16ToBigint    [] uint16 bigint,+  prim1 _literals_uint32ToBigint    Literals.uint32ToBigint    [] uint32 bigint,+  prim1 _literals_uint64ToBigint    Literals.uint64ToBigint    [] uint64 bigint] +-- * hydra.lib.logic primitives+ _hydra_lib_logic :: Namespace-_hydra_lib_logic = Namespace "hydra/lib/logic"+_hydra_lib_logic = Namespace "hydra.lib.logic"  _logic_and = qname _hydra_lib_logic "and" :: Name _logic_ifElse = qname _hydra_lib_logic "ifElse" :: Name-_logic_not = qname _hydra_lib_logic "not" :: Name-_logic_or = qname _hydra_lib_logic "or" :: Name+_logic_not    = qname _hydra_lib_logic "not" :: Name+_logic_or     = qname _hydra_lib_logic "or" :: Name  hydraLibLogic :: Library hydraLibLogic = standardLibrary _hydra_lib_logic [-    prim2 [] _logic_and boolean boolean boolean Logic.and,-    prim3 ["x"] _logic_ifElse x x boolean x Logic.ifElse,-    prim1 [] _logic_not boolean boolean Logic.not,-    prim2 [] _logic_or boolean boolean boolean Logic.or]+    prim2 _logic_and    Logic.and    []    boolean boolean boolean,+    prim3 _logic_ifElse Logic.ifElse ["x"] boolean x x x,+    prim1 _logic_not    Logic.not    []    boolean boolean,+    prim2 _logic_or     Logic.or     []    boolean boolean boolean]   where     x = variable "x" +-- * hydra.lib.maps primitives+ _hydra_lib_maps :: Namespace-_hydra_lib_maps = Namespace "hydra/lib/maps"+_hydra_lib_maps = Namespace "hydra.lib.maps" -_maps_empty = qname _hydra_lib_maps "empty" :: Name-_maps_fromList = qname _hydra_lib_maps "fromList" :: Name-_maps_insert = qname _hydra_lib_maps "insert" :: Name-_maps_isEmpty = qname _hydra_lib_maps "isEmpty" :: Name-_maps_keys = qname _hydra_lib_maps "keys" :: Name-_maps_lookup = qname _hydra_lib_maps "lookup" :: Name-_maps_map = qname _hydra_lib_maps "map" :: Name-_maps_mapKeys = qname _hydra_lib_maps "mapKeys" :: Name-_maps_remove = qname _hydra_lib_maps "remove" :: Name-_maps_singleton = qname _hydra_lib_maps "singleton" :: Name-_maps_size = qname _hydra_lib_maps "size" :: Name-_maps_toList = qname _hydra_lib_maps "toList" :: Name-_maps_values = qname _hydra_lib_maps "values" :: Name+_maps_alter           = qname _hydra_lib_maps "alter" :: Name+_maps_bimap           = qname _hydra_lib_maps "bimap" :: Name+_maps_elems           = qname _hydra_lib_maps "elems" :: Name+_maps_empty           = qname _hydra_lib_maps "empty" :: Name+_maps_filter          = qname _hydra_lib_maps "filter" :: Name+_maps_filterWithKey   = qname _hydra_lib_maps "filterWithKey" :: Name+_maps_findWithDefault = qname _hydra_lib_maps "findWithDefault" :: Name+_maps_fromList        = qname _hydra_lib_maps "fromList" :: Name+_maps_insert          = qname _hydra_lib_maps "insert" :: Name+_maps_keys            = qname _hydra_lib_maps "keys" :: Name+_maps_lookup          = qname _hydra_lib_maps "lookup" :: Name+_maps_map             = qname _hydra_lib_maps "map" :: Name+_maps_mapKeys         = qname _hydra_lib_maps "mapKeys" :: Name+_maps_member          = qname _hydra_lib_maps "member" :: Name+_maps_null            = qname _hydra_lib_maps "null" :: Name+_maps_remove          = qname _hydra_lib_maps "remove" :: Name+_maps_singleton       = qname _hydra_lib_maps "singleton" :: Name+_maps_size            = qname _hydra_lib_maps "size" :: Name+_maps_toList          = qname _hydra_lib_maps "toList" :: Name+_maps_union           = qname _hydra_lib_maps "union" :: Name+_maps_values          = qname _hydra_lib_maps "values" :: Name  hydraLibMaps :: Library hydraLibMaps = standardLibrary _hydra_lib_maps [-    prim0 ["k", "v"] _maps_empty mapKv Maps.empty,-    prim1 ["k", "v"] _maps_fromList (list $ pair k v) mapKv Maps.fromList,-    prim3 ["k", "v"] _maps_insert k v mapKv mapKv Maps.insert,-    prim1 ["k", "v"] _maps_isEmpty mapKv boolean Maps.isEmpty,-    prim1 ["k", "v"] _maps_keys mapKv (list k) Maps.keys,-    prim2 ["k", "v"] _maps_lookup k mapKv (optional v) Maps.lookup,-    prim2 ["k", "v1", "v2"] _maps_map (function v1 v2) (Prims.map k v1) (Prims.map k v2) Maps.map,-    prim2 ["k1", "k2", "v"] _maps_mapKeys (function k1 k2) (Prims.map k1 v) (Prims.map k2 v) Maps.mapKeys,-    prim1 ["k", "v"] _maps_size mapKv int32 Maps.size,-    prim2 ["k", "v"] _maps_remove k mapKv mapKv Maps.remove,-    prim2 ["k", "v"] _maps_singleton k v mapKv Maps.singleton,-    prim1 ["k", "v"] _maps_size mapKv int32 Maps.size,-    prim1 ["k", "v"] _maps_toList mapKv (list $ pair k v) Maps.toList,-    prim1 ["k", "v"] _maps_values mapKv (list v) Maps.values]+    prim3Interp _maps_alter     Nothing        ["k", "v"]               (function (optional v) (optional v)) k mapKv mapKv,+    prim3 _maps_bimap           Maps.bimap     ["k1", "k2", "v1", "v2"] (function k1 k2) (function v1 v2) (Prims.map k1 v1) (Prims.map k2 v2),+    prim1 _maps_elems           Maps.elems     ["k", "v"]               mapKv (list v),+    prim0 _maps_empty           Maps.empty     ["k", "v"]               mapKv,+    prim2 _maps_filter          Maps.filter    ["k", "v"]               (function v boolean) mapKv mapKv,+    prim2 _maps_filterWithKey   Maps.filterWithKey ["k", "v"]           (function k (function v boolean)) mapKv mapKv,+    prim3 _maps_findWithDefault Maps.findWithDefault ["k", "v"]         v k mapKv v,+    prim1 _maps_fromList        Maps.fromList  ["k", "v"]               (list $ pair k v) mapKv,+    prim3 _maps_insert          Maps.insert    ["k", "v"]               k v mapKv mapKv,+    prim1 _maps_keys            Maps.keys      ["k", "v"]               mapKv (list k),+    prim2 _maps_lookup          Maps.lookup    ["k", "v"]               k mapKv (optional v),+    prim2 _maps_map             Maps.map       ["k", "v1", "v2"]        (function v1 v2) (Prims.map k v1) (Prims.map k v2),+    prim2 _maps_mapKeys         Maps.mapKeys   ["k1", "k2", "v"]        (function k1 k2) (Prims.map k1 v) (Prims.map k2 v),+    prim2 _maps_member          Maps.member    ["k", "v"]               k mapKv boolean,+    prim1 _maps_null            Maps.null      ["k", "v"]               mapKv boolean,+    prim1 _maps_size            Maps.size      ["k", "v"]               mapKv int32,+    prim2 _maps_remove          Maps.remove    ["k", "v"]               k mapKv mapKv,+    prim2 _maps_singleton       Maps.singleton ["k", "v"]               k v mapKv,+    prim1 _maps_size            Maps.size      ["k", "v"]               mapKv int32,+    prim1 _maps_toList          Maps.toList    ["k", "v"]               mapKv (list $ pair k v),+    prim2 _maps_union           Maps.union     ["k", "v"]               mapKv mapKv mapKv]   where     k = variable "k"     k1 = variable "k1"@@ -296,138 +416,161 @@     v2 = variable "v2"     mapKv = Prims.map k v +-- * hydra.lib.math primitives+ _hydra_lib_math :: Namespace-_hydra_lib_math = Namespace "hydra/lib/math"+_hydra_lib_math = Namespace "hydra.lib.math" -_math_add = qname _hydra_lib_math "add" :: Name-_math_div = qname _hydra_lib_math "div" :: Name-_math_mod = qname _hydra_lib_math "mod" :: Name-_math_mul = qname _hydra_lib_math "mul" :: Name-_math_neg = qname _hydra_lib_math "neg" :: Name-_math_rem = qname _hydra_lib_math "rem" :: Name-_math_sub = qname _hydra_lib_math "sub" :: Name+_math_add   = qname _hydra_lib_math "add" :: Name+_math_div   = qname _hydra_lib_math "div" :: Name+_math_mod   = qname _hydra_lib_math "mod" :: Name+_math_mul   = qname _hydra_lib_math "mul" :: Name+_math_neg   = qname _hydra_lib_math "neg" :: Name+_math_range = qname _hydra_lib_math "range" :: Name+_math_rem   = qname _hydra_lib_math "rem" :: Name+_math_sub   = qname _hydra_lib_math "sub" :: Name  hydraLibMathInt32 :: Library hydraLibMathInt32 = standardLibrary _hydra_lib_math [-  prim2 [] _math_add int32 int32 int32 Math.add,-  prim2 [] _math_div int32 int32 int32 Math.div,-  prim2 [] _math_mod int32 int32 int32 Math.mod,-  prim2 [] _math_mul int32 int32 int32 Math.mul,-  prim1 [] _math_neg int32 int32 Math.neg,-  prim2 [] _math_rem int32 int32 int32 Math.rem,-  prim2 [] _math_sub int32 int32 int32 Math.sub]+  prim2 _math_add   Math.add   [] int32 int32 int32,+  prim2 _math_div   Math.div   [] int32 int32 int32,+  prim2 _math_mod   Math.mod   [] int32 int32 int32,+  prim2 _math_mul   Math.mul   [] int32 int32 int32,+  prim1 _math_neg   Math.neg   [] int32 int32,+  prim2 _math_range Math.range [] int32 int32 (list int32),+  prim2 _math_rem   Math.rem   [] int32 int32 int32,+  prim2 _math_sub   Math.sub   [] int32 int32 int32] +-- * hydra.lib.optionals primitives+ _hydra_lib_optionals :: Namespace-_hydra_lib_optionals = Namespace "hydra/lib/optionals"+_hydra_lib_optionals = Namespace "hydra.lib.optionals"  _optionals_apply :: Name-_optionals_apply = qname _hydra_lib_optionals "apply" :: Name-_optionals_bind = qname _hydra_lib_optionals "bind" :: Name-_optionals_cat = qname _hydra_lib_optionals "cat" :: Name-_optionals_compose = qname _hydra_lib_optionals "compose" :: Name+_optionals_apply     = qname _hydra_lib_optionals "apply" :: Name+_optionals_bind      = qname _hydra_lib_optionals "bind" :: Name+_optionals_cases     = qname _hydra_lib_optionals "cases" :: Name+_optionals_cat       = qname _hydra_lib_optionals "cat" :: Name+_optionals_compose   = qname _hydra_lib_optionals "compose" :: Name+_optionals_fromJust  = qname _hydra_lib_optionals "fromJust" :: Name _optionals_fromMaybe = qname _hydra_lib_optionals "fromMaybe" :: Name-_optionals_isJust = qname _hydra_lib_optionals "isJust" :: Name+_optionals_isJust    = qname _hydra_lib_optionals "isJust" :: Name _optionals_isNothing = qname _hydra_lib_optionals "isNothing" :: Name-_optionals_map = qname _hydra_lib_optionals "map" :: Name-_optionals_maybe = qname _hydra_lib_optionals "maybe" :: Name-_optionals_pure = qname _hydra_lib_optionals "pure" :: Name+_optionals_map       = qname _hydra_lib_optionals "map" :: Name+_optionals_mapMaybe  = qname _hydra_lib_optionals "mapMaybe" :: Name+_optionals_maybe     = qname _hydra_lib_optionals "maybe" :: Name+_optionals_pure      = qname _hydra_lib_optionals "pure" :: Name  hydraLibOptionals :: Library hydraLibOptionals = standardLibrary _hydra_lib_optionals [-    prim2 ["x", "y"] _optionals_apply (optional $ function x y) (optional x) (optional y) Optionals.apply,-    prim2 ["x", "y"] _optionals_bind (optional x) (function x (optional y)) (optional y) Optionals.bind,-    prim1 ["x"] _optionals_cat (list $ optional x) (list x) Optionals.cat,-    prim2 ["x", "y", "z"] _optionals_compose (function x $ optional y) (function y $ optional z) (function x $ optional z) Optionals.compose,-    prim2 ["x"] _optionals_fromMaybe x (optional x) x Optionals.fromMaybe,-    prim1 ["x"] _optionals_isJust (optional x) boolean Optionals.isJust,-    prim1 ["x"] _optionals_isNothing (optional x) boolean Optionals.isNothing,-    prim2 ["x", "y"] _optionals_map (function x y) (optional x) (optional y) Optionals.map,-    prim3 ["x", "y"] _optionals_maybe y (function x y) (optional x) y Optionals.maybe,-    prim1 ["x"] _optionals_pure x (optional x) Optionals.pure]+    prim2       _optionals_apply     Optionals.apply           ["x", "y"]      (optional $ function x y) (optional x) (optional y),+    prim2       _optionals_bind      Optionals.bind            ["x", "y"]      (optional x) (function x (optional y)) (optional y),+    prim3Interp _optionals_cases     (Just casesInterp)        ["x", "y"]      (optional x) y (function x y) y,+    prim1       _optionals_cat       Optionals.cat             ["x"]           (list $ optional x) (list x),+    prim2       _optionals_compose   Optionals.compose         ["x", "y", "z"] (function x $ optional y) (function y $ optional z) (function x $ optional z),+    prim1       _optionals_fromJust  Optionals.fromJust        ["x"]           (optional x) x,+    prim2       _optionals_fromMaybe Optionals.fromMaybe       ["x"]           x (optional x) x,+    prim1       _optionals_isJust    Optionals.isJust          ["x"]           (optional x) boolean,+    prim1       _optionals_isNothing Optionals.isNothing       ["x"]           (optional x) boolean,+    prim2Interp _optionals_map       (Just optionalsMapInterp) ["x", "y"]      (function x y) (optional x) (optional y),+    prim2Interp _optionals_mapMaybe  Nothing                   ["x", "y"]      (function x $ optional y) (list x) (list y),+    prim3Interp _optionals_maybe     (Just maybeInterp)        ["x", "y"]      y (function x y) (optional x) y,+    prim1       _optionals_pure      Optionals.pure            ["x"]           x (optional x)]   where     x = variable "x"     y = variable "y"     z = variable "z" +-- | Interpreted implementation of hydra.lib.optionals.cases+casesInterp :: Term -> Term -> Term -> Flow Graph Term+casesInterp opt def fun = maybeInterp def fun opt++-- | Interpreted implementation of hydra.lib.optionals.maybe+maybeInterp :: Term -> Term -> Term -> Flow Graph Term+maybeInterp def fun opt = do+    mval <- ExtractCore.optional Prelude.pure opt+    return $ case mval of+      Nothing -> def+      Just val -> Terms.apply fun val++optionalsMapInterp :: Term -> Term -> Flow Graph Term+optionalsMapInterp fun opt = do+    mval <- ExtractCore.optional Prelude.pure opt+    return $ case mval of+      Nothing -> Terms.nothing+      Just val -> Terms.just $ Terms.apply fun val++-- * hydra.lib.sets primitives+ _hydra_lib_sets :: Namespace-_hydra_lib_sets = Namespace "hydra/lib/sets"+_hydra_lib_sets = Namespace "hydra.lib.sets" -_sets_insert = qname _hydra_lib_sets "add" :: Name-_sets_contains = qname _hydra_lib_sets "contains" :: Name-_sets_difference = qname _hydra_lib_sets "difference" :: Name-_sets_empty = qname _hydra_lib_sets "empty" :: Name-_sets_fromList = qname _hydra_lib_sets "fromList" :: Name+_sets_delete       = qname _hydra_lib_sets "delete" :: Name+_sets_difference   = qname _hydra_lib_sets "difference" :: Name+_sets_empty        = qname _hydra_lib_sets "empty" :: Name+_sets_fromList     = qname _hydra_lib_sets "fromList" :: Name+_sets_insert       = qname _hydra_lib_sets "insert" :: Name _sets_intersection = qname _hydra_lib_sets "intersection" :: Name-_sets_isEmpty = qname _hydra_lib_sets "isEmpty" :: Name-_sets_map = qname _hydra_lib_sets "map" :: Name-_sets_remove = qname _hydra_lib_sets "remove" :: Name-_sets_singleton = qname _hydra_lib_sets "singleton" :: Name-_sets_size = qname _hydra_lib_sets "size" :: Name-_sets_toList = qname _hydra_lib_sets "toList" :: Name-_sets_union = qname _hydra_lib_sets "union" :: Name+_sets_map          = qname _hydra_lib_sets "map" :: Name+_sets_member       = qname _hydra_lib_sets "member" :: Name+_sets_null         = qname _hydra_lib_sets "null" :: Name+_sets_singleton    = qname _hydra_lib_sets "singleton" :: Name+_sets_size         = qname _hydra_lib_sets "size" :: Name+_sets_toList       = qname _hydra_lib_sets "toList" :: Name+_sets_union        = qname _hydra_lib_sets "union" :: Name+_sets_unions       = qname _hydra_lib_sets "unions" :: Name  hydraLibSets :: Library hydraLibSets = standardLibrary _hydra_lib_sets [-    prim2 ["x"] _sets_contains x (set x) boolean Sets.contains,-    prim2 ["x"] _sets_difference (set x) (set x) (set x) Sets.difference,-    prim0 ["x"] _sets_empty (set x) Sets.empty,-    prim1 ["x"] _sets_fromList (list x) (set x) Sets.fromList,-    prim2 ["x"] _sets_insert x (set x) (set x) Sets.insert,-    prim2 ["x"] _sets_intersection (set x) (set x) (set x) Sets.intersection,-    prim1 ["x"] _sets_isEmpty (set x) boolean Sets.isEmpty,-    prim2 ["x", "y"] _sets_map (function x y) (set x) (set y) Sets.map,-    prim2 ["x"] _sets_remove x (set x) (set x) Sets.remove,-    prim1 ["x"] _sets_singleton x (set x) Sets.singleton,-    prim1 ["x"] _sets_size (set x) int32 Sets.size,-    prim1 ["x"] _sets_toList (set x) (list x) Sets.toList,-    prim2 ["x"] _sets_union (set x) (set x) (set x) Sets.union]+    prim2 _sets_delete       Sets.delete       ["x"]      x (set x) (set x),+    prim2 _sets_difference   Sets.difference   ["x"]      (set x) (set x) (set x),+    prim0 _sets_empty        Sets.empty        ["x"]      (set x),+    prim1 _sets_fromList     Sets.fromList     ["x"]      (list x) (set x),+    prim2 _sets_insert       Sets.insert       ["x"]      x (set x) (set x),+    prim2 _sets_intersection Sets.intersection ["x"]      (set x) (set x) (set x),+    prim2 _sets_map          Sets.map          ["x", "y"] (function x y) (set x) (set y),+    prim2 _sets_member       Sets.member       ["x"]      x (set x) boolean,+    prim1 _sets_null         Sets.null         ["x"]      (set x) boolean,+    prim1 _sets_singleton    Sets.singleton    ["x"]      x (set x),+    prim1 _sets_size         Sets.size         ["x"]      (set x) int32,+    prim1 _sets_toList       Sets.toList       ["x"]      (set x) (list x),+    prim2 _sets_union        Sets.union        ["x"]      (set x) (set x) (set x),+    prim1 _sets_unions       Sets.unions       ["x"]      (list $ set x) (set x)]   where     x = variable "x"     y = variable "y" +-- * hydra.lib.strings primitives+ _hydra_lib_strings :: Namespace-_hydra_lib_strings = Namespace "hydra/lib/strings"+_hydra_lib_strings = Namespace "hydra.lib.strings" -_strings_cat = qname _hydra_lib_strings "cat" :: Name-_strings_cat2 = qname _hydra_lib_strings "cat2" :: Name-_strings_fromList = qname _hydra_lib_strings "fromList" :: Name+_strings_cat         = qname _hydra_lib_strings "cat" :: Name+_strings_cat2        = qname _hydra_lib_strings "cat2" :: Name+_strings_charAt      = qname _hydra_lib_strings "charAt" :: Name+_strings_fromList    = qname _hydra_lib_strings "fromList" :: Name _strings_intercalate = qname _hydra_lib_strings "intercalate" :: Name-_strings_isEmpty = qname _hydra_lib_strings "isEmpty" :: Name-_strings_length = qname _hydra_lib_strings "length" :: Name-_strings_splitOn = qname _hydra_lib_strings "splitOn" :: Name-_strings_toList = qname _hydra_lib_strings "toList" :: Name-_strings_toLower = qname _hydra_lib_strings "toLower" :: Name-_strings_toUpper = qname _hydra_lib_strings "toUpper" :: Name+_strings_null        = qname _hydra_lib_strings "null" :: Name+_strings_length      = qname _hydra_lib_strings "length" :: Name+_strings_lines       = qname _hydra_lib_strings "lines" :: Name+_strings_splitOn     = qname _hydra_lib_strings "splitOn" :: Name+_strings_toList      = qname _hydra_lib_strings "toList" :: Name+_strings_toLower     = qname _hydra_lib_strings "toLower" :: Name+_strings_toUpper     = qname _hydra_lib_strings "toUpper" :: Name+_strings_unlines     = qname _hydra_lib_strings "unlines" :: Name  hydraLibStrings :: Library hydraLibStrings = standardLibrary _hydra_lib_strings [-  prim1 [] _strings_cat (list string) string Strings.cat,-  prim2 [] _strings_cat2 string string string Strings.cat2,-  prim1 [] _strings_fromList (list int32) string Strings.fromList,-  prim2 [] _strings_intercalate string (list string) string Strings.intercalate,-  prim1 [] _strings_isEmpty string boolean Strings.isEmpty,-  prim1 [] _strings_length string int32 Strings.length,-  prim2 [] _strings_splitOn string string (list string) Strings.splitOn,-  prim1 [] _strings_toList string (list int32) Strings.toList,-  prim1 [] _strings_toLower string string Strings.toLower,-  prim1 [] _strings_toUpper string string Strings.toUpper]--standardLibrary :: Namespace -> [Primitive] -> Library-standardLibrary ns prims = Library {-  libraryNamespace = ns,-  libraryPrefix = L.drop (L.length ("hydra/lib/" :: String)) $ unNamespace ns,-  libraryPrimitives = prims}--standardLibraries :: [Library]-standardLibraries = [-  hydraLibEquality,-  hydraLibFlows,-  hydraLibIo,-  hydraLibLists,-  hydraLibLiterals,-  hydraLibLogic,-  hydraLibMaps,-  hydraLibMathInt32,-  hydraLibOptionals,-  hydraLibSets,-  hydraLibStrings]+  prim1 _strings_cat         Strings.cat         [] (list string) string,+  prim2 _strings_cat2        Strings.cat2        [] string string string,+  prim2 _strings_charAt      Strings.charAt      [] int32 string int32,+  prim1 _strings_fromList    Strings.fromList    [] (list int32) string,+  prim2 _strings_intercalate Strings.intercalate [] string (list string) string,+  prim1 _strings_length      Strings.length      [] string int32,+  prim1 _strings_lines       Strings.lines       [] string (list string),+  prim1 _strings_null        Strings.null        [] string boolean,+  prim2 _strings_splitOn     Strings.splitOn     [] string string (list string),+  prim1 _strings_toList      Strings.toList      [] string (list int32),+  prim1 _strings_toLower     Strings.toLower     [] string string,+  prim1 _strings_toUpper     Strings.toUpper     [] string string,+  prim1 _strings_unlines     Strings.unlines     [] (list string) string]
+ src/main/haskell/Hydra/Sources/Test/Formatting.hs view
@@ -0,0 +1,47 @@+module Hydra.Sources.Test.Formatting (formattingTests) where++import Hydra.Kernel+import Hydra.Dsl.Tests+import Hydra.Dsl.ShorthandTypes+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+++formattingTests :: TestGroup+formattingTests = TestGroup "formatting tests" Nothing [] cases+  where+    cases = [+      -- from lower_snake_case+      testCase 1 CaseConventionLowerSnake CaseConventionUpperSnake "a_hello_world_42_a42_42a_b" "A_HELLO_WORLD_42_A42_42A_B",+      testCase 2 CaseConventionLowerSnake CaseConventionCamel "a_hello_world_42_a42_42a_b" "aHelloWorld42A4242aB",+      testCase 3 CaseConventionLowerSnake CaseConventionPascal "a_hello_world_42_a42_42a_b" "AHelloWorld42A4242aB",+      testCase 4 CaseConventionLowerSnake CaseConventionLowerSnake "a_hello_world_42_a42_42a_b" "a_hello_world_42_a42_42a_b",++      -- from UPPER_SNAKE_CASE+      testCase 5 CaseConventionUpperSnake CaseConventionLowerSnake "A_HELLO_WORLD_42_A42_42A_B" "a_hello_world_42_a42_42a_b",+      testCase 6 CaseConventionUpperSnake CaseConventionCamel "A_HELLO_WORLD_42_A42_42A_B" "aHelloWorld42A4242aB",+      testCase 7 CaseConventionUpperSnake CaseConventionPascal "A_HELLO_WORLD_42_A42_42A_B" "AHelloWorld42A4242aB",+      testCase 8 CaseConventionUpperSnake CaseConventionUpperSnake "A_HELLO_WORLD_42_A42_42A_B" "A_HELLO_WORLD_42_A42_42A_B",++      -- from camelCase+      testCase 9 CaseConventionCamel CaseConventionLowerSnake "aHelloWorld42A4242aB" "a_hello_world42_a4242a_b",+      testCase 10 CaseConventionCamel CaseConventionUpperSnake "aHelloWorld42A4242aB" "A_HELLO_WORLD42_A4242A_B",+      testCase 11 CaseConventionCamel CaseConventionPascal "aHelloWorld42A4242aB" "AHelloWorld42A4242aB",+      testCase 12 CaseConventionCamel CaseConventionCamel "aHelloWorld42A4242aB" "aHelloWorld42A4242aB",++      -- from PascalCase+      testCase 13 CaseConventionPascal CaseConventionLowerSnake "AHelloWorld42A4242aB" "a_hello_world42_a4242a_b",+      testCase 14 CaseConventionPascal CaseConventionUpperSnake "AHelloWorld42A4242aB" "A_HELLO_WORLD42_A4242A_B",+      testCase 15 CaseConventionPascal CaseConventionCamel "AHelloWorld42A4242aB" "aHelloWorld42A4242aB",+      testCase 16 CaseConventionPascal CaseConventionPascal "AHelloWorld42A4242aB" "AHelloWorld42A4242aB"]++    testCase i fromConvention toConvention fromString toString = TestCaseWithMetadata name tcase Nothing []+      where+        tcase = TestCaseCaseConversion $ CaseConversionTestCase fromConvention toConvention fromString toString+        name = "#" ++ show i ++ " (" ++ showConvention fromConvention ++ " -> " ++ showConvention toConvention ++ ")"++    showConvention c = case c of+      CaseConventionLowerSnake -> "lower_snake_case"+      CaseConventionUpperSnake -> "UPPER_SNAKE_CASE"+      CaseConventionCamel -> "camelCase"+      CaseConventionPascal -> "PascalCase"
+ src/main/haskell/Hydra/Sources/Test/Inference/AlgebraicTypes.hs view
@@ -0,0 +1,157 @@+module Hydra.Sources.Test.Inference.AlgebraicTypes (algebraicTypesTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Phantoms as Base+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph+import Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T+import Hydra.Sources.Test.Inference.Fundamentals++import qualified Data.Map as M+import Prelude hiding (map, sum)+++algebraicTypesTests :: TTerm TestGroup+algebraicTypesTests = supergroup "Algebraic terms" [+  testGroupForFolds,+  testGroupForLists,+  testGroupForMaps,+  testGroupForOptionals,+  testGroupForProducts,+  testGroupForSets,+  testGroupForSums]++testGroupForFolds :: TTerm TestGroup+testGroupForFolds = subgroup "List eliminations (folds)" [+    expectMono 1 [tag_disabledForMinimalInference]+      foldAdd+      (T.functionMany [T.int32, T.list T.int32, T.int32]),+    expectMono 2 [tag_disabledForMinimalInference]+      (foldAdd @@ int32 0)+      (T.function (T.list T.int32) T.int32),+    expectMono 3 [tag_disabledForMinimalInference]+      (foldAdd @@ int32 0 @@ (list (int32 <$> [1, 2, 3, 4, 5])))+      T.int32]+  where+    foldAdd = primitive _lists_foldl @@ primitive _math_add++testGroupForLists :: TTerm TestGroup+testGroupForLists = supergroup "List terms" [+    subgroup "List of strings" [+      expectMono 1 []+        (list [string "foo", string "bar"])+        (T.list T.string)],+    subgroup "List of lists of strings" [+      expectMono 1 []+        (list [list [string "foo"], list []])+        (T.list $ T.list T.string)],+    subgroup "Empty list" [+      expectPoly 1 []+        (list [])+        ["t0"] (T.list $ T.var "t0")],+    subgroup "List containing an empty list" [+      expectPoly 1 []+        (list [list []])+        ["t0"] (T.list $ T.list $ T.var "t0")],+    subgroup "Lambda producing a polymorphic list" [+      expectPoly 1 []+        (lambda "x" (list [var "x"]))+        ["t0"] (T.function (T.var "t0") (T.list $ T.var "t0"))],+    subgroup "Lambda producing a list of integers" [+      expectMono 1 []+        (lambda "x" (list [var "x", int32 42]))+        (T.function T.int32 $ T.list T.int32)],+    subgroup "List with repeated variables" [+      expectMono 1 []+        (lambda "x" (list [var "x", string "foo", var "x"]))+        (T.function T.string (T.list T.string))]]++testGroupForMaps :: TTerm TestGroup+testGroupForMaps = subgroup "Map terms" [+    expectMono 1 [tag_disabledForMinimalInference]+      (mapTermCheat [+        (Terms.string "firstName", Terms.string "Arthur"),+        (Terms.string "lastName", Terms.string "Dent")])+      (T.map T.string T.string),+    expectPoly 2 [tag_disabledForMinimalInference]+      (mapTermCheat [])+      ["t0", "t1"] (T.map (T.var "t0") (T.var "t1"))]++testGroupForOptionals :: TTerm TestGroup+testGroupForOptionals = subgroup "Optional terms" [+    expectMono 1 [tag_disabledForMinimalInference]+      (optional $ just $ int32 42)+      (T.optional T.int32),+    expectPoly 2 [tag_disabledForMinimalInference]+      (optional nothing)+      ["t0"] (T.optional $ T.var "t0")]++testGroupForProducts :: TTerm TestGroup+testGroupForProducts = supergroup "Product terms" [+    subgroup "Empty products" [+      expectMono 1 []+        (tuple [])+        (T.product [])],++    subgroup "Non-empty, monotyped products" [+      expectMono 1 []+        (tuple [string "foo", int32 42])+        (T.product [T.string, T.int32]),+      expectMono 2 []+        (tuple [string "foo", list [float32 42.0, float32 137.0]])+        (T.product [T.string, T.list T.float32]),+      expectMono 3 [tag_disabledForMinimalInference]+        (tuple [string "foo", int32 42, list [float32 42.0, float32 137.0]])+        (T.product [T.string, T.int32, T.list T.float32])],++    subgroup "Polytyped products" [+      expectPoly 1 []+        (tuple [list [], string "foo"])+        ["t0"] (T.product [T.list $ T.var "t0", T.string]),+      expectPoly 2 [tag_disabledForMinimalInference]+        (tuple [int32 42, string "foo", list []])+        ["t0"] (T.product [T.int32, T.string, T.list $ T.var "t0"])],++    subgroup "Pairs" [+      expectMono 1 []+        (pair (int32 42) (string "foo"))+        (T.pair T.int32 T.string),+      expectPoly 2 []+        (pair (list []) (string "foo"))+        ["t0"] (T.pair (T.list $ T.var "t0") T.string),+      expectPoly 3 []+        (pair (list []) (list []))+        ["t0", "t1"] (T.pair (T.list $ T.var "t0") (T.list $ T.var "t1"))]]++testGroupForSets :: TTerm TestGroup+testGroupForSets = subgroup "Set terms" [+    expectMono 1 [tag_disabledForMinimalInference]+      (set [true])+      (T.set T.boolean),+    expectPoly 2 [tag_disabledForMinimalInference]+      (set [set []])+      ["t0"] (T.set $ T.set $ T.var "t0")]++testGroupForSums :: TTerm TestGroup+testGroupForSums = supergroup "Sum terms" [+    subgroup "Singleton sum terms" [+      expectMono 1 [tag_disabledForMinimalInference]+        (sum 0 1 (string "foo"))+        (T.sum [T.string]),+      expectPoly 2 [tag_disabledForMinimalInference]+        (sum 0 1 (list []))+        ["t0"] (T.sum [T.list $ T.var "t0"])],++    subgroup "Non-singleton sum terms" [+      expectPoly 1 [tag_disabledForMinimalInference]+        (sum 0 2 (string "foo"))+        ["t0"] (T.sum [T.string, T.var "t0"]),+      expectPoly 2 [tag_disabledForMinimalInference]+        (sum 1 2 (string "foo"))+        ["t0"] (T.sum [T.var "t0", T.string])]]
+ src/main/haskell/Hydra/Sources/Test/Inference/AlgorithmW.hs view
@@ -0,0 +1,196 @@+module Hydra.Sources.Test.Inference.AlgorithmW (algorithmWTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Phantoms as Base+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph+import Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T+import Hydra.Sources.Test.Inference.Fundamentals++import qualified Data.Map as M+import Prelude hiding (map, sum)+++algorithmWTests :: TTerm TestGroup+algorithmWTests = supergroup "Algorithm W test cases" [+  testGroupForSystemF]++-- @wisnesky's original Algorithm W test cases, modified so as to normalize type variables+testGroupForSystemF :: TTerm TestGroup+testGroupForSystemF = subgroup "STLC to System F" [++--  --Untyped input:+--  --	(\x. x)+--  --System F type:+--  -- 	(v0 -> v0)+    expectPoly 1 []+      (lambda "x" $ var "x")+      ["t0"] (T.functionMany [T.var "t0", T.var "t0"]),++--  --Untyped input:+--  --	letrecs foo = (\x. x)+--  --		in 42+--  --System F type:+--  -- 	Nat+    expectMono 2 []+      (lets [+        "foo" >: lambda "x" $ var "x"]+        $ int32 42)+      T.int32,++--  --Untyped input:+--  --	let f = (\x. x) in (f 0)+--  --System F type:+--  -- 	Nat+    expectMono 3 []+      (lets [+        "f" >: lambda "x" $ var "x"]+        $ var "f" @@ int32 0)+      T.int32,++--  --Untyped input:+--  --	let f = ((\x. x) 0) in f+--  --System F type:+--  -- 	Nat+    expectMono 4 []+      (lets [+        "f" >: (lambda "x" $ var "x") @@ int32 0]+        $ var "f")+      T.int32,++---- TODO+----testAdt3 = TestCase "testAdt3" $ Abs "z" $ ExprConst (Fold "List")+----  @@ Var "z"+----  @@ ExprConst (Con "Nil")+----  @@ ExprConst (Con "Cons")+----+----foldl :: TTerm ((b -> a -> b) -> b -> [a] -> b)+----cons :: TTerm (a -> [a] -> [a])+----+----[testAdt3]+----Untyped input:+----	(\z. (fold_List z Nil Cons))+----Type inferred by Hindley-Milner:+----	(List v6 -> List v6)+----+----System F translation:+----	(\z:List v6 . ((fold_List [List v6 ,v6]) z (Nil [v6]) (Cons [v6])))+----  H.it "testAdt3" $ expectPolytype+----    ()+----    [t0] (tFun t0 t0)+--+--  --Untyped input:+--  --	let sng = (\x. (cons x nil)) in sng+--  --System F type:+--  -- 	(v5 -> (List v5))+    expectPoly 5 []+      (lets [+        "sng" >: lambda "x" $ list [var "x"]]+        $ var "sng")+      ["t0"] (T.function (T.var "t0") (T.list $ T.var "t0")),++--  --Untyped input:+--  --	let sng = (\x. (cons x nil)) in (pair (sng 0) (sng alice))+--  --System F type:+--  -- 	((List Nat) * (List String))+    expectMono 6 []+      (lets [+        "sng" >: lambda "x" $ list [var "x"]]+        $ pair (var "sng" @@ int32 0) (var "sng" @@ string "alice"))+      (T.pair (T.list T.int32) (T.list T.string)),++--  --Untyped input:+--  --	letrecs + = (\x. (\y. (S (+ (P x) y))))+--  --		in (+ (S (S 0)) (S 0))+--  --System F type:+--  -- 	Nat+    expectMono 7 []+      (lets [+        "+" >: lambdas ["x", "y"] (primSucc @@ (var "+" @@ (primPred @@ var "x") @@ var "y"))]+        $ var "+" @@ (primSucc @@ (primSucc @@ int32 0)) @@ (primSucc @@ int32 0))+      T.int32,++--  --Untyped input:+--  --	letrecs f = (\x. (\y. (f 0 x)))+--  --		in f+--  --System F type:+--  -- 	(Nat -> (Nat -> v5))+    expectPoly 9 []+      (lets [+        "f" >: lambdas ["x", "y"] (var "f" @@ int32 0 @@ var "x")]+        $ var "f")+      ["t0"] (T.functionMany [T.int32, T.int32, T.var "t0"]),++----Untyped input:+----	letrec f = (\x. (\y. (f 0 x)))+----		g = (\xx. (\yy. (g 0 xx)))+----		in (pair f g)+----Type inferred by Hindley-Milner:+----	((Int32 -> (Int32 -> v12)) * (Int32 -> (Int32 -> v14)))+    expectPoly 10 []+      (lets [+        "f">: lambdas ["x", "y"] (var "f" @@ int32 0 @@ var "x"),+        "g">: lambda "xx" $ lambda "yy" (var "g" @@ int32 0 @@ var "xx")]+        $ pair (var "f") (var "g"))+      ["t0", "t1"] (T.pair+        (T.functionMany [T.int32, T.int32, T.var "t0"])+        (T.functionMany [T.int32, T.int32, T.var "t1"])),++    -- Note: in the following three test cases, the original Algorithm W implementation and the new inference+    --       implementation find slightly different results. This is a result of tradeoffs between stronger support+    --       for monomorphic recursion vs. stronger support for wide letrecs with polymorphism.+--  --Untyped input:+--  --	letrecs f = (\x. (\y. (g 0 x)))+--  --		g = (\u. (\v. (f v 0)))+--  --		in (pair f g)+--  --System F type:+--  -- 	((v12 -> (Nat -> v13)) * (Nat -> (v15 -> v16)))+    expectPoly 11 []+      (lets [+        "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),+        "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)]+        $ pair (var "f") (var "g"))+      ["t0", "t1", "t2", "t3"] (T.pair+        (T.functionMany [T.var "t0", T.int32, T.var "t1"])+        (T.functionMany [T.int32, T.var "t2", T.var "t3"])),++--  --Untyped input:+--  --	letrecs f = (\x. (\y. (g 0 0)))+--  --		g = (\u. (\v. (f v 0)))+--  --		in (pair f g)+--  --System F type:+--  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))+    expectPoly 12 []+      (lets [+        "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ int32 0),+        "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)]+        $ pair (var "f") (var "g"))+      ["t0", "t1"] (T.pair+        (T.functionMany [T.int32, T.int32, T.var "t0"])+        (T.functionMany [T.int32, T.int32, T.var "t1"])),++--  --Untyped input:+--  --	letrecs f = (\x. (\y. (g 0 x)))+--  --		g = (\u. (\v. (f 0 0)))+--  --		in (pair f g)+--  --System F type:+--  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))+    expectPoly 13 []+      (lets [+        "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),+        "g">: lambda "u" $ lambda "v" (var "f" @@ int32 0 @@ int32 0)]+        $ pair (var "f") (var "g"))+      ["t0", "t1"] (T.pair+        (T.functionMany [T.int32, T.int32, T.var "t0"])+        (T.functionMany [T.int32, T.int32, T.var "t1"]))]+  where+    -- Placeholders for the primitives in @wisnesky's test cases; they are not necessarily the same functions,+    -- but they have the same types.+    primPred = primitive _math_neg+    primSucc = primitive _math_neg
+ src/main/haskell/Hydra/Sources/Test/Inference/Failures.hs view
@@ -0,0 +1,428 @@+module Hydra.Sources.Test.Inference.Failures (failureTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph++import           Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T++import qualified Data.Map as M+import qualified Data.Set as S+import Prelude hiding (map, sum)+++failureTests :: TTerm TestGroup+failureTests = supergroup "Expected failures" [+  undefinedVariableTests,+  unificationFailureTests,+  invalidApplicationTests,+  selfApplicationTests,+  arityMismatchTests,+  recursiveTypeTests,+  occurCheckTests,+  typeConstructorMisuseTests,+  polymorphismViolationTests,+  letBindingMismatchTests,+  constraintSolverEdgeCaseTests,+  primitiveTypeErrorTests,+  complexConstraintFailureTests]++undefinedVariableTests :: TTerm TestGroup+undefinedVariableTests = supergroup "Undefined variable" [+  subgroup "Basic unbound variables" [+    expectFailure 1 []+      (var "x"),+    expectFailure 2 []+      (lambda "x" $ var "y"),+    expectFailure 3 []+      (lets ["x">: int32 42] $ var "y")],++  subgroup "Unbound in let expressions" [+    expectFailure 1 []+      (lets ["x">: var "y"] $ var "x"),+    expectFailure 2 []+      (lets ["x">: var "y", "z">: int32 42] $ var "x"),+    expectFailure 3 []+      (lets ["x">: int32 42, "y">: var "z"] $ pair (var "x") (var "y"))],++  subgroup "Shadowing scope errors" [+    expectFailure 1 []+      (lambda "x" $ lets ["y">: var "x"] $ var "z"),+    expectFailure 2 []+      (lets ["x">: int32 42] $ lets ["y">: var "x"] $ var "z"),+    expectFailure 3 []+      (lets ["x">: lambda "y" $ var "z"] $ var "x")]]++unificationFailureTests :: TTerm TestGroup+unificationFailureTests = supergroup "Unification failure" [+  subgroup "Basic type mismatches" [+    expectFailure 1 []+      (primitive _math_add @@ int32 42 @@ string "foo"),+    expectFailure 2 []+      (list [int32 42, string "foo"]),+    expectFailure 3 []+      (list [list [int32 42], string "foo"]),+    expectFailure 4 []+      (pair (int32 42) (string "foo") @@ string "bar")],++  subgroup "Collection type mismatches" [+    expectFailure 1 []+      (primitive _lists_cons @@ int32 42 @@ string "not a list"),+    expectFailure 2 []+      (list [int32 42, list [string "foo"]]),+    expectFailure 3 []+      (pair (list [int32 42]) (list [string "foo"]) @@ int32 137),+    expectFailure 4 []+      (primitive _lists_concat @@ list [list [int32 42], list [string "foo"]])],++  subgroup "Conditional type mismatches" [+    expectFailure 1 []+      (primitive _logic_ifElse @@ true @@ int32 42 @@ string "foo"),+    expectFailure 2 []+      (primitive _logic_ifElse @@ true @@ list [int32 42] @@ string "foo"),+    expectFailure 3 []+      (primitive _logic_ifElse @@ true @@ (lambda "x" $ var "x") @@ int32 42)],++  subgroup "Polymorphic instantiation conflicts" [+    expectFailure 1 []+      (lets ["f">: lambda "x" $ var "x"] $+        list [var "f" @@ int32 42, var "f" @@ string "foo"]),+    expectFailure 2 []+      (lets ["id">: lambda "x" $ var "x"] $+        pair (var "id" @@ int32 42) (var "id" @@ string "foo") @@ true),+    expectFailure 3 []+      (lets ["cons">: primitive _lists_cons] $+        list [var "cons" @@ int32 42, var "cons" @@ string "foo"])]]++invalidApplicationTests :: TTerm TestGroup+invalidApplicationTests = supergroup "Invalid application" [+  subgroup "Non-function application" [+    expectFailure 1 []+      (int32 42 @@ int32 137),+    expectFailure 2 []+      (string "foo" @@ int32 42),+    expectFailure 3 []+      (true @@ false),+    expectFailure 4 []+      (float64 3.14 @@ int32 42)],++  subgroup "Collection application" [+    expectFailure 1 []+      (list [int32 42] @@ string "bar"),+    expectFailure 2 []+      (pair (int32 42) (string "foo") @@ true),+    expectFailure 3 []+      (list [] @@ int32 42),+    expectFailure 4 []+      (tuple [int32 1, int32 2, int32 3] @@ string "index")],++  subgroup "Primitive misapplication" [+    expectFailure 1 []+      (primitive _maps_empty @@ string "foo"),+    expectFailure 2 []+      (primitive _sets_empty @@ int32 42),+    expectFailure 3 []+      (optional nothing @@ string "value"),+    expectFailure 4 []+      (list [] @@ true)]]++selfApplicationTests :: TTerm TestGroup+selfApplicationTests = supergroup "Self-application" [+  subgroup "Direct self-application" [+    expectFailure 1 []+      (lambda "x" $ var "x" @@ var "x"),+    expectFailure 2 []+      (lets ["f">: var "f" @@ var "f"] $ var "f")],++  subgroup "Indirect self-application" [+    expectFailure 1 []+      (lets ["f">: lambda "x" $ var "g" @@ var "f", "g">: lambda "y" $ var "y" @@ var "y"] $ var "f"),+    expectFailure 2 []+      (lets ["a">: var "b" @@ var "a", "b">: lambda "x" $ var "x" @@ var "x"] $ var "a"),+    expectFailure 3 []+      (lets ["cycle">: lambda "f" $ var "f" @@ var "cycle"] $ var "cycle" @@ var "cycle")]]++arityMismatchTests :: TTerm TestGroup+arityMismatchTests = supergroup "Arity mismatch" [+  subgroup "Too many arguments" [+    expectFailure 1 []+      (primitive _math_add @@ int32 42 @@ int32 137 @@ int32 999),+    expectFailure 2 []+      ((lambda "x" $ lambda "y" $ var "x") @@ int32 42 @@ string "foo" @@ true),+    expectFailure 3 []+      (primitive _lists_cons @@ int32 42 @@ list [int32 137] @@ string "extra")],++  subgroup "Wrong argument types with extra args" [+    expectFailure 1 []+      (primitive _strings_length @@ int32 42 @@ string "extra"),+    expectFailure 2 []+      (primitive _logic_not @@ int32 42 @@ true),+    expectFailure 3 []+      ((lambda "x" $ int32 42) @@ string "arg" @@ int32 137 @@ true)]]++recursiveTypeTests :: TTerm TestGroup+recursiveTypeTests = supergroup "Recursive type construction" [+  subgroup "Direct recursive types" [+    expectFailure 1 []+      (lets ["x">: list [var "x"]] $ var "x"),+    expectFailure 2 []+      (lets ["x">: pair (var "x") (int32 42)] $ var "x"),+    expectFailure 3 []+      (lets ["x">: tuple [var "x", var "x"]] $ var "x")],++  subgroup "Recursive function types" [+    expectFailure 1 []+      (lets ["f">: lambda "x" $ var "f"] $ var "f"),+    expectFailure 2 []+      (lets ["f">: lambda "x" $ lambda "y" $ var "f" @@ var "f"] $ var "f"),+    expectFailure 3 []+      (lets ["f">: lambda "x" $ list [var "f"]] $ var "f")],++  subgroup "Mutually recursive types" [+    expectFailure 1 []+      (lets ["x">: list [var "y"], "y">: pair (var "x") (int32 42)] $ var "x"),+    expectFailure 2 []+      (lets ["a">: lambda "x" $ var "b", "b">: var "a"] $ var "a"),+    expectFailure 3 []+      (lets ["f">: list [var "g"], "g">: tuple [var "f", var "f"]] $ var "f")]]++occurCheckTests :: TTerm TestGroup+occurCheckTests = supergroup "Occur check failures" [+  subgroup "Function occur checks" [+    expectFailure 1 []+      (lets ["g">: lambda "h" $ var "g" @@ var "g" @@ var "h"] $ var "g")],++  subgroup "Mutual occur checks" [+    expectFailure 1 []+      (lets [+        "f">: lambda "x" $ var "g" @@ var "f",+        "g">: lambda "y" $ var "f" @@ var "g"] $ var "f"),+    expectFailure 2 []+      (lets [+        "a">: lambda "x" $ var "b" @@ var "a" @@ var "x",+        "b">: lambda "y" $ var "a" @@ var "b"] $ var "a"),+    expectFailure 3 []+      (lets [+        "cycle1">: var "cycle2" @@ var "cycle1",+        "cycle2">: lambda "x" $ var "cycle1" @@ var "x"] $ var "cycle1")],++  subgroup "Complex occur checks" [+    expectFailure 1 []+      (lets ["omega">: lambda "x" $ var "x" @@ var "x" @@ var "omega"] $ var "omega"),+    expectFailure 2 []+      (lets ["loop">: lambda "x" $ lambda "y" $ var "loop" @@ (var "x" @@ var "loop") @@ var "y"] $ var "loop")]]++typeConstructorMisuseTests :: TTerm TestGroup+typeConstructorMisuseTests = supergroup "Type constructor misuse" [+  subgroup "List constructor errors" [+    expectFailure 1 []+      (primitive _lists_cons @@ (list [int32 42]) @@ int32 137),  -- Wrong order+    expectFailure 2 []+      (primitive _lists_length @@ int32 42),  -- Not a list+    expectFailure 3 []+      (primitive _lists_head @@ string "not a list"),+    expectFailure 4 []+      (primitive _lists_tail @@ int32 42)],++  subgroup "String constructor errors" [+    expectFailure 1 []+      (primitive _strings_length @@ list [string "foo"]),  -- Not a string+    expectFailure 2 []+      (primitive _strings_cat @@ int32 42),+    expectFailure 3 []+      (primitive _strings_fromList @@ string "not a list"),+    expectFailure 4 []+      (primitive _strings_toList @@ int32 42)],++  subgroup "Math constructor errors" [+    expectFailure 1 []+      (primitive _math_add @@ list [int32 42] @@ int32 137),  -- Wrong type for math+    expectFailure 2 []+      (primitive _math_sub @@ string "not a number" @@ int32 42),+    expectFailure 3 []+      (primitive _math_mul @@ int32 42 @@ string "not a number"),+    expectFailure 4 []+      (primitive _math_div @@ true @@ false)]]++polymorphismViolationTests :: TTerm TestGroup+polymorphismViolationTests = supergroup "Polymorphism violations" [+  subgroup "Identity function violations" [+    expectFailure 1 []+      (lets ["id">: lambda "x" $ var "x"] $+        primitive _math_add @@ (var "id" @@ int32 42) @@ (var "id" @@ string "foo")),+    expectFailure 2 []+      (lets ["id">: lambda "x" $ var "x"] $+        list [var "id" @@ int32 42, var "id" @@ string "foo"]),+    expectFailure 3 []+      (lets ["id">: lambda "x" $ var "x"] $+        pair (var "id" @@ int32 42) (var "id" @@ string "foo") @@ true)],++  subgroup "Constrained polymorphism violations" [+    expectFailure 1 []+      (lets ["f">: lambda "x" $ list [var "x", int32 42]] $ var "f" @@ string "foo"),+    expectFailure 2 []+      (lets ["g">: lambda "x" $ pair (var "x") (string "constant")] $+        primitive _math_add @@ (first $ var "g" @@ int32 42) @@ (first $ var "g" @@ string "bad")),+    expectFailure 3 []+      (lets ["h">: lambda "x" $ primitive _lists_cons @@ var "x" @@ list [int32 0]] $+        var "h" @@ string "incompatible")],++  subgroup "Higher-order polymorphism violations" [+    expectFailure 1 []+      (lambda "f" $ pair (var "f" @@ int32 42) (var "f" @@ string "foo")),+    expectFailure 2 []+      (lambda "g" $ list [var "g" @@ int32 1, var "g" @@ string "bad"]),+    expectFailure 3 []+      (lambda "h" $ primitive _math_add @@ (var "h" @@ int32 42) @@ (var "h" @@ string "error"))]]++letBindingMismatchTests :: TTerm TestGroup+letBindingMismatchTests = supergroup "Let binding type mismatches" [+  subgroup "Application type mismatches" [+    expectFailure 1 []+      (lets [+        "x">: int32 42,+        "y">: var "x" @@ string "foo"] $ var "y"),+    expectFailure 2 []+      (lets [+        "f">: lambda "x" $ string "result",+        "g">: var "f" @@ int32 42 @@ string "extra"] $ var "g"),+    expectFailure 3 []+      (lets [+        "num">: int32 42,+        "bad">: var "num" @@ var "num"] $ var "bad")],++  subgroup "Collection type mismatches" [+    expectFailure 1 []+      (lets [+        "list1">: list [int32 42],+        "list2">: primitive _lists_cons @@ string "foo" @@ var "list1"] $ var "list2"),+    expectFailure 2 []+      (lets [+        "nums">: list [int32 1, int32 2],+        "mixed">: primitive _lists_cons @@ string "bad" @@ var "nums"] $ var "mixed"),+    expectFailure 3 []+      (lets [+        "pair1">: pair (int32 42) (string "foo"),+        "pair2">: pair (string "bar") (var "pair1")] $+        primitive _math_add @@ (first $ var "pair2") @@ int32 1)],++  subgroup "Function binding mismatches" [+    expectFailure 1 []+      (lets [+        "add">: primitive _math_add,+        "badCall">: var "add" @@ string "not a number" @@ int32 42] $+        var "badCall"),+    expectFailure 2 []+      (lets [+        "f">: lambda "x" $ lambda "y" $ var "x",+        "g">: var "f" @@ int32 42,+        "bad">: var "g" @@ string "foo" @@ true] $+        var "bad")]]++constraintSolverEdgeCaseTests :: TTerm TestGroup+constraintSolverEdgeCaseTests = supergroup "Constraint solver edge cases" [+  subgroup "Complex constraint propagation" [+    expectFailure 1 []+      (lets [+        "complex">: lambda "f" $ lambda "g" $ lambda "x" $+          var "f" @@ (var "g" @@ var "x") @@ (var "g" @@ (var "f" @@ var "x")),+        "bad">: var "complex" @@ (lambda "a" $ int32 42) @@ (lambda "b" $ string "foo")] $ var "bad")],++  subgroup "Fixed point combinators" [+    expectFailure 1 []+      (lets [+        "fix">: lambda "f" $ var "f" @@ var "f",+        "bad">: var "fix" @@ (lambda "x" $ var "x" @@ var "x")] $ var "bad"),+    expectFailure 2 []+      (lets [+        "y">: lambda "f" $ (lambda "x" $ var "f" @@ (var "x" @@ var "x")) @@+                           (lambda "x" $ var "f" @@ (var "x" @@ var "x")),+        "bad">: var "y" @@ (lambda "rec" $ lambda "n" $ var "rec" @@ var "rec")] $ var "bad"),+    expectFailure 3 []+      (lets [+        "omega">: lambda "x" $ var "x" @@ var "x",+        "bad">: var "omega" @@ var "omega"] $ var "bad")],++  subgroup "Constraint cycles" [+    expectFailure 1 []+      (lets [+        "a">: lambda "x" $ var "b" @@ var "c" @@ var "x",+        "b">: lambda "y" $ var "c" @@ var "a" @@ var "y",+        "c">: lambda "z" $ var "a" @@ var "b" @@ var "z"] $+        var "a" @@ int32 42),+    expectFailure 2 []+      (lets [+        "circular">: lambda "f" $ var "f" @@ var "circular" @@ var "f"] $+        var "circular" @@ var "circular")]]++primitiveTypeErrorTests :: TTerm TestGroup+primitiveTypeErrorTests = supergroup "Primitive function type errors" [+  subgroup "Logic primitive errors" [+    expectFailure 1 []+      (primitive _logic_ifElse @@ int32 42 @@ true @@ false),  -- Condition not boolean+    expectFailure 2 []+      (primitive _logic_ifElse @@ true @@ int32 42 @@ false),  -- Branch type mismatch+    expectFailure 3 []+      (primitive _logic_and @@ int32 42 @@ true),+    expectFailure 4 []+      (primitive _logic_or @@ true @@ string "not boolean")],++  subgroup "Collection primitive errors" [+    expectFailure 1 []+      (primitive _maps_lookup @@ int32 42 @@ string "not a map"),  -- Not a map+    expectFailure 2 []+      (primitive _sets_member @@ int32 42 @@ list [int32 42]),  -- Not a set+    expectFailure 3 []+      (primitive _lists_head @@ string "not a list"),+    expectFailure 4 []+      (primitive _optionals_fromMaybe @@ int32 42 @@ string "not optional")],++  subgroup "Math primitive errors" [+    expectFailure 1 []+      (primitive _math_add @@ string "not a number" @@ int32 42),+    expectFailure 2 []+      (primitive _math_mul @@ true @@ false),+    expectFailure 3 []+      (primitive _math_div @@ list [int32 42] @@ int32 2),+    expectFailure 4 []+      (primitive _math_mod @@ int32 42 @@ string "not a number")]]++complexConstraintFailureTests :: TTerm TestGroup+complexConstraintFailureTests = supergroup "Complex constraint failures" [+  subgroup "Multi-level constraint conflicts" [+    expectFailure 1 []+      (lets [+        "f">: lambda "x" $ lambda "y" $ pair (var "x") (var "y"),+        "g">: lambda "a" $ var "f" @@ var "a" @@ var "a",+        "h">: var "g" @@ (lambda "z" $ var "z")] $ var "h" @@ int32 42),+    expectFailure 2 []+      (lets [+        "weird">: lambda "f" $ lambda "x" $ var "f" @@ (var "f" @@ var "x"),+        "bad">: var "weird" @@ (lambda "y" $ pair (var "y") (int32 42))] $ var "bad"),+    expectFailure 3 []+      (lets [+        "nested">: lambda "f" $ lambda "g" $ lambda "x" $+          var "f" @@ (var "g" @@ (var "f" @@ (var "g" @@ var "x"))),+        "int_f">: lambda "n" $ primitive _math_add @@ var "n" @@ int32 1,+        "str_g">: lambda "s" $ primitive _strings_cat @@ list [var "s", string "!"],+        "bad">: var "nested" @@ var "int_f" @@ var "str_g"] $ var "bad")],++  subgroup "Function composition failures" [+    expectFailure 1 []+      (lets [+        "triple">: lambda "f" $ lambda "x" $ var "f" @@ (var "f" @@ (var "f" @@ var "x")),+        "increment">: lambda "n" $ primitive _math_add @@ var "n" @@ int32 1,+        "stringify">: lambda "s" $ primitive _strings_cat @@ list [var "s", string "!"],+        "bad">: var "triple" @@ var "increment" @@ var "stringify"] $ var "bad"),+    expectFailure 2 []+      (lets [+        "compose">: lambda "f" $ lambda "g" $ lambda "x" $ var "f" @@ (var "g" @@ var "x"),+        "reverse_compose">: lambda "g" $ lambda "f" $ lambda "x" $ var "f" @@ (var "g" @@ var "x"),+        "bad">: var "compose" @@ var "reverse_compose" @@ primitive _math_add @@ primitive _strings_length] $+        var "bad")]]
+ src/main/haskell/Hydra/Sources/Test/Inference/Fundamentals.hs view
@@ -0,0 +1,454 @@+module Hydra.Sources.Test.Inference.Fundamentals (fundamentalsTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph++import           Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T++import qualified Data.Map as M+import Prelude hiding (map, sum)+++fundamentalsTests :: TTerm TestGroup+fundamentalsTests = supergroup "Fundamentals" [+  testGroupForLambdas,+  testGroupForLet,+  testGroupForLiterals,+  testGroupForPathologicalTerms,+  testGroupForPolymorphism,+  testGroupForPrimitives]++testGroupForLambdas :: TTerm TestGroup+testGroupForLambdas = supergroup "Lambdas" [+    subgroup "Simple lambdas" [+      expectPoly 1 []+        (lambda "x" $ var "x")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectPoly 2 []+        (lambda "x" $ int16 137)+        ["t0"] (T.function (T.var "t0") T.int16)],++    subgroup "Nested lambdas" [+      expectMono 1 []+        (lambda "x" $ lambda "y" $ primitive _math_add @@ var "x" @@ var "y")+        (T.functionMany [T.int32, T.int32, T.int32]),+      expectMono 2 []+        (lambda "x" $ list [lambda "y" $ primitive _math_add @@ var "x" @@ var "y"])+        (T.function T.int32 $ T.list $ T.function T.int32 T.int32)],++    subgroup "Nested lambdas with shadowing" [+      expectPoly 1 []+        (lambda "x" $ lambda "x" $ primitive _math_add @@ var "x" @@ int32 42)+        ["t0"] (T.function (T.var "t0") (T.function T.int32 T.int32))]]++testGroupForLet :: TTerm TestGroup+testGroupForLet = supergroup "Let terms" [++    subgroup "Simple" [+      expectPoly 1  []+        (lets ["x">: float32 42.0] (lambda "y" (lambda "z" (var "x"))))+        ["t0", "t1"] (T.function (T.var "t0") (T.function (T.var "t1") T.float32))],+    subgroup "Empty let" [+      expectMono 1 []+        (lets [] $ int32 42)+        T.int32,+      expectPoly 2 []+        (lets [] $ lambda "x" $ var "x")+        ["t0"] (T.function (T.var "t0") (T.var "t0"))],+    subgroup "Trivial let" [+      expectMono 1  []+        (lets [+          "foo">: int32 42]+          $ var "foo")+        T.int32],+    subgroup "Multiple references to a let-bound term" [+      expectMono 1 []+        (lets [+          "foo">: int32 42,+          "bar">: int32 137]+          $ list [var "foo", var "bar", var "foo"])+        (T.list T.int32)],++    subgroup "Nested let" [+      expectMono 1 []+        (lets [+          "foo">: int32 42]+          $ lets [+            "bar">: int32 137]+            $ list [var "foo", var "bar"])+        (T.list T.int32),+      expectMono 2 []+        (lets [+          "foo">: int32 42]+          $ lets [+            "bar">: pair (var "foo") (int32 137)]+            $ var "bar")+        (T.pair T.int32 T.int32),+      expectPoly 3 []+        (lets [+          "sng">: lambda "x" $ list [var "x"]]+          $ lets [+            "foo">: var "sng" @@ int32 42,+            "bar">: var "sng" @@ string "bar",+            "quux">: lambda "x" $ var "sng" @@ var "x"]+            $ pair (var "foo") (pair (var "bar") (var "quux" @@ list [])))+        ["t0"] (T.pair (T.list T.int32) (T.pair (T.list T.string) (T.list $ T.list $ T.var "t0")))],++    subgroup "Nested let with shadowing" [+      expectMono 1 []+        (lets [+          "foo">: string "foo"]+          $ lets [+            "foo">: int32 137]+            $ var "foo")+        T.int32,+      expectMono 2 []+        (lets [+          "foo">: string "foo",+          "bar">: var "foo"]+          $ lets [+            "foo">: int32 137]+            $ pair (var "bar") (var "foo"))+        (T.pair T.string T.int32)],++    subgroup "Let-polymorphism" [+      expectPoly 1 []+        (lets [+          "id">: lambda "x" $ var "x"]+          $ lambda "x" $ var "id" @@ (var "id" @@ var "x"))+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectMono 2 []+        (lets [+          "id">: lambda "x" $ var "x"]+          $ var "id" @@ (list [var "id" @@ int32 42]))+        (T.list T.int32),+      expectPoly 3 []+        (lets [+          "id">: lambda "x" $ var "x"]+          $ lambda "x" (var "id" @@ (list [var "id" @@ var "x"])))+        ["t0"] (T.function (T.var "t0") (T.list $ T.var "t0")),+      expectMono 4 []+        (lets [+          "id">: lambda "x" $ var "x"]+          $ pair (var "id" @@ int32 42) (var "id" @@ string "foo"))+        (T.pair T.int32 T.string),+      expectMono 5 []+        (lets [+          "list">: lambda "x" $ list [var "x"]]+          $ pair (var "list" @@ int32 42) (var "list" @@ string "foo"))+        (T.pair (T.list T.int32) (T.list T.string)),+      expectPoly 6 [tag_disabled]+        (lets [+          "singleton">: lambda "x" $ list [var "x"],+          "f">: lambda "x" $ lambda "y" $ primitive _lists_cons+            @@ (pair (var "singleton" @@ var "x") (var "singleton" @@ var "y"))+            @@ (var "g" @@ var "x" @@ var "y"),+          "g">: lambda "x" $ lambda "y" $ var "f" @@ int32 42 @@ var "y"]+          $ var "f")+        ["t0"] (T.list $ T.pair T.int32 (T.var "t0")),+      expectMono 7 [tag_disabledForMinimalInference]+        (lets [+          "id">: lambda "x" $ var "x",+          "fortytwo">: var "id" @@ int32 42,+          "foo">: var "id" @@ string "foo"]+          $ pair (var "fortytwo") (var "foo"))+        (T.pair T.int32 T.string),+      expectMono 8 [tag_disabledForMinimalInference]+        (lets [+          "fortytwo">: var "id" @@ int32 42,+          "id">: lambda "x" $ var "x",+          "foo">: var "id" @@ string "foo"]+          $ pair (var "fortytwo") (var "foo"))+        (T.pair T.int32 T.string)],++    subgroup "Recursive and mutually recursive let (@wisnesky's test cases)" [+      expectPoly 1 []+        (lets [+          "f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")]+          $ var "f")+        ["t0"] (T.function T.int32 (T.function T.int32 (T.var "t0"))),+      -- Try: :t (let (f, g) = (g, f) in (f, g))+      expectPoly 2 []+        (lets [+          "x">: var "y",+          "y">: var "x"] $+          pair (var "x") (var "y"))+        ["t0", "t1"] (T.pair (T.var "t0") (T.var "t1")),+      expectPoly 3 [tag_disabled]+        (lets [+          "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),+          "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)]+          $ pair (var "f") (var "g"))+        ["t0", "t1"] (T.pair+          (T.functionMany [T.var "t0", T.int32, T.var "t1"])+          (T.functionMany [T.int32, T.var "v0", T.var "t1"])),+      expectMono 4 []+        -- letrec + = (\x . (\y . (S (+ (P x) y)))) in (+ (S (S 0)) (S 0))+        (lets [+          "plus">: lambda "x" $ lambda "y" $ s @@ (var "plus" @@ (p @@ var "x") @@ var "y")]+          $ var "plus" @@ (s @@ (s @@ int32 0)) @@ (s @@ int32 0))+        T.int32,+      expectMono 5 []+        -- letrecs id = (\z. z)+        --     f = (\p0. (pair (id p0) (id p0)))+        --     in 0+        (lets [+          "id">: lambda "z" $ var "z",+          "f">: lambda "p0" $ pair (var "id" @@ var "p0") (var "id" @@ var "p0")]+          $ int32 0)+        T.int32,+      expectPoly 6 []+        (lets [+           "x">: lambda "y" $ var "y",+           "z">: var "x"] $+           pair (var "x") (var "z"))+        ["t0", "t1"] (T.pair (T.function (T.var "t0") (T.var "t0")) (T.function (T.var "t1") (T.var "t1"))),+      expectPoly 7 []+        (lets [+           "x">: lambda "y" $ var "y",+           "z">: var "x",+           "w">: var "z"] $+           pair (var "x") (pair (var "w") (var "z")))+        ["t0", "t1", "t2"] (T.product [+          T.function (T.var "t0") (T.var "t0"),+          T.product [+          T.function (T.var "t1") (T.var "t1"),+          T.function (T.var "t2") (T.var "t2")]])],++    subgroup "Recursive and mutually recursive let with polymorphism" [+      expectMono 1 []+        (lets [+          "id">: lambda "x" $ var "x",+          "f">: primitive _strings_length @@ var "g",+          "g">: primitive _strings_fromList @@ list [var "f"]]+          $ pair (var "f") (var "g"))+        (T.pair T.int32 T.string),+      expectMono 2 [tag_disabledForMinimalInference]+        (lets [+          "id">: lambda "x" $ var "x",+          "f">: var "id" @@ (primitive _strings_length @@ var "g"),+          "g">: var "id" @@ (primitive _strings_fromList @@ list [var "f"])]+          $ pair (var "f") (var "g"))+        (T.pair T.int32 T.string),+      expectMono 3 [tag_disabledForMinimalInference]+        (lets [+          "f">: var "id" @@ (primitive _strings_length @@ var "g"),+          "id">: lambda "x" $ var "x",+          "g">: var "id" @@ (primitive _strings_fromList @@ list [var "f"])]+          $ pair (var "f") (var "g"))+        (T.pair T.int32 T.string)],++    subgroup "Recursion involving polymorphic functions" [ -- Note: not 'polymorphic recursion' per se+      expectPoly 1 []+        (lets [+          "f">: lambda "b" $ lambda "x" $ primitive _logic_ifElse @@ var "b" @@ list [list [var "x"]] @@ (var "g" @@ var "b" @@ var "x"),+          "g">: lambda "b" $ lambda "x" $ primitive _logic_ifElse @@ var "b" @@ (var "f" @@ var "b" @@ var "x") @@ list [list [var "x"]]]+          $ var "f")+        ["t0"] (T.functionMany [T.boolean, T.var "t0", T.list $ T.list $ T.var "t0"]),++      -- The recursive pattern of hydra.rewriting.foldOverType is similar to this example.+      expectPoly 2 [tag_disabledForMinimalInference]+        (lets [+          "inst">: var "rec" @@ (lambda "x" false) @@ false,+          "rec">: lambda "f" $ lambda "b0" $ var "f" @@ (var "rec" @@ var "f" @@ var "b0")] $+          pair (var "inst") (var "rec"))+        ["t0", "t1"] (T.pair T.boolean (T.functionMany [T.function (T.var "t0") (T.var "t0"), T.var "t1", T.var "t0"])),+      expectPoly 3 [tag_disabledForMinimalInference] -- Try with GHC:    :t let inst = rec (\x -> False); rec = \f -> f (rec f) in (inst, rec)+        (lets [+          "inst">: var "rec" @@ (lambda "x" false),+          "rec">: lambda "f" $ var "f" @@ (var "rec" @@ var "f")] $+          pair (var "inst") (var "rec"))+        ["t0"] (T.pair T.boolean (T.functionMany [T.function (T.var "t0") (T.var "t0"), T.var "t0"])),+      expectPoly 4 [tag_disabledForMinimalInference]+        (lets [+          "inst1">: var "rec" @@ (lambda "x" false),+          "inst2">: var "rec" @@ (lambda "x" $ int32 42),+          "rec">: lambda "f" $ var "f" @@ (var "rec" @@ var "f")] $+          tuple [var "inst1", var "inst2", var "rec"])+        ["t0"] (T.product [T.boolean, T.int32, T.functionMany [T.function (T.var "t0") (T.var "t0"), T.var "t0"]]),++      -- Try: :t let foo = bar; bar = foo in (foo, bar)+      expectPoly 5 [tag_disabledForMinimalInference]+        (lets [+          "foo">: var "bar",+          "bar">: var "foo"] $+          pair (var "foo") (var "bar"))+        ["t0", "t1"] (T.pair (T.var "t0") (T.var "t1"))]]+  where+    s = primitive _math_neg+    p = primitive _math_neg++testGroupForLiterals :: TTerm TestGroup+testGroupForLiterals = subgroup "Literals" [+    expectMono 1 []+      (int32 42)+      T.int32,+    expectMono 2 []+      (string "foo")+      T.string,+    expectMono 3 []+      false+      T.boolean,+    expectMono 4 []+      (float64 42.0)+      T.float64]++testGroupForPathologicalTerms :: TTerm TestGroup+testGroupForPathologicalTerms = supergroup "Pathological terms" [++    subgroup "Recursion" [+      expectPoly 1 []+        (lets [+          "x">: var "x"]+          $ var "x")+        ["t0"] (T.var "t0"),+      expectPoly 2 [tag_disabledForMinimalInference]+        (lets ["id">: lambda "x" $ var "x",+               "weird">: var "id" @@ var "id" @@ var "id"] $+               var "weird")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectPoly 3 []+        (lets ["f">: lambda "x" $ var "f" @@ (var "f" @@ var "x")] $+               var "f")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectPoly 4 []+        (lets ["x">: lambda "y" $+                 var "x" @@ var "y"] $+               var "x")+        ["t0", "t1"] (T.function (T.var "t0") (T.var "t1")),+      expectPoly 5 []+        (lets ["paradox">: lambda "f" $ var "f" @@ (var "paradox" @@ var "f")] $+               var "paradox")+        ["t0"] (T.function (T.function (T.var "t0") (T.var "t0")) (T.var "t0")),+      expectMono 6 []+        (lets [+          "f">: lambda "x" $ var "g" @@ (var "f" @@ var "x"),+          "g">: lambda "y" $ var "f" @@ (var "g" @@ var "y")] $+          var "f" @@ (var "g" @@ int32 42))+        T.int32],++    subgroup "Infinite lists" [+      expectMono 1 []+        (lets [+          "self">: primitive _lists_cons @@ int32 42 @@ var "self"]+          $ var "self")+        (T.list T.int32),+      expectPoly 2  []+        (lambda "x" $ lets [+          "self">: primitive _lists_cons @@ var "x" @@ var "self"]+          $ var "self")+        ["t0"] (T.function (T.var "t0") (T.list $ T.var "t0")),+      expectPoly 3  [tag_disabled]+        (lets [+          "self">: lambda "e" $ primitive _lists_cons @@ var "e" @@ (var "self" @@ var "e")]+          $ lambda "x" $ var "self" @@ var "x")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectMono 4  []+        (lets [+          "build">: lambda "x" $ primitive _lists_cons @@ var "x" @@ (var "build" @@+            (primitive _math_add @@ var "x" @@ int32 1))]+          $ var "build" @@ int32 0)+        (T.list T.int32)]]++testGroupForPolymorphism :: TTerm TestGroup+testGroupForPolymorphism = supergroup "Polymorphism" [++    subgroup "Simple lists and optionals" [+      expectPoly 1 []+        (list [])+        ["t0"] (T.list (T.var "t0")),+      expectPoly 2 [tag_disabledForMinimalInference]+        (optional nothing)+        ["t0"] (T.optional (T.var "t0")),+      expectMono 3 [tag_disabledForMinimalInference]+        (optional $ just $ int32 42)+        (T.optional T.int32)],++    subgroup "Lambdas, lists, and products" [+      expectPoly 1 []+        (lambda "x" $ var "x")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectPoly 2 []+        (lambda "x" $ pair (var "x") (var "x"))+        ["t0"] (T.function (T.var "t0") (T.pair (T.var "t0") (T.var "t0"))),+      expectPoly 3 []+        (lambda "x" $ list [var "x"])+        ["t0"] (T.function (T.var "t0") (T.list $ T.var "t0")),+      expectPoly 4 []+        (list [lambda "x" $ var "x", lambda "y" $ var "y"])+        ["t0"] (T.list (T.function (T.var "t0") (T.var "t0"))),+      expectPoly 5 []+        (list [lambda "x" $ lambda "y" $ pair (var "y") (var "x")])+        ["t0", "t1"] (T.list (T.function (T.var "t0") (T.function (T.var "t1") (T.pair (T.var "t1") (T.var "t0")))))],++    subgroup "Lambdas and application" [+      expectMono 1 []+        ((lambda "x" $ var "x") @@ string "foo")+        T.string],++    subgroup "Primitives and application" [+      expectMono 1 []+        (primitive _lists_concat @@ list [list [int32 42], list []])+        (T.list T.int32)],++    subgroup "Lambdas and primitives" [+      expectMono 1 []+        (primitive _math_add)+        (T.functionMany [T.int32, T.int32, T.int32]),+      expectMono 2 []+        (lambda "x" (primitive _math_add @@ var "x"))+        (T.functionMany [T.int32, T.int32, T.int32]),+      expectMono 3 []+        (lambda "x" (primitive _math_add @@ var "x" @@ var "x"))+        (T.function T.int32 T.int32)],++    subgroup "Mixed expressions with lambdas, constants, and primitive functions" [+      expectMono 1 []+        (lambda "x" $ (primitive _math_sub @@ (primitive _math_add @@ var "x" @@ var "x") @@ int32 1))+        (T.function T.int32 T.int32)]]++testGroupForPrimitives :: TTerm TestGroup+testGroupForPrimitives = supergroup "Primitives" [++    subgroup "Monomorphic primitive functions" [+      expectMono 1 []+        (primitive $ _strings_length)+        (T.function T.string T.int32),+      expectMono 2 []+        (primitive _math_sub)+        (T.functionMany [T.int32, T.int32, T.int32])],++    subgroup "Polymorphic primitive functions" [+      expectPoly 1 []+        (lambda "el" (primitive _lists_length @@ (list [var "el"])))+        ["t0"] (T.function (T.var "t0") T.int32),+      expectMono 2 []+        (lambda "el" (primitive _lists_length @@ (list [int32 42, var "el"])))+        (T.function T.int32 T.int32),+      expectPoly 3 []+        (primitive _lists_concat)+        ["t0"] (T.function (T.list $ T.list $ T.var "t0") (T.list $ T.var "t0")),+      expectPoly 4 []+        (lambda "lists" (primitive _lists_concat @@ var "lists"))+        ["t0"] (T.function (T.list $ T.list $ T.var "t0") (T.list $ T.var "t0")),+      expectPoly 5 []+        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))+        ["t0"] (T.function (T.list $ T.list $ T.var "t0") T.int32),+      expectPoly 6 []+        (lambda "list" (primitive _lists_length @@ (primitive _lists_concat @@ list [var "list", list []])))+        ["t0"] (T.function (T.list $ T.var "t0") T.int32),+      expectPoly 7 []+        (lambda "list" (primitive _math_add+          @@ int32 1+          @@ (primitive _lists_length @@ (primitive _lists_concat @@ list [var "list", list []]))))+        ["t0"] (T.function (T.list $ T.var "t0") T.int32),+      expectPoly 8 []+        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))+        ["t0"] (T.function (T.list $ T.list $ T.var "t0") T.int32)]]
+ src/main/haskell/Hydra/Sources/Test/Inference/InferenceSuite.hs view
@@ -0,0 +1,23 @@+module Hydra.Sources.Test.Inference.InferenceSuite (inferenceTests) where++import Hydra.Kernel+import Hydra.Testing+import Hydra.Dsl.Testing as Testing+import Hydra.Sources.Test.Inference.AlgebraicTypes+import Hydra.Sources.Test.Inference.AlgorithmW+import Hydra.Sources.Test.Inference.Failures+import Hydra.Sources.Test.Inference.Fundamentals+import Hydra.Sources.Test.Inference.KernelExamples+import Hydra.Sources.Test.Inference.NominalTypes+import Hydra.Sources.Test.Inference.Simple+++inferenceTests :: TTerm TestGroup+inferenceTests = supergroup "Inference tests" [+  algebraicTypesTests,+  algorithmWTests,+  failureTests,+  fundamentalsTests,+  kernelExamplesTests,+  nominalTypesTests,+  simpleTermsTests]
+ src/main/haskell/Hydra/Sources/Test/Inference/KernelExamples.hs view
@@ -0,0 +1,35 @@+module Hydra.Sources.Test.Inference.KernelExamples (kernelExamplesTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Phantoms as Base+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph+import Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T+import Hydra.Sources.Test.Inference.Fundamentals++import qualified Data.Map as M+import Prelude hiding (map, sum)+++kernelExamplesTests :: TTerm TestGroup+kernelExamplesTests = supergroup "Examples from the Hydra kernel" [+  testGroupForNestedLet]++testGroupForNestedLet :: TTerm TestGroup+testGroupForNestedLet = supergroup "Nested let" [+    subgroup "hydra.formatting.mapFirstLetter" [+      expectMono 1 [tag_disabledForMinimalInference]+        (lambda "mapping" $ lambda "s" $ lets [+          "firstLetter">: var "mapping" @@ (primitive _strings_fromList @@ (primitive _lists_pure @@ (primitive _lists_head @@ var "list"))),+          "list">: primitive _strings_toList @@ var "s"] $+          primitive _logic_ifElse+            @@ (primitive _strings_null @@ var "s")+            @@ (var "s")+            @@ (primitive _strings_cat2 @@ var "firstLetter" @@ (primitive _strings_fromList @@ (primitive _lists_tail @@ var "list"))))+        (T.functionMany [T.function T.string T.string, T.string, T.string])]]
+ src/main/haskell/Hydra/Sources/Test/Inference/NominalTypes.hs view
@@ -0,0 +1,175 @@+module Hydra.Sources.Test.Inference.NominalTypes (nominalTypesTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Phantoms as Base+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph+import Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T+import Hydra.Sources.Test.Inference.Fundamentals++import qualified Data.Map as M+import Prelude hiding (map, sum)+++nominalTypesTests :: TTerm TestGroup+nominalTypesTests = supergroup "Nominal terms" [+  testGroupForCaseStatements,+  testGroupForProjections,+  testGroupForRecords,+  testGroupForVariants,+  testGroupForWrappers]++testGroupForCaseStatements :: TTerm TestGroup+testGroupForCaseStatements = subgroup "Case statements" [+    expectMono 1 [tag_disabledForMinimalInference]+      (match (ref testTypeSimpleNumberNameDef) nothing [+        "int">: lambda "x" $ var "x",+        "float">: lambda "x" $ int32 42])+      (T.function (Core.typeVariable $ ref testTypeSimpleNumberNameDef) T.int32),+    expectMono 2 [tag_disabledForMinimalInference]+      (match (ref testTypeUnionMonomorphicNameDef) nothing [+        "bool">: constant true,+        "string">: constant false,+        "unit">: constant false])+      (T.function (Core.typeVariable $ ref testTypeUnionMonomorphicNameDef) T.boolean)]++testGroupForProjections :: TTerm TestGroup+testGroupForProjections = supergroup "Projections" [+    subgroup "Record eliminations" [+      expectMono 1 [tag_disabledForMinimalInference]+        (project (ref testTypePersonNameDef) (name "firstName"))+        (T.function (Core.typeVariable $ ref testTypePersonNameDef) T.string)]]++testGroupForRecords :: TTerm TestGroup+testGroupForRecords = supergroup "Records" [++    subgroup "Simple records" [+      expectMono 1 [tag_disabledForMinimalInference]+        (record (ref testTypeLatLonNameDef) [+          "lat">: float32 37.7749,+          "lon">: float32 $ negate 122.4194])+        (Core.typeVariable (ref testTypeLatLonNameDef)),+      expectMono 2 [tag_disabledForMinimalInference]+        (record (ref testTypeLatLonPolyNameDef) [+          "lat">: float32 37.7749,+          "lon">: float32 $ negate 122.4194])+        (T.apply (Core.typeVariable (ref testTypeLatLonPolyNameDef)) T.float32),+      expectMono 3 [tag_disabledForMinimalInference]+        (lambda "lon" (record (ref testTypeLatLonPolyNameDef) [+          "lat">: float32 37.7749,+          "lon">: var "lon"]))+        (T.function T.float32 (T.apply (Core.typeVariable (ref testTypeLatLonPolyNameDef)) T.float32)),+      expectPoly 4 [tag_disabledForMinimalInference]+        (lambda "latlon" (record (ref testTypeLatLonPolyNameDef) [+          "lat">: var "latlon",+          "lon">: var "latlon"]))+        ["t0"] (T.function (T.var "t0") (T.apply (Core.typeVariable (ref testTypeLatLonPolyNameDef)) (T.var "t0"))),+      expectMono 5 [tag_disabledForMinimalInference]+        (ref testDataArthurDef)+        (Core.typeVariable (ref testTypePersonNameDef))],++    subgroup "Record instances of simply recursive record types" [+      expectMono 1 [tag_disabledForMinimalInference]+        (record (ref testTypeIntListNameDef) [+          "head">: int32 42,+          "tail">: optional $ just (record (ref testTypeIntListNameDef) [+            "head">: int32 43,+            "tail">: optional nothing])])+        (Core.typeVariable (ref testTypeIntListNameDef)),+      expectMono 2 [tag_disabledForMinimalInference]+        ((lambda "x" $ record (ref testTypeIntListNameDef) [+          "head">: var "x",+          "tail">: optional $ just (record (ref testTypeIntListNameDef) [+            "head">: var "x",+            "tail">: optional nothing])]) @@ int32 42)+        (Core.typeVariable (ref testTypeIntListNameDef)),+      expectMono 3 [tag_disabledForMinimalInference]+        (record (ref testTypeListNameDef) [+          "head">: int32 42,+          "tail">: optional $ just (record (ref testTypeListNameDef) [+            "head">: int32 43,+            "tail">: optional nothing])])+        (T.apply (Core.typeVariable (ref testTypeListNameDef)) T.int32),+      expectMono 4 [tag_disabledForMinimalInference]+        ((lambda "x" $ record (ref testTypeListNameDef) [+          "head">: var "x",+          "tail">: optional $ just (record (ref testTypeListNameDef) [+            "head">: var "x",+            "tail">: optional nothing])]) @@ int32 42)+        (T.apply (Core.typeVariable (ref testTypeListNameDef)) T.int32),+      expectPoly 5 [tag_disabledForMinimalInference]+        (lambda "x" $ record (ref testTypeListNameDef) [+          "head">: var "x",+          "tail">: optional $ just (record (ref testTypeListNameDef) [+            "head">: var "x",+            "tail">: optional nothing])])+        ["t0"] (T.function (T.var "t0") (T.apply (Core.typeVariable (ref testTypeListNameDef)) (T.var "t0")))],++    subgroup "Record instances of mutually recursive record types" [+      expectMono 1 [tag_disabledForMinimalInference]+        ((lambda "x" $ record (ref testTypeBuddyListANameDef) [+          "head">: var "x",+          "tail">: optional $ just $ record (ref testTypeBuddyListBNameDef) [+            "head">: var "x",+            "tail">: optional nothing]]) @@ int32 42)+        (T.apply (Core.typeVariable $ ref testTypeBuddyListANameDef) T.int32),+      expectPoly 2 [tag_disabledForMinimalInference]+        (lambda "x" $ record (ref testTypeBuddyListANameDef) [+          "head">: var "x",+          "tail">: optional $ just $ record (ref testTypeBuddyListBNameDef) [+            "head">: var "x",+            "tail">: optional nothing]])+        ["t0"] (T.function (T.var "t0") (T.apply (Core.typeVariable $ ref testTypeBuddyListANameDef) (T.var "t0")))]]++testGroupForVariants :: TTerm TestGroup+testGroupForVariants = supergroup "Variant terms" [++    subgroup "Variants" [+      expectMono 1 [tag_disabledForMinimalInference]+        (inject (ref testTypeTimestampNameDef) "unixTimeMillis" $ uint64 1638200308368)+        (Core.typeVariable (ref testTypeTimestampNameDef)),+      expectMono 2 [tag_disabledForMinimalInference]+        (inject (ref testTypeUnionMonomorphicNameDef) "string" $ string "bar")+        (Core.typeVariable (ref testTypeUnionMonomorphicNameDef))],+--    TODO: inference failure test cases+--      H.it "test #3" $+--        expectFailure+--          (inject testTypeUnionMonomorphicName $ Field (Name "string") $ int32 42)++    subgroup "Polymorphic and recursive variants" [+      expectPoly 1 [tag_disabledForMinimalInference]+        (inject (ref testTypeUnionPolymorphicRecursiveNameDef) "bool" true)+        ["t0"] (T.apply (Core.typeVariable (ref testTypeUnionPolymorphicRecursiveNameDef)) (T.var "t0")),+      expectMono 2 [tag_disabledForMinimalInference]+        (inject (ref testTypeUnionPolymorphicRecursiveNameDef) "value" $ string "foo")+        (T.apply (Core.typeVariable (ref testTypeUnionPolymorphicRecursiveNameDef)) T.string),+      expectMono 3 [tag_disabledForMinimalInference]+        (lets [+          "other">: inject (ref testTypeUnionPolymorphicRecursiveNameDef) "value" $ int32 42]+          $ inject (ref testTypeUnionPolymorphicRecursiveNameDef) "other" $ var "other")+        (T.apply (Core.typeVariable (ref testTypeUnionPolymorphicRecursiveNameDef)) T.int32)]]++testGroupForWrappers :: TTerm TestGroup+testGroupForWrappers = supergroup "Wrapper introductions and eliminations" [++    subgroup "Wrapper introductions" [+      expectMono 1 [tag_disabledForMinimalInference]+        (wrap (ref testTypeStringAliasNameDef) $ string "foo")+        (Core.typeVariable $ ref testTypeStringAliasNameDef),+      expectMono 2 [tag_disabledForMinimalInference]+        (lambda "v" $ wrap (ref testTypeStringAliasNameDef) $ var "v")+        (T.function T.string (Core.typeVariable $ ref testTypeStringAliasNameDef))],++    subgroup "Wrapper eliminations" [+      expectMono 1 [tag_disabledForMinimalInference]+        (unwrap (ref testTypeStringAliasNameDef))+        (T.function (Core.typeVariable $ ref testTypeStringAliasNameDef) T.string),+      expectMono 2 [tag_disabledForMinimalInference]+        (unwrap (ref testTypeStringAliasNameDef) @@ (wrap (ref testTypeStringAliasNameDef) $ string "foo"))+        T.string]]
+ src/main/haskell/Hydra/Sources/Test/Inference/Simple.hs view
@@ -0,0 +1,272 @@+module Hydra.Sources.Test.Inference.Simple (simpleTermsTests) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Phantoms as Base+import qualified Hydra.Dsl.Core as Core+import Hydra.Dsl.Testing as Testing+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Lib.Maps as Maps+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Test.TestGraph+import Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Dsl.TTypes as T+import Hydra.Sources.Test.Inference.Fundamentals++import qualified Data.Map as M+import Prelude hiding (map, sum)+++simpleTermsTests :: TTerm TestGroup+simpleTermsTests = supergroup "Simple terms" [+  testGroupForApplicationTerms,+  testGroupForFunctionTerms,+  testGroupForIndividualTerms,+  testGroupForLetTerms,+  testGroupForListTerms,+  testGroupForPrimitiveTerms,+  testGroupForProductTerms,+  testGroupForSumTerms]++testGroupForApplicationTerms :: TTerm TestGroup+testGroupForApplicationTerms = subgroup "Application terms" [+    expectMono 1 []+      ((lambda "x" $ var "x") @@ string "foo")+      T.string,+    expectMono 2 []+      (lambda "x" $ primitive _math_sub @@ (primitive _math_add @@ var "x" @@ var "x") @@ int32 1)+      (T.function T.int32 T.int32)]++testGroupForFunctionTerms :: TTerm TestGroup+testGroupForFunctionTerms = supergroup "Function terms" [++    subgroup "Lambdas" [+      expectPoly 1 []+        (lambda "x" $ var "x")+        ["t0"] (T.function (T.var "t0") (T.var "t0")),+      expectPoly 2 []+        (lambda "x" $ int16 137)+        ["t0"] (T.function (T.var "t0") T.int16)],++    subgroup "List eliminations" [+      expectMono 1 [tag_disabledForMinimalInference]+        foldAdd+        (T.functionMany [T.int32, T.list T.int32, T.int32]),+      expectMono 2 [tag_disabledForMinimalInference]+        (apply foldAdd $ int32 0)+        (T.function (T.list T.int32) T.int32),+      expectMono 3 [tag_disabledForMinimalInference]+        (apply (apply foldAdd $ int32 0) (list (int32 <$> [1, 2, 3, 4, 5])))+        T.int32],++    subgroup "Optional eliminations" [+      expectMono 1 [tag_disabledForMinimalInference]+        (primitive _optionals_maybe @@ (int32 42) @@ (primitive _math_neg))+        (T.function (T.optional T.int32) T.int32),+      expectMono 2 [tag_disabledForMinimalInference]+        (primitive _optionals_maybe @@ (int32 42) @@ (primitive _math_neg) @@ (optional (just $ int32 137)))+        T.int32,+      expectMono 3 [tag_disabledForMinimalInference]+        (primitive _optionals_maybe @@ (int32 42) @@ (primitive _math_neg) @@ optional nothing)+        T.int32,+      expectPoly 4 [tag_disabledForMinimalInference]+        (lambda "x" $ primitive _optionals_maybe @@ (var "x") @@ (primitive _optionals_pure) @@ var "x")+        ["t0"] (T.function (T.optional $ T.var "t0") (T.optional $ T.var "t0")),+      expectPoly 5 [tag_disabledForMinimalInference]+        (primitive _optionals_maybe @@ (list []) @@ (lambda "x" $ list [var "x"]))+        ["t0"] (T.function (T.optional $ T.var "t0") (T.list $ T.var "t0"))],++   subgroup "Tuple projections" [+     expectPoly 1 [tag_disabledForMinimalInference]+       (untuple 2 0)+       ["t0", "t1"] (T.function (T.product [T.var "t0", T.var "t1"]) (T.var "t0")),+     expectMono 2 [tag_disabledForMinimalInference]+       (untuple 2 1 @@ pair (int32 42) (string "foo"))+       T.string,+     expectPoly 3 [tag_disabledForMinimalInference]+       (lambda "x" $ untuple 1 0 @@ tuple [var "x"])+       ["t0"] (T.function (T.var "t0") (T.var "t0")),+     expectPoly 4 [tag_disabledForMinimalInference]+       (lambda "x" $ untuple 3 2 @@ tuple [var "x", var "x", int32 42])+       ["t0"] (T.function (T.var "t0") T.int32)]]++  where+    foldAdd = primitive _lists_foldl @@ primitive _math_add++testGroupForIndividualTerms :: TTerm TestGroup+testGroupForIndividualTerms = supergroup "Individual terms" [++    subgroup "Literal values" [+      expectMono 1 []+        (int32 42)+        T.int32,+      expectMono 2 []+        (string "foo")+        T.string,+      expectMono 3 []+        false+        T.boolean,+      expectMono 4 []+        (float64 42.0)+        T.float64],++    subgroup "Let terms" [+      expectPoly 1 []+        (lets ["x">: float32 42.0] $ lambdas ["y", "z"] $ var "x")+        ["t0", "t1"] (T.function (T.var "t0") (T.function (T.var "t1") T.float32)),+      -- Example from https://www.cs.cornell.edu/courses/cs6110/2017sp/lectures/lec23.pdf+      expectMono 2 []+        (lets [+            "square">: lambda "z" $ primitive _math_mul @@ var "z" @@ var "z"] $+          lambdas ["f", "x", "y"] $ primitive _logic_ifElse+              @@ (var "f" @@ (var "square" @@ var "x") @@ var "y")+              @@ (var "f" @@ var "x" @@ (var "f" @@ var "x" @@ var "y"))+              @@ (var "f" @@ var "x" @@ var "y"))+        (T.functionMany [+          T.functionMany [T.int32, T.boolean, T.boolean], T.int32, T.boolean, T.boolean])],++    subgroup "Optionals" [+      expectMono 1 [tag_disabledForMinimalInference]+        (optional $ just $ int32 42)+        (T.optional T.int32),+      expectPoly 2 [tag_disabledForMinimalInference]+        (optional nothing)+        ["t0"] (T.optional $ T.var "t0")],++    subgroup "Products" [+      expectMono 1 []+        (tuple [])+        (T.product []),+      expectMono 2 []+        (pair (int32 42) (string "foo"))+        (T.product [T.int32, T.string])],++    subgroup "Sets" [+      expectMono 1 [tag_disabledForMinimalInference]+        (set [true])+        (T.set T.boolean),+      expectPoly 2 [tag_disabledForMinimalInference]+        (set [set []])+        ["t0"] (T.set $ T.set $ T.var "t0")],++    subgroup "Maps" [+      expectMono 1 [tag_disabledForMinimalInference]+        (mapTermCheat [+          (Terms.string "firstName", Terms.string "Arthur"),+          (Terms.string "lastName", Terms.string "Dent")])+        (T.map T.string T.string),+      expectPoly 2 [tag_disabledForMinimalInference]+        (TTerms.map Maps.empty)+        ["t0", "t1"] (T.map (T.var "t0") (T.var "t1")),+      expectPoly 3 [tag_disabledForMinimalInference]+        (lambdas ["x", "y"] $ mapTermCheat+          [(Terms.var "x", Terms.float64 0.1), (Terms.var "y", Terms.float64 0.2)])+        ["t0"] (T.function (T.var "t0") (T.function (T.var "t0") (T.map (T.var "t0") T.float64)))]]++--     -- TODO: add a case for a recursive nominal type -- e.g. MyList := () + (int, Mylist)+--     subgroup "Nominal (newtype) terms" [+--       expectMono []+--         testDataArthur+--         (T.wrap "Person")+--       expectMono []+--         (lambda "x" (record [+--           Field "firstName" $ var "x",+--           Field "lastName" $ var "x",+--           Field "age" $ int32 42]))+--         (T.function T.string testTypePerson)++testGroupForLetTerms :: TTerm TestGroup+testGroupForLetTerms = supergroup "Let terms" [++    subgroup "Empty let" [+      expectMono 1 []+        (lets [] $ int32 42)+        T.int32],++    subgroup "Trivial let" [+      expectMono 2 []+        (lets [+            "foo">: int32 42]+          $ var "foo")+        T.int32]]++testGroupForListTerms :: TTerm TestGroup+testGroupForListTerms = supergroup "List terms" [++    subgroup "List of strings" [+      expectMono 1 []+        (list [string "foo", string "bar"])+        (T.list T.string)],+    subgroup "List of lists of strings" [+      expectMono 1 []+        (list [list [string "foo"], list []])+        (T.list $ T.list T.string)],+    subgroup "Empty list" [+      expectPoly 1 []+        (list [])+        ["t0"] (T.list $ T.var "t0")],+    subgroup "List containing an empty list" [+      expectPoly 1 []+        (list [list []])+        ["t0"] (T.list $ T.list $ T.var "t0")],+    subgroup "Lambda producing a list of integers" [+      expectMono 1 []+        (lambda "x" (list [var "x", int32 42]))+        (T.function T.int32 $ T.list T.int32)],+    subgroup "List with bound variables" [+      expectMono 1 []+        (lambda "x" (list [var "x", string "foo", var "x"]))+        (T.function T.string (T.list T.string))]]++testGroupForPrimitiveTerms :: TTerm TestGroup+testGroupForPrimitiveTerms = supergroup "Primitive terms" [++    subgroup "Monomorphic primitive functions" [+      expectMono 1 []+        (primitive $ Name "hydra.lib.strings.length")+        (T.function T.string T.int32),+      expectMono 2 []+        (primitive _math_sub)+        (T.function T.int32 (T.function T.int32 T.int32))],+    subgroup "Polymorphic primitive functions" [+      expectPoly 1 []+        (lambda "els" (apply (primitive _lists_length) (apply (primitive _lists_concat) $ var "els")))+        ["t0"] (T.function (T.list $ T.list $ T.var "t0") T.int32)]]++testGroupForProductTerms :: TTerm TestGroup+testGroupForProductTerms = supergroup "Product terms" [++    subgroup "Empty product" [+      expectMono 1 []+        (tuple [])+        (T.product [])],+    subgroup "Non-empty monotyped products" [+      expectMono 1 []+        (tuple [string "foo", int32 42])+        (T.product [T.string, T.int32]),+      expectMono 2 []+        (tuple [string "foo", list [float32 42.0, float32 137.0]])+        (T.product [T.string, T.list T.float32])],+    subgroup "Polytyped products" [+      expectPoly 1 []+        (tuple [list [], string "foo"])+        ["t0"] (T.product [T.list $ T.var "t0", T.string])]]++testGroupForSumTerms :: TTerm TestGroup+testGroupForSumTerms = supergroup "Sum terms" [++    subgroup "Singleton sum terms" [+      expectMono 1 [tag_disabledForMinimalInference]+        (sum 0 1 $ string "foo")+        (T.sum [T.string]),+      expectPoly 2 [tag_disabledForMinimalInference]+        (sum 0 1 $ list [])+        ["t0"] (T.sum [T.list $ T.var "t0"])],+    subgroup "Non-singleton sum terms" [+      expectPoly 1 [tag_disabledForMinimalInference]+        (sum 0 2 $ string "foo")+        ["t0"] (T.sum [T.string, T.var "t0"]),+      expectPoly 2 [tag_disabledForMinimalInference]+        (sum 1 2 $ string "foo")+        ["t0"] (T.sum [T.var "t0", T.string])]]
+ src/main/haskell/Hydra/Sources/Test/Lib/Lists.hs view
@@ -0,0 +1,409 @@+module Hydra.Sources.Test.Lib.Lists (listPrimitiveTests) where++import Hydra.Dsl.Tests+import Hydra.Dsl.Terms+++listPrimitiveTests :: TestGroup+listPrimitiveTests = TestGroup "hydra.lib.lists primitives" Nothing groups []+  where+    groups = [+      listsApply,+      listsAt,+      listsBind,+      listsConcat,+      listsConcat2,+      listsCons,+      listsDrop,+--      listsDropWhile, -- TODO+      listsElem,+--      listsFilter, -- TODO+--      listsFoldl, -- TODO+      listsGroup,+      listsHead,+      listsInit,+      listsIntercalate,+      listsIntersperse,+      listsLast,+      listsLength,+      listsMap,+      listsNub,+      listsNull,+      listsPure,+      listsReplicate,+      listsReverse,+      listsSafeHead,+      listsSingleton,+      listsSort,+--      listsSortOn, -- TODO+--      listsSpan, -- TODO+      listsTail,+      listsTake,+      listsTranspose,+      listsZip]+--      listsZipWith] -- TODO++listsApply :: TestGroup+listsApply = TestGroup "apply" Nothing [] [+    testStr "string transformations" [primitive _strings_toUpper, primitive _strings_toLower] ["One", "Two", "Three"] ["ONE", "TWO", "THREE", "one", "two", "three"],+    testStr "empty function list" [] ["a", "b"] [],+    testStr "empty input list" [primitive _strings_toUpper] [] [],+    testStr "single function" [primitive _strings_toUpper] ["hello"] ["HELLO"],+    testStr "single input" [primitive _strings_toUpper, primitive _strings_toLower] ["Test"] ["TEST", "test"]]+  where+    testStr name funs lst result = primCase name _lists_apply [list funs, stringList lst] (stringList result)++listsAt :: TestGroup+listsAt = TestGroup "at" Nothing [] [+    testInt "first element" 0 [1, 2, 3] 1,+    testInt "middle element" 1 [1, 2, 3] 2,+    testInt "last element" 2 [1, 2, 3] 3,+    testInt "single element list" 0 [42] 42,+    testStr "string list access" 1 ["hello", "world"] "world"]+  where+    testInt name idx lst result = primCase name _lists_at [int32 idx, intList lst] (int32 result)+    testStr name idx lst result = primCase name _lists_at [int32 idx, stringList lst] (string result)++listsBind :: TestGroup+listsBind = TestGroup "bind" Nothing [] [+    test "negation function" [1, 2, 3, 4] (primitive _lists_pure <.> primitive _math_neg) (negate <$> [1, 2, 3, 4]),+    test "empty list" [] (primitive _lists_pure <.> primitive _math_neg) [],+    test "single element" [5] (primitive _lists_pure <.> primitive _math_neg) [-5],+    test "duplicate elements" [1, 1, 2] (primitive _lists_pure <.> primitive _math_neg) [-1, -1, -2]]+  where+    test name lst fun result = primCase name _lists_bind [intList lst, fun] (intList result)++listsConcat :: TestGroup+listsConcat = TestGroup "concat" Nothing [] [+    test "multiple non-empty lists" [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 4, 5, 6, 7, 8],+    test "empty lists included" [[], [1, 2], [], [3]] [1, 2, 3],+    test "single list" [[1, 2, 3]] [1, 2, 3],+    test "all empty lists" [[], [], []] [],+    test "empty list of lists" [] []]+  where+    test name lists result = primCase name _lists_concat [intListList lists] (intList result)++listsConcat2 :: TestGroup+listsConcat2 = TestGroup "concat2" Nothing [] [+    testInt "two non-empty lists" [1, 2] [3, 4] [1, 2, 3, 4],+    testInt "first list empty" [] [1, 2] [1, 2],+    testInt "second list empty" [1, 2] [] [1, 2],+    testInt "both lists empty" [] [] [],+    testInt "single elements" [1] [2] [1, 2],+    testStr "string lists" ["a", "b"] ["c", "d"] ["a", "b", "c", "d"]]+  where+    testInt name lst1 lst2 result = primCase name _lists_concat2 [intList lst1, intList lst2] (intList result)+    testStr name lst1 lst2 result = primCase name _lists_concat2 [stringList lst1, stringList lst2] (stringList result)++listsCons :: TestGroup+listsCons = TestGroup "cons" Nothing [] [+    testInt "cons to non-empty list" 1 [2, 3] [1, 2, 3],+    testInt "cons to empty list" 1 [] [1],+    testInt "cons negative number" (-1) [2, 3] [-1, 2, 3],+    testStr "cons string" "hello" ["world"] ["hello", "world"]]+  where+    testInt name x lst result = primCase name _lists_cons [int32 x, intList lst] (intList result)+    testStr name x lst result = primCase name _lists_cons [string x, stringList lst] (stringList result)++listsDrop :: TestGroup+listsDrop = TestGroup "drop" Nothing [] [+    test "drop from beginning" 2 [1, 2, 3, 4, 5] [3, 4, 5],+    test "drop zero elements" 0 [1, 2, 3] [1, 2, 3],+    test "drop all elements" 3 [1, 2, 3] [],+    test "drop more than length" 5 [1, 2] [],+    test "drop from empty list" 3 [] [],+    test "drop negative amount" (-1) [1, 2, 3] [1, 2, 3]]+  where+    test name n lst result = primCase name _lists_drop [int32 n, intList lst] (intList result)++listsDropWhile :: TestGroup+listsDropWhile = TestGroup "dropWhile" Nothing [] [+    test "drop while less than 3" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 3)) [1, 2, 3, 2, 1] [3, 2, 1],+    test "drop all elements" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 10)) [1, 2, 3] [],+    test "drop no elements" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 0)) [1, 2, 3] [1, 2, 3],+    test "empty list" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 5)) [] []]+  where+    test name pred lst result = primCase name _lists_dropWhile [pred, intList lst] (intList result)++listsElem :: TestGroup+listsElem = TestGroup "elem" Nothing [] [+    testInt "element present" 2 [1, 2, 3] True,+    testInt "element not present" 4 [1, 2, 3] False,+    testInt "empty list" 1 [] False,+    testInt "single element present" 1 [1] True,+    testInt "single element not present" 2 [1] False,+    testInt "duplicate elements" 2 [1, 2, 2, 3] True,+    testStr "string element present" "hello" ["world", "hello", "test"] True,+    testStr "string element not present" "missing" ["world", "hello"] False]+  where+    testInt name x lst result = primCase name _lists_elem [int32 x, intList lst] (boolean result)+    testStr name x lst result = primCase name _lists_elem [string x, stringList lst] (boolean result)++listsFilter :: TestGroup+listsFilter = TestGroup "filter" Nothing [] [+    test "filter positive numbers" (lambda "x" (primitive _equality_gt <.> var "x" <.> int32 0)) [-1, 2, -3, 4, 5] [2, 4, 5],+    test "filter all elements" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 10)) [1, 2, 3] [1, 2, 3],+    test "filter no elements" (lambda "x" (primitive _equality_gt <.> var "x" <.> int32 10)) [1, 2, 3] [],+    test "empty list" (lambda "x" (primitive _equality_gt <.> var "x" <.> int32 0)) [] []]+  where+    test name pred lst result = primCase name _lists_filter [pred, intList lst] (intList result)++listsFoldl :: TestGroup+listsFoldl = TestGroup "foldl" Nothing [] [+    test "sum with addition" (primitive _math_add) 0 [1, 2, 3, 4] 10,+    test "product with multiplication" (primitive _math_mul) 1 [2, 3, 4] 24,+    test "empty list" (primitive _math_add) 5 [] 5,+    test "single element" (primitive _math_add) 10 [5] 15,+    test "subtraction fold" (primitive _math_sub) 10 [1, 2, 3] 4]+  where+    test name op acc lst result = primCase name _lists_foldl [op, int32 acc, intList lst] (int32 result)++listsGroup :: TestGroup+listsGroup = TestGroup "group" Nothing [] [+    test "consecutive duplicates" [1, 1, 2, 2, 2, 3, 1] [[1, 1], [2, 2, 2], [3], [1]],+    test "no duplicates" [1, 2, 3] [[1], [2], [3]],+    test "all same" [1, 1, 1] [[1, 1, 1]],+    test "empty list" [] [],+    test "single element" [1] [[1]]]+  where+    test name lst result = primCase name _lists_group [intList lst] (intListList result)++listsHead :: TestGroup+listsHead = TestGroup "head" Nothing [] [+    testInt "three element list" [1, 2, 3] 1,+    testInt "single element list" [42] 42,+    testInt "negative numbers" [-1, -2, -3] (-1),+    testStr "string list" ["hello", "world"] "hello"]+  where+    testInt name lst result = primCase name _lists_head [intList lst] (int32 result)+    testStr name lst result = primCase name _lists_head [stringList lst] (string result)++listsInit :: TestGroup+listsInit = TestGroup "init" Nothing [] [+    testInt "multiple elements" [1, 2, 3, 4] [1, 2, 3],+    testInt "two elements" [1, 2] [1],+    testInt "single element" [1] [],+    testStr "string list" ["a", "b", "c"] ["a", "b"]]+  where+    testInt name lst result = primCase name _lists_init [intList lst] (intList result)+    testStr name lst result = primCase name _lists_init [stringList lst] (stringList result)++listsIntercalate :: TestGroup+listsIntercalate = TestGroup "intercalate" Nothing [] [+    test "double zero separator" [0, 0] [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 0, 0, 4, 5, 0, 0, 6, 7, 8],+    test "empty separator" [] [[1, 2], [3, 4]] [1, 2, 3, 4],+    test "single element separator" [99] [[1], [2], [3]] [1, 99, 2, 99, 3],+    test "empty list of lists" [0] [] [],+    test "single list" [0] [[1, 2, 3]] [1, 2, 3],+    test "lists with empty lists" [0] [[], [1], []] [0, 1, 0]]+  where+    test name ifx lists result = primCase name _lists_intercalate [intList ifx, intListList lists] (intList result)++listsIntersperse :: TestGroup+listsIntersperse = TestGroup "intersperse" Nothing [] [+    testStr "string interspersion" "and" ["one", "two", "three"] ["one", "and", "two", "and", "three"],+    testStr "single element" "x" ["only"] ["only"],+    testStr "empty list" "x" [] [],+    testStr "two elements" "+" ["a", "b"] ["a", "+", "b"],+    testInt "number interspersion" 0 [1, 2, 3] [1, 0, 2, 0, 3]]+  where+    testStr name ifx lst result = primCase name _lists_intersperse [string ifx, stringList lst] (stringList result)+    testInt name ifx lst result = primCase name _lists_intersperse [int32 ifx, intList lst] (intList result)++listsLast :: TestGroup+listsLast = TestGroup "last" Nothing [] [+    testInt "three element list" [1, 2, 3] 3,+    testInt "single element list" [42] 42,+    testInt "negative numbers" [-1, -2, -3] (-3),+    testStr "string list" ["hello", "world"] "world"]+  where+    testInt name lst result = primCase name _lists_last [intList lst] (int32 result)+    testStr name lst result = primCase name _lists_last [stringList lst] (string result)++listsLength :: TestGroup+listsLength = TestGroup "length" Nothing [] [+    testInt "three elements" [1, 2, 3] 3,+    testInt "empty list" [] 0,+    testInt "single element" [42] 1,+    testInt "many elements" [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] 10,+    testStr "string list" ["a", "b", "c"] 3]+  where+    testInt name lst result = primCase name _lists_length [intList lst] (int32 result)+    testStr name lst result = primCase name _lists_length [stringList lst] (int32 result)++listsMap :: TestGroup+listsMap = TestGroup "map" Nothing [] [+    testStr "string to uppercase" (primitive _strings_toUpper) ["one", "two"] ["ONE", "TWO"],+    testStr "empty list" (primitive _strings_toUpper) [] [],+    testStr "single element" (primitive _strings_toUpper) ["hello"] ["HELLO"],+    testInt "number negation" (primitive _math_neg) [1, 2, 3] [-1, -2, -3],+    testInt "identity function" (primitive _equality_identity) [1, 2, 3] [1, 2, 3]]+  where+    testStr name fun lst result = primCase name _lists_map [fun, stringList lst] (stringList result)+    testInt name fun lst result = primCase name _lists_map [fun, intList lst] (intList result)++listsNub :: TestGroup+listsNub = TestGroup "nub" Nothing [] [+    testInt "remove duplicates" [1, 2, 1, 3, 2, 4] [1, 2, 3, 4],+    testInt "no duplicates" [1, 2, 3] [1, 2, 3],+    testInt "all duplicates" [1, 1, 1] [1],+    testInt "empty list" [] [],+    testInt "single element" [1] [1],+    testStr "string duplicates" ["a", "b", "a", "c"] ["a", "b", "c"]]+  where+    testInt name lst result = primCase name _lists_nub [intList lst] (intList result)+    testStr name lst result = primCase name _lists_nub [stringList lst] (stringList result)++listsNull :: TestGroup+listsNull = TestGroup "null" Nothing [] [+    testInt "empty int list" [] True,+    testInt "single element" [1] False,+    testInt "multiple elements" [1, 2, 3] False,+    testStr "empty string list" [] True,+    testStr "non-empty string list" ["a"] False]+  where+    testInt name lst result = primCase name _lists_null [intList lst] (boolean result)+    testStr name lst result = primCase name _lists_null [stringList lst] (boolean result)++listsPure :: TestGroup+listsPure = TestGroup "pure" Nothing [] [+    testStr "string element" "one" ["one"],+    testStr "empty string" "" [""],+    testInt "number element" 42 [42],+    testInt "negative number" (-5) [-5]]+  where+    testStr name arg result = primCase name _lists_pure [string arg] (stringList result)+    testInt name arg result = primCase name _lists_pure [int32 arg] (intList result)++listsReplicate :: TestGroup+listsReplicate = TestGroup "replicate" Nothing [] [+    testInt "replicate three times" 3 42 [42, 42, 42],+    testInt "replicate zero times" 0 1 [],+    testInt "replicate once" 1 99 [99],+    testStr "replicate string" 2 "hello" ["hello", "hello"]]+  where+    testInt name n x result = primCase name _lists_replicate [int32 n, int32 x] (intList result)+    testStr name n x result = primCase name _lists_replicate [int32 n, string x] (stringList result)++listsReverse :: TestGroup+listsReverse = TestGroup "reverse" Nothing [] [+    testInt "multiple elements" [1, 2, 3, 4] [4, 3, 2, 1],+    testInt "single element" [1] [1],+    testInt "empty list" [] [],+    testInt "two elements" [1, 2] [2, 1],+    testStr "string list" ["a", "b", "c"] ["c", "b", "a"]]+  where+    testInt name lst result = primCase name _lists_reverse [intList lst] (intList result)+    testStr name lst result = primCase name _lists_reverse [stringList lst] (stringList result)++listsSafeHead :: TestGroup+listsSafeHead = TestGroup "safeHead" Nothing [] [+    testInt "non-empty int list" [1, 2, 3] (Just 1),+    testInt "empty int list" [] Nothing,+    testInt "single element" [42] (Just 42),+    testStr "non-empty string list" ["hello", "world"] (Just "hello"),+    testStr "empty string list" [] Nothing]+  where+    testInt name lst result = primCase name _lists_safeHead [intList lst] (optionalInt32 result)+    testStr name lst result = primCase name _lists_safeHead [stringList lst] (optionalString result)+    optionalInt32 Nothing = optional Nothing+    optionalInt32 (Just x) = optional (Just (int32 x))+    optionalString Nothing = optional Nothing+    optionalString (Just x) = optional (Just (string x))++listsSingleton :: TestGroup+listsSingleton = TestGroup "singleton" Nothing [] [+    testInt "number element" 42 [42],+    testInt "negative number" (-1) [-1],+    testInt "zero" 0 [0],+    testStr "string element" "hello" ["hello"]]+  where+    testInt name x result = primCase name _lists_singleton [int32 x] (intList result)+    testStr name x result = primCase name _lists_singleton [string x] (stringList result)++listsSort :: TestGroup+listsSort = TestGroup "sort" Nothing [] [+    testInt "unsorted numbers" [3, 1, 4, 1, 5] [1, 1, 3, 4, 5],+    testInt "already sorted" [1, 2, 3] [1, 2, 3],+    testInt "reverse sorted" [3, 2, 1] [1, 2, 3],+    testInt "single element" [1] [1],+    testInt "empty list" [] [],+    testInt "duplicates" [2, 1, 2, 3, 1] [1, 1, 2, 2, 3],+    testStr "string sort" ["zebra", "apple", "banana"] ["apple", "banana", "zebra"]]+  where+    testInt name lst result = primCase name _lists_sort [intList lst] (intList result)+    testStr name lst result = primCase name _lists_sort [stringList lst] (stringList result)++listsSortOn :: TestGroup+listsSortOn = TestGroup "sortOn" Nothing [] [+   testStr "sort by string length" (primitive _strings_length) ["hello", "hi", "world"] ["hi", "hello", "world"],+   testStr "empty string list" (primitive _strings_length) [] [],+   testStr "single string element" (primitive _strings_length) ["test"] ["test"],+   testInt "sort by negation" (primitive _math_neg) [1, 3, 2] [3, 2, 1],+   testInt "sort by absolute value" (primitive _math_neg) [-1, -3, 2] [-1, 2, -3]]+ where+   testStr name keyFn lst result = primCase name _lists_sortOn [keyFn, stringList lst] (stringList result)+   testInt name keyFn lst result = primCase name _lists_sortOn [keyFn, intList lst] (intList result)++listsSpan :: TestGroup+listsSpan = TestGroup "span" Nothing [] [+    test "span less than 3" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 3)) [1, 2, 3, 1, 2] ([1, 2], [3, 1, 2]),+    test "span all elements" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 10)) [1, 2, 3] ([1, 2, 3], []),+    test "span no elements" (lambda "x" (primitive _equality_gt <.> var "x" <.> int32 10)) [1, 2, 3] ([], [1, 2, 3]),+    test "empty list" (lambda "x" (primitive _equality_lt <.> var "x" <.> int32 5)) [] ([], [])]+  where+    test name pred lst (prefix, suffix) = primCase name _lists_span [pred, intList lst] (pair (intList prefix) (intList suffix))++listsTail :: TestGroup+listsTail = TestGroup "tail" Nothing [] [+    testInt "multiple elements" [1, 2, 3, 4] [2, 3, 4],+    testInt "two elements" [1, 2] [2],+    testInt "single element" [1] [],+    testStr "string list" ["a", "b", "c"] ["b", "c"]]+  where+    testInt name lst result = primCase name _lists_tail [intList lst] (intList result)+    testStr name lst result = primCase name _lists_tail [stringList lst] (stringList result)++listsTake :: TestGroup+listsTake = TestGroup "take" Nothing [] [+    test "take from beginning" 2 [1, 2, 3, 4, 5] [1, 2],+    test "take zero elements" 0 [1, 2, 3] [],+    test "take all elements" 3 [1, 2, 3] [1, 2, 3],+    test "take more than length" 5 [1, 2] [1, 2],+    test "take from empty list" 3 [] [],+    test "take negative amount" (-1) [1, 2, 3] []]+  where+    test name n lst result = primCase name _lists_take [int32 n, intList lst] (intList result)++listsTranspose :: TestGroup+listsTranspose = TestGroup "transpose" Nothing [] [+    test "square matrix" [[1, 2, 3], [4, 5, 6]] [[1, 4], [2, 5], [3, 6]],+    test "empty lists" [] [],+    test "single row" [[1, 2, 3]] [[1], [2], [3]],+    test "single column" [[1], [2], [3]] [[1, 2, 3]],+    test "ragged matrix" [[1, 2], [3], [4, 5, 6]] [[1, 3, 4], [2, 5], [6]]]+  where+    test name matrix result = primCase name _lists_transpose [intListList matrix] (intListList result)++listsZip :: TestGroup+listsZip = TestGroup "zip" Nothing [] [+    test "equal length lists" [1, 2, 3] ["a", "b", "c"] [(1, "a"), (2, "b"), (3, "c")],+    test "first list shorter" [1, 2] ["a", "b", "c"] [(1, "a"), (2, "b")],+    test "second list shorter" [1, 2, 3] ["a", "b"] [(1, "a"), (2, "b")],+    test "empty first list" [] ["a", "b"] [],+    test "empty second list" [1, 2] [] [],+    test "both empty lists" [] [] []]+  where+    test name lst1 lst2 result = primCase name _lists_zip [intList lst1, stringList lst2] (list ((\(x, y) -> pair (int32 x) (string y)) <$> result))++listsZipWith :: TestGroup+listsZipWith = TestGroup "zipWith" Nothing [] [+    testInt "addition" (primitive _math_add) [1, 2, 3] [4, 5, 6] [5, 7, 9],+    testInt "first list shorter" (primitive _math_add) [1, 2] [4, 5, 6] [5, 7],+    testInt "second list shorter" (primitive _math_add) [1, 2, 3] [4, 5] [5, 7],+    testInt "empty first list" (primitive _math_add) [] [1, 2, 3] [],+    testInt "empty second list" (primitive _math_add) [1, 2, 3] [] [],+    testStr "string concatenation" (primitive _strings_cat2) ["a", "b"] ["1", "2"] ["a1", "b1"]]+  where+    testInt name op lst1 lst2 result = primCase name _lists_zipWith [op, intList lst1, intList lst2] (intList result)+    testStr name op lst1 lst2 result = primCase name _lists_zipWith [op, stringList lst1, stringList lst2] (stringList result)
+ src/main/haskell/Hydra/Sources/Test/Lib/Strings.hs view
@@ -0,0 +1,206 @@+module Hydra.Sources.Test.Lib.Strings (stringPrimitiveTests) where++import Hydra.Dsl.Tests+++stringPrimitiveTests :: TestGroup+stringPrimitiveTests = TestGroup "hydra.lib.strings primitives" Nothing groups []+  where+    groups = [+      stringsCat,+      stringsCat2,+      stringsCharAt,+      stringsFromList,+      stringsIntercalate,+      stringsLength,+      stringsLines,+      stringsNull,+      stringsSplitOn,+      stringsToList,+      stringsToLower,+      stringsToUpper,+      stringsUnlines]++stringsCat :: TestGroup+stringsCat = TestGroup "cat" Nothing [] [+    test "basic concatenation" ["one", "two", "three"] "onetwothree",+    test "with empty strings" ["", "one", "", ""] "one",+    test "empty list" [] "",+    test "single string" ["hello"] "hello",+    test "many empty strings" ["", "", "", ""] "",+    test "unicode strings" ["ñ", "世", "🌍"] "ñ世🌍",+    test "special characters" ["\n", "\t", "\r"] "\n\t\r",+    test "numbers as strings" ["1", "2", "3"] "123",+    test "spaces" [" ", " ", " "] "   ",+    test "mixed content" ["Hello", " ", "World", "!"] "Hello World!"]+  where+    test name ls result = primCase name _strings_cat [list (string <$> ls)] (string result)++stringsCat2 :: TestGroup+stringsCat2 = TestGroup "cat2" Nothing [] [+    test "basic concatenation" "hello" "world" "helloworld",+    test "empty first string" "" "world" "world",+    test "empty second string" "hello" "" "hello",+    test "both empty strings" "" "" "",+    test "with spaces" "hello " "world" "hello world",+    test "unicode characters" "ñ" "世" "ñ世",+    test "numeric strings" "123" "456" "123456",+    test "special characters" "\n" "\t" "\n\t"]+  where+    test name s1 s2 result = primCase name _strings_cat2 [string s1, string s2] (string result)++stringsCharAt :: TestGroup+stringsCharAt = TestGroup "charAt" Nothing [] [+    test "first character" 0 "hello" 104,  -- 'h'+    test "middle character" 2 "hello" 108, -- 'l'+    test "last character" 4 "hello" 111,   -- 'o'+    test "single character string" 0 "a" 97,      -- 'a'+    test "unicode character" 0 "ñ" 241,    -- 'ñ'+    test "space character" 0 " " 32,       -- space+    test "newline character" 0 "\n" 10,    -- newline+    test "tab character" 0 "\t" 9]         -- tab+  where+    test name idx s result = primCase name _strings_charAt [int32 idx, string s] (int32 result)++stringsFromList :: TestGroup+stringsFromList = TestGroup "fromList" Nothing [] [+    test "basic ascii string" [104, 101, 108, 108, 111] "hello",+    test "empty code point list" [] "",+    test "single character" [97] "a",+    test "with spaces" [104, 32, 105] "h i",+    test "unicode characters" [241, 19990, 127757] "ñ世🌍",+    test "numeric characters" [49, 50, 51] "123",+    test "special characters" [10, 9, 13] "\n\t\r"]+  where+    test name codePoints result = primCase name _strings_fromList [list (int32 <$> codePoints)] (string result)++stringsIntercalate :: TestGroup+stringsIntercalate = TestGroup "intercalate" Nothing [] [+    test "comma separator" "," ["one", "two", "three"] "one,two,three",+    test "space separator" " " ["hello", "world"] "hello world",+    test "empty separator" "" ["a", "b", "c"] "abc",+    test "multi-character separator" " | " ["A", "B", "C"] "A | B | C",+    test "empty string list" "," [] "",+    test "single item list" "," ["only"] "only",+    test "empty strings in list" "," ["", "a", ""] ",a,",+    test "unicode separator" "🔗" ["link1", "link2"] "link1🔗link2"]+  where+    test name sep strs result = primCase name _strings_intercalate [string sep, list (string <$> strs)] (string result)++stringsLength :: TestGroup+stringsLength = TestGroup "length" Nothing [] [+    test "empty string" "" 0,+    test "single character" "a" 1,+    test "basic word" "one" 3,+    test "string with spaces" "hello world" 11,+    test "unicode characters" "ñ世🌍" 3,+    test "special characters" "\n\t\r" 3,+    test "numeric string" "12345" 5,+    test "long string" "this is a longer string for testing" 35]+  where+    test name s result = primCase name _strings_length [string s] (int32 result)++stringsLines :: TestGroup+stringsLines = TestGroup "lines" Nothing [] [+    test "single line" "hello world" ["hello world"],+    test "two lines" "hello\nworld" ["hello", "world"],+    test "three lines" "one\ntwo\nthree" ["one", "two", "three"],+    test "empty string" "" [],+    test "just newline" "\n" [""],+    test "trailing newline" "hello\n" ["hello"],+    test "leading newline" "\nhello" ["", "hello"],+    test "multiple consecutive newlines" "a\n\nb" ["a", "", "b"]]+  where+    test name s result = primCase name _strings_lines [string s] (list (string <$> result))++stringsNull :: TestGroup+stringsNull = TestGroup "null" Nothing [] [+    test "empty string" "" True,+    test "single character" "a" False,+    test "space only" " " False,+    test "basic word" "hello" False,+    test "newline only" "\n" False,+    test "tab only" "\t" False]+  where+    test name s result = primCase name _strings_null [string s] (boolean result)++stringsSplitOn :: TestGroup+stringsSplitOn = TestGroup "splitOn" Nothing [] [+    test "double s in Mississippi" "ss" "Mississippi" ["Mi", "i", "ippi"],+    test "whole string as separator" "Mississippi" "Mississippi" ["", ""],+    test "space separated words" " " "one two three" ["one", "two", "three"],+    test "leading and trailing spaces" " " " one two three " ["", "one", "two", "three", ""],+    test "multiple consecutive spaces" " " "  one two three" ["", "", "one", "two", "three"],+    test "double space separator" "  " "  one two three" ["", "one two three"],+    test "overlapping pattern aa in aaa" "aa" "aaa" ["", "a"],+    test "separator on empty string" "a" "" [""],+    test "empty separator on abc" "" "abc" ["", "a", "b", "c"],+    test "both separator and string empty" "" "" [""],+    test "separator not found" "x" "hello" ["hello"],+    test "separator at start" "h" "hello" ["", "ello"],+    test "separator at end" "o" "hello" ["hell", ""],+    test "multiple same separators" "l" "hello" ["he", "", "o"],+    test "single character string and separator" "a" "a" ["", ""],+    test "unicode separator" "世" "hello世world世!" ["hello", "world", "!"],+    test "multi-character separator" "ab" "cabbage" ["c", "bage"],+    test "newline separator" "\n" "line1\nline2\nline3" ["line1", "line2", "line3"]]+  where+    test name s0 s1 result = primCase name _strings_splitOn [string s0, string s1] (list (string <$> result))++stringsToList :: TestGroup+stringsToList = TestGroup "toList" Nothing [] [+    test "empty string" "" [],+    test "single character" "a" [97],+    test "basic word" "hello" [104, 101, 108, 108, 111],+    test "with space" "h i" [104, 32, 105],+    test "unicode characters" "ñ世🌍" [241, 19990, 127757],+    test "numeric string" "123" [49, 50, 51],+    test "special characters" "\n\t\r" [10, 9, 13]]+  where+    test name s result = primCase name _strings_toList [string s] (list (int32 <$> result))++stringsToLower :: TestGroup+stringsToLower = TestGroup "toLower" Nothing [] [+    test "mixed case sentence" "One TWO threE" "one two three",+    test "alphanumeric mixed case" "Abc123" "abc123",+    test "all uppercase" "HELLO" "hello",+    test "all lowercase" "hello" "hello",+    test "empty string" "" "",+    test "single uppercase char" "A" "a",+    test "single lowercase char" "a" "a",+    test "with spaces" "Hello World" "hello world",+    test "with punctuation" "Hello, World!" "hello, world!",+    test "unicode accented chars" "ÑÁÉÍÓÚ" "ñáéíóú",+    test "numbers only" "12345" "12345",+    test "special characters only" "\n\t\r" "\n\t\r"]+  where+    test name s result = primCase name _strings_toLower [string s] (string result)++stringsToUpper :: TestGroup+stringsToUpper = TestGroup "toUpper" Nothing [] [+    test "mixed case sentence" "One TWO threE" "ONE TWO THREE",+    test "alphanumeric mixed case" "Abc123" "ABC123",+    test "all lowercase" "hello" "HELLO",+    test "all uppercase" "HELLO" "HELLO",+    test "empty string" "" "",+    test "single lowercase char" "a" "A",+    test "single uppercase char" "A" "A",+    test "with spaces" "hello world" "HELLO WORLD",+    test "with punctuation" "hello, world!" "HELLO, WORLD!",+    test "unicode accented chars" "ñáéíóú" "ÑÁÉÍÓÚ",+    test "numbers only" "12345" "12345",+    test "special characters only" "\n\t\r" "\n\t\r"]+  where+    test name s result = primCase name _strings_toUpper [string s] (string result)++stringsUnlines :: TestGroup+stringsUnlines = TestGroup "unlines" Nothing [] [+    test "basic two lines" ["hello", "world"] "hello\nworld\n",+    test "single line" ["hello"] "hello\n",+    test "empty list" [] "",+    test "three lines" ["one", "two", "three"] "one\ntwo\nthree\n",+    test "with empty lines" ["hello", "", "world"] "hello\n\nworld\n",+    test "all empty lines" ["", "", ""] "\n\n\n",+    test "unicode content" ["ñoño", "世界"] "ñoño\n世界\n"]+  where+    test name strs result = primCase name _strings_unlines [list (string <$> strs)] (string result)
+ src/main/haskell/Hydra/Sources/Test/TestGraph.hs view
@@ -0,0 +1,340 @@+module Hydra.Sources.Test.TestGraph where++import Hydra.Kernel+import qualified Hydra.Dsl.Core          as Core+import qualified Hydra.Dsl.Graph         as Graph+import qualified Hydra.Dsl.Module        as Module+import qualified Hydra.Dsl.Lib.Chars     as Chars+import qualified Hydra.Dsl.Lib.Equality  as Equality+import qualified Hydra.Dsl.Lib.Lists     as Lists+import qualified Hydra.Dsl.Lib.Literals  as Literals+import qualified Hydra.Dsl.Lib.Logic     as Logic+import qualified Hydra.Dsl.Lib.Maps      as Maps+import qualified Hydra.Dsl.Lib.Math      as Math+import qualified Hydra.Dsl.Lib.Optionals as Optionals+import qualified Hydra.Dsl.Phantoms      as Phantoms+import qualified Hydra.Dsl.Lib.Sets      as Sets+import           Hydra.Dsl.Lib.Strings   as Strings+import qualified Hydra.Dsl.Terms         as Terms+import qualified Hydra.Dsl.Types         as Types+import           Hydra.Sources.Kernel.Types.All+import           Prelude hiding ((++))+import qualified Data.List               as L+import qualified Data.Map                as M+import qualified Data.Set                as S+import qualified Data.Maybe              as Y++import qualified Hydra.Dsl.TTypes as T+import           Hydra.Dsl.TTerms as TTerms+++testGraphDefinition :: String -> TTerm a -> TBinding a+testGraphDefinition = definitionInModule testGraphModule++testGraphModule :: Module+testGraphModule = Module (Namespace "hydra.test.testGraph") elements+    []+    kernelTypesModules $+    Just ("A module defining the graph used in the test suite.")+  where+    elements = [+      el testTypeLatLonNameDef,+      el testTypeLatLonPolyNameDef,+      el latlonRecordDef,+      el testTypeLatLonDef,+      el testTypeLatLonPolyDef,+      el testTypeStringAliasDef,+      el testTypeStringAliasNameDef,+      el testTypePolymorphicWrapperDef,+      el testTypePolymorphicWrapperNameDef,+      el testElementArthurDef,+      el testElementFirstNameDef,+--      el testGraphDef, -- TODO+      el testNamespaceDef,+--      el testSchemaGraphDef, -- TODO+      el testSchemaNamespaceDef,+      el testDataArthurDef,+      el testTypeBuddyListADef,+      el testTypeBuddyListANameDef,+      el testTypeBuddyListBDef,+      el testTypeBuddyListBNameDef,+      el testTypeComparisonDef,+      el testTypeComparisonNameDef,+      el testTypeIntListDef,+      el testTypeIntListNameDef,+      el testTypeHydraLiteralTypeDef,+      el testTypeHydraLiteralTypeNameDef,+      el testTypeHydraTypeDef,+      el testTypeHydraTypeNameDef,+      el testTypeListDef,+      el testTypeListNameDef,+      el testTypeNumberDef,+      el testTypeNumberNameDef,+      el testTypePersonDef,+      el testTypePersonNameDef,+      el testTypePersonOrSomethingDef,+      el testTypePersonOrSomethingNameDef,+      el testTypeSimpleNumberDef,+      el testTypeSimpleNumberNameDef,+      el testTypeTimestampDef,+      el testTypeTimestampNameDef,+      el testTypeUnionMonomorphicDef,+      el testTypeUnionMonomorphicNameDef,+      el testTypeUnionPolymorphicRecursiveDef,+      el testTypeUnionPolymorphicRecursiveNameDef,+      el testTypeUnitDef,+      el testTypeUnitNameDef]++testGraphType :: String -> TTerm Type -> TBinding Type+testGraphType name = testGraphDefinition name . firstClassType++testTypeLatLonNameDef :: TBinding Name+testTypeLatLonNameDef = testGraphDefinition "testTypeLatLonName" $+  name "LatLon"++testTypeLatLonPolyNameDef :: TBinding Name+testTypeLatLonPolyNameDef = testGraphDefinition "testTypeLatLonPolyName" $+  name "LatLonPoly"++latlonRecordDef :: TBinding (Float -> Float -> Term)+latlonRecordDef = testGraphDefinition "latlonRecord" $+  Phantoms.lambdas ["lat", "lon"] $ record (ref testTypeLatLonNameDef) [+    "lat">: float32Lift $ varPhantom "lat",+    "lon">: float32Lift $ varPhantom "lon"]++testTypeLatLonDef :: TBinding Type+testTypeLatLonDef = testGraphType "testTypeLatLon" $+  T.record (ref testTypeLatLonNameDef) [+    "lat">: T.float32,+    "lon">: T.float32]++testTypeLatLonPolyDef :: TBinding Type+testTypeLatLonPolyDef = testGraphType "testTypeLatLonPoly" $+  T.forAll "a" $ T.record (ref testTypeLatLonPolyNameDef) [+    "lat">: T.var "a",+    "lon">: T.var "a"]++testTypeStringAliasDef :: TBinding Type+testTypeStringAliasDef = testGraphType "testTypeStringAlias" $+  Core.typeWrap $ Core.wrappedType (ref testTypeStringAliasNameDef) T.string++testTypeStringAliasNameDef :: TBinding Name+testTypeStringAliasNameDef = testGraphDefinition "testTypeStringAliasName" $+  name "StringTypeAlias"++testTypePolymorphicWrapperDef :: TBinding Type+testTypePolymorphicWrapperDef = testGraphType "testTypePolymorphicWrapper" $+  T.forAll "a" $ Core.typeWrap $ Core.wrappedType (ref testTypePolymorphicWrapperNameDef) (T.list $ T.var "a")++testTypePolymorphicWrapperNameDef :: TBinding Name+testTypePolymorphicWrapperNameDef = testGraphDefinition "testTypePolymorphicWrapperName" $+  name "PolymorphicWrapper"++testElementArthurDef :: TBinding Binding+testElementArthurDef = testGraphDefinition "testElementArthur" $+  Core.binding+    (name "firstName")+    (ref testDataArthurDef)+    (Phantoms.just $ Core.typeScheme (Phantoms.list []) (Core.typeVariable $ ref testTypePersonNameDef))++testElementFirstNameDef :: TBinding Binding+testElementFirstNameDef = testGraphDefinition "testElementFirstName" $+  Core.binding+    (name "firstName")+    (project (ref testTypePersonNameDef) (name "firstName"))+    (Phantoms.just $ Core.typeScheme (Phantoms.list [])+      (Core.typeFunction $ Core.functionType (Core.typeVariable $ ref testTypePersonNameDef) T.string))++--testGraph :: Graph+--testGraph = elementsToGraph hydraCoreGraph (Just testSchemaGraph) [testElementArthur, testElementFirstName]++testNamespaceDef :: TBinding Namespace+testNamespaceDef = testGraphDefinition "testNamespace" $ Module.namespace $ Phantoms.string "testGraph"++--testSchemaGraph :: Graph+--testSchemaGraph = elementsToGraph hydraCoreGraph (Just hydraCoreGraph) [+--    def testTypeBuddyListAName testTypeBuddyListA,+--    def testTypeBuddyListBName testTypeBuddyListB,+--    def testTypeComparisonName testTypeComparison,+--    def testTypeIntListName testTypeIntList,+--    def testTypeHydraLiteralTypeName testTypeHydraLiteralType,+--    def testTypeHydraTypeName testTypeHydraType,+--    def testTypeLatLonName testTypeLatLon,+--    def testTypeLatLonPolyName testTypeLatLonPoly,+--    def testTypeListName testTypeList,+--    def testTypeNumberName testTypeNumber,+--    def testTypePersonName testTypePerson,+--    def testTypePersonOrSomethingName testTypePersonOrSomething,+--    def testTypeSimpleNumberName testTypeSimpleNumber,+--    def testTypeStringAliasName $ Ann.doc "An alias for the string type" testTypeStringAlias,+--    def testTypeTimestampName testTypeTimestamp,+--    def testTypeUnionMonomorphicName testTypeUnionMonomorphic,+--    def testTypeUnionPolymorphicRecursiveName testTypeUnionPolymorphicRecursive,+--    def testTypeUnitName testTypeUnit]+--  where+--    def = typeElement++testSchemaNamespaceDef :: TBinding Namespace+testSchemaNamespaceDef = testGraphDefinition "testSchemaNamespace" $ Module.namespace $ Phantoms.string "testSchemaGraph"++testDataArthurDef :: TBinding Term+testDataArthurDef = testGraphDefinition "testDataArthur" $+  record (ref testTypePersonNameDef) [+    "firstName">: string "Arthur",+    "lastName">: string "Dent",+    "age">: int32 42]++testTypeBuddyListADef :: TBinding Type+testTypeBuddyListADef = testGraphType "testTypeBuddyListA" $+  T.forAll "a" $ T.record (ref testTypeBuddyListANameDef) [+    "head">: T.var "a",+    "tail">: T.optional $+      T.apply (Core.typeVariable $ ref testTypeBuddyListBNameDef) (T.var "a")]++testTypeBuddyListANameDef :: TBinding Name+testTypeBuddyListANameDef = testGraphDefinition "testTypeBuddyListAName" $+  name "BuddyListA"++testTypeBuddyListBDef :: TBinding Type+testTypeBuddyListBDef = testGraphType "testTypeBuddyListB" $+  T.forAll "a" $ T.record (ref testTypeBuddyListBNameDef) [+    "head">: T.var "a",+    "tail">: T.optional $+      T.apply (Core.typeVariable $ ref testTypeBuddyListANameDef) (T.var "a")]++testTypeBuddyListBNameDef :: TBinding Name+testTypeBuddyListBNameDef = testGraphDefinition "testTypeBuddyListBName" $+  name "BuddyListB"++testTypeComparisonDef :: TBinding Type+testTypeComparisonDef = testGraphType "testTypeComparison" $+  T.union (ref testTypeComparisonNameDef) [+    "lessThan">: T.unit,+    "equalTo">: T.unit,+    "greaterThan">: T.unit]++testTypeComparisonNameDef :: TBinding Name+testTypeComparisonNameDef = testGraphDefinition "testTypeComparisonName" $+  name "Comparison"++testTypeIntListDef :: TBinding Type+testTypeIntListDef = testGraphType "testTypeIntList" $+  T.record (ref testTypeIntListNameDef) [+    "head">: T.int32,+    "tail">: T.optional $ Core.typeVariable (ref testTypeIntListNameDef)]++testTypeIntListNameDef :: TBinding Name+testTypeIntListNameDef = testGraphDefinition "testTypeIntListName" $+  name "IntList"++testTypeHydraLiteralTypeDef :: TBinding Type+testTypeHydraLiteralTypeDef = testGraphType "testTypeHydraLiteralType" $+  T.union (ref testTypeHydraLiteralTypeNameDef) [+    "boolean">: T.boolean,+    "string">: T.string]++testTypeHydraLiteralTypeNameDef :: TBinding Name+testTypeHydraLiteralTypeNameDef = testGraphDefinition "testTypeHydraLiteralTypeName" $+  name "HydraLiteralType"++testTypeHydraTypeDef :: TBinding Type+testTypeHydraTypeDef = testGraphType "testTypeHydraType" $+  T.union (ref testTypeHydraTypeNameDef) [+    "literal">: Core.typeVariable $ ref testTypeHydraLiteralTypeNameDef,+    "list">: Core.typeVariable $ ref testTypeHydraTypeNameDef]++testTypeHydraTypeNameDef :: TBinding Name+testTypeHydraTypeNameDef = testGraphDefinition "testTypeHydraTypeName" $+  name "HydraType"++testTypeListDef :: TBinding Type+testTypeListDef = testGraphType "testTypeList" $+  T.forAll "a" $ T.record (ref testTypeListNameDef) [+    "head">: T.var "a",+    "tail">: T.optional $+      T.apply (Core.typeVariable $ ref testTypeListNameDef) (T.var "a")]++testTypeListNameDef :: TBinding Name+testTypeListNameDef = testGraphDefinition "testTypeListName" $+  name "List"++testTypeNumberDef :: TBinding Type+testTypeNumberDef = testGraphType "testTypeNumber" $+  T.union (ref testTypeNumberNameDef) [+    "int">: T.int32,+    "float">: T.float32]++testTypeNumberNameDef :: TBinding Name+testTypeNumberNameDef = testGraphDefinition "testTypeNumberName" $+  name "Number"++testTypePersonDef :: TBinding Type+testTypePersonDef = testGraphType "testTypePerson" $+  T.record (ref testTypePersonNameDef) [+    "firstName">: T.string,+    "lastName">: T.string,+    "age">: T.int32]++testTypePersonNameDef :: TBinding Name+testTypePersonNameDef = testGraphDefinition "testTypePersonName" $+  name "Person"++testTypePersonOrSomethingDef :: TBinding Type+testTypePersonOrSomethingDef = testGraphType "testTypePersonOrSomething" $+  T.forAll "a" $ T.union (ref testTypePersonOrSomethingNameDef) [+    "person">: Core.typeVariable $ ref testTypePersonNameDef,+    "other">: T.var "a"]++testTypePersonOrSomethingNameDef :: TBinding Name+testTypePersonOrSomethingNameDef = testGraphDefinition "testTypePersonOrSomethingName" $+  name "PersonOrSomething"++testTypeSimpleNumberDef :: TBinding Type+testTypeSimpleNumberDef = testGraphType "testTypeSimpleNumber" $+  T.union (ref testTypeSimpleNumberNameDef) [+    "int">: T.int32,+    "float">: T.float32]++testTypeSimpleNumberNameDef :: TBinding Name+testTypeSimpleNumberNameDef = testGraphDefinition "testTypeSimpleNumberName" $+  name "SimpleNumber"++testTypeTimestampDef :: TBinding Type+testTypeTimestampDef = testGraphType "testTypeTimestamp" $+  T.union (ref testTypeTimestampNameDef) [+    "unixTimeMillis">: T.uint64,+    "date">: T.string]++testTypeTimestampNameDef :: TBinding Name+testTypeTimestampNameDef = testGraphDefinition "testTypeTimestampName" $+  name "Timestamp"++testTypeUnionMonomorphicDef :: TBinding Type+testTypeUnionMonomorphicDef = testGraphType "testTypeUnionMonomorphic" $+  T.union (ref testTypeUnionMonomorphicNameDef) [+    "bool">: T.boolean,+    "string">: T.string,+    "unit">: T.unit]++testTypeUnionMonomorphicNameDef :: TBinding Name+testTypeUnionMonomorphicNameDef = testGraphDefinition "testTypeUnionMonomorphicName" $+  name "UnionMonomorphic"++testTypeUnionPolymorphicRecursiveDef :: TBinding Type+testTypeUnionPolymorphicRecursiveDef = testGraphType "testTypeUnionPolymorphicRecursive" $+  T.forAll "a" $ T.union (ref testTypeUnionPolymorphicRecursiveNameDef) [+    "bool">: T.boolean,+    "value">: T.var "a",+    "other">: T.apply (Core.typeVariable $ ref testTypeUnionPolymorphicRecursiveNameDef) (T.var "a")]++testTypeUnionPolymorphicRecursiveNameDef :: TBinding Name+testTypeUnionPolymorphicRecursiveNameDef = testGraphDefinition "testTypeUnionPolymorphicRecursiveName" $+  name "UnionPolymorphicRecursive"++testTypeUnitDef :: TBinding Type+testTypeUnitDef = testGraphType "testTypeUnit" $+  T.record (ref testTypeUnitNameDef) []++testTypeUnitNameDef :: TBinding Name+testTypeUnitNameDef = testGraphDefinition "testTypeUnitName" $+  name "Unit"
+ src/main/haskell/Hydra/Sources/Test/TestSuite.hs view
@@ -0,0 +1,62 @@+module Hydra.Sources.Test.TestSuite (testSuiteModule) where++import Hydra.Kernel+import Hydra.Testing+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Kernel.Terms.All+import Hydra.Dsl.Phantoms as Base+import Hydra.Dsl.Testing+import qualified Hydra.Dsl.TTerms as TTerms+import qualified Hydra.Sources.Kernel.Types.All as KernelTypes+import qualified Hydra.Sources.Kernel.Terms.All as Tier2++import Hydra.Sources.Test.Lib.Lists+import Hydra.Sources.Test.Lib.Strings+import Hydra.Sources.Test.Formatting+import Hydra.Sources.Test.Inference.InferenceSuite+import Hydra.Sources.Test.TestGraph++import qualified Data.List as L+++testSuiteNs = Namespace "hydra.test.testSuite"+testSuitePrimitivesNs = Namespace "hydra.test.testSuite.primitives"++testSuiteModule :: Module+testSuiteModule = Module testSuiteNs elements+    [testGraphModule]+    KernelTypes.kernelTypesModules $+    Just "Test cases for primitive functions"+  where+    elements = [+      allTestsEl,+      formattingTestsEl,+      inferenceTestsEl,+      listPrimitiveTestsEl,+      primitiveTestsEl,+      stringPrimitiveTestsEl]++allTestsEl :: Binding+allTestsEl = encodedTestGroupToBinding testSuiteNs "allTests" $ tgroup "All tests" Nothing subgroups []+  where+    subgroups = fmap groupRef [+      formattingTestsEl,+      inferenceTestsEl,+      primitiveTestsEl]++formattingTestsEl = testGroupToBinding testSuiteNs "formattingTests" formattingTests++inferenceTestsEl = encodedTestGroupToBinding testSuiteNs "inferenceTests" inferenceTests++listPrimitiveTestsEl = testGroupToBinding testSuiteNs "listPrimitiveTests" listPrimitiveTests++primitiveTestsEl = encodedTestGroupToBinding testSuiteNs "primitiveTests" $+    tgroup "Primitive functions" (Just "Test cases for primitive functions") primGroups []+  where+    primGroups = fmap groupRef [+      listPrimitiveTestsEl,+      stringPrimitiveTestsEl]++stringPrimitiveTestsEl = testGroupToBinding testSuiteNs "stringPrimitiveTests" stringPrimitiveTests+
− src/main/haskell/Hydra/Sources/Tier0/All.hs 
@@ -1,50 +0,0 @@-module Hydra.Sources.Tier0.All(-  module Hydra.Sources.Tier0.All,-  module Hydra.Sources.Core,-  module Hydra.Sources.Tier0.Ast,-  module Hydra.Sources.Tier0.Coders,-  module Hydra.Sources.Tier0.Compute,-  module Hydra.Sources.Tier0.Constraints,-  module Hydra.Sources.Tier0.Grammar,-  module Hydra.Sources.Tier0.Graph,-  module Hydra.Sources.Tier0.Json,-  module Hydra.Sources.Tier0.Mantle,-  module Hydra.Sources.Tier0.Module,-  module Hydra.Sources.Tier0.Phantoms,-  module Hydra.Sources.Tier0.Query,-  module Hydra.Sources.Tier0.Testing,-  module Hydra.Sources.Tier0.Workflow,-) where--import Hydra.Sources.Core-import Hydra.Sources.Tier0.Ast-import Hydra.Sources.Tier0.Coders-import Hydra.Sources.Tier0.Compute-import Hydra.Sources.Tier0.Constraints-import Hydra.Sources.Core-import Hydra.Sources.Tier0.Grammar-import Hydra.Sources.Tier0.Graph-import Hydra.Sources.Tier0.Json-import Hydra.Sources.Tier0.Mantle-import Hydra.Sources.Tier0.Module-import Hydra.Sources.Tier0.Phantoms-import Hydra.Sources.Tier0.Query-import Hydra.Sources.Tier0.Testing-import Hydra.Sources.Tier0.Workflow--tier0Modules :: [Module]-tier0Modules = [-  hydraAstModule,-  hydraCodersModule,-  hydraComputeModule,-  hydraConstraintsModule,-  hydraCoreModule,-  hydraGrammarModule,-  hydraGraphModule,-  hydraMantleModule,-  hydraModuleModule,-  hydraPhantomsModule,-  hydraQueryModule,-  hydraTestingModule,-  hydraWorkflowModule,-  jsonModelModule]
− src/main/haskell/Hydra/Sources/Tier0/Ast.hs 
@@ -1,105 +0,0 @@-module Hydra.Sources.Tier0.Ast where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraAstModule :: Module-hydraAstModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A model which provides a common syntax tree for Hydra serializers"-  where-    ns = Namespace "hydra/ast"-    def = datatype ns-    ast = typeref ns--    elements = [--      def "Associativity" $-        doc "Operator associativity" $-        enum ["none", "left", "right", "both"],--      def "BlockStyle" $-        doc "Formatting option for code blocks" $-        record [-          "indent">: optional string,-          "newlineBeforeContent">: boolean,-          "newlineAfterContent">: boolean],--      def "BracketExpr" $-        doc "An expression enclosed by brackets" $-        record [-          "brackets">: ast "Brackets",-          "enclosed">: ast "Expr",-          "style">: ast "BlockStyle"],--      def "Brackets" $-        doc "Matching open and close bracket symbols" $-        record [-          "open">: ast "Symbol",-          "close">: ast "Symbol"],--      def "Expr" $-        doc "An abstract expression" $-        union [-          "const">: ast "Symbol",-          "indent">: ast "IndentedExpression",-          "op">: ast "OpExpr",-          "brackets">: ast "BracketExpr"],--      def "IndentedExpression" $-        doc "An expression indented in a certain style" $-        record [-          "style">: ast "IndentStyle",-          "expr">: ast "Expr"],--      def "IndentStyle" $-        doc "Any of several indentation styles" $-        union [-          "allLines">: string,-          "subsequentLines">: string],--      def "Op" $-        doc "An operator symbol" $-        record [-          "symbol">: ast "Symbol",-          "padding">: ast "Padding",-          "precedence">: ast "Precedence",-          "associativity">: ast "Associativity"],--      def "OpExpr" $-        doc "An operator expression" $-        record [-          "op">: ast "Op",-          "lhs">: ast "Expr",-          "rhs">: ast "Expr"],--      def "Padding" $-        doc "Left and right padding for an operator" $-        record [-          "left">: ast "Ws",-          "right">: ast "Ws"],--      def "Precedence" $-        doc "Operator precedence" $-        int32,--      def "Symbol" $-        doc "Any symbol"-        string,--      def "Ws" $-        doc "One of several classes of whitespace" $-        union [-          "none">: unit,-          "space">: unit,-          "break">: unit,-          "breakAndIndent">: string,-          "doubleBreak">: unit]]
− src/main/haskell/Hydra/Sources/Tier0/Coders.hs 
@@ -1,93 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Coders where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Compute-import Hydra.Sources.Tier0.Graph-import Hydra.Sources.Tier0.Mantle---hydraCodersModule :: Module-hydraCodersModule = Module ns elements [hydraMantleModule, hydraGraphModule] [hydraCoreModule] $-    Just "Abstractions for paired transformations between languages"-  where-    ns = Namespace "hydra/coders"-    core = typeref $ moduleNamespace hydraCoreModule-    compute = typeref $ moduleNamespace hydraComputeModule-    graph = typeref $ moduleNamespace hydraGraphModule-    mantle = typeref $ moduleNamespace hydraMantleModule-    coders = typeref ns--    def = datatype ns--    elements = [--      def "AdapterContext" $-        doc "An evaluation context together with a source language and a target language" $-        record [-          "graph">: graph "Graph",-          "language">: coders "Language",-          "adapters">: Types.map (core "Name") (compute "Adapter"-            @@ coders "AdapterContext" @@ coders "AdapterContext"-            @@ core "Type" @@ core "Type"-            @@ core "Term" @@ core "Term")],--      def "CoderDirection" $-        doc "Indicates either the 'out' or the 'in' direction of a coder" $-        enum [-          "encode",-          "decode"],--      def "Language" $-        doc "A named language together with language-specific constraints" $-        record [-          "name">: coders "LanguageName",-          "constraints">: coders "LanguageConstraints"],--      def "LanguageConstraints" $-        doc "A set of constraints on valid type and term expressions, characterizing a language" $-        record [-          "eliminationVariants">:-            doc "All supported elimination variants" $-            Types.set $ mantle "EliminationVariant",-          "literalVariants">:-            doc "All supported literal variants" $-            Types.set $ mantle "LiteralVariant",-          "floatTypes">:-            doc "All supported float types" $-            Types.set $ core "FloatType",-          "functionVariants">:-            doc "All supported function variants" $-            Types.set $ mantle "FunctionVariant",-          "integerTypes">:-            doc "All supported integer types" $-            Types.set $ core "IntegerType",-          "termVariants">:-            doc "All supported term variants" $-            Types.set $ mantle "TermVariant",-          "typeVariants">:-            doc "All supported type variants" $-            Types.set $ mantle "TypeVariant",-          "types">:-            doc "A logical set of types, as a predicate which tests a type for inclusion" $-            core "Type" --> boolean],--      def "LanguageName" $-        doc "The unique name of a language" string,--      def "TraversalOrder" $-        doc "Specifies either a pre-order or post-order traversal" $-        union [-          "pre">: doc "Pre-order traversal" unit,-          "post">: doc "Post-order traversal" unit]]
− src/main/haskell/Hydra/Sources/Tier0/Compute.hs 
@@ -1,68 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Compute where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraComputeModule :: Module-hydraComputeModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "Abstractions for single- and bidirectional transformations"-  where-    ns = Namespace "hydra/compute"-    core = typeref $ moduleNamespace hydraCoreModule-    compute = typeref ns--    def = datatype ns--    elements = [--      def "Adapter" $-        doc "A two-level bidirectional encoder which adapts types to types and terms to terms" $-        lambda "s1" $ lambda "s2" $ lambda "t1" $ lambda "t2" $ lambda "v1" $ lambda "v2" $ record [-          "isLossy">: boolean,-          "source">: var "t1",-          "target">: var "t2",-          "coder">: compute "Coder" @@ "s1" @@ "s2" @@ "v1" @@ "v2"],--      def "Bicoder" $-        doc "A two-level encoder and decoder, operating both at a type level and an instance (data) level" $-        lambda "s1" $ lambda "s2" $ lambda "t1" $ lambda "t2" $ lambda "v1" $ lambda "v2" $ record [-          "encode">: "t1" --> compute "Adapter" @@ "s1" @@ "s2" @@ "t1" @@ "t2" @@ "v1" @@ "v2",-          "decode">: "t2" --> compute "Adapter" @@ "s2" @@ "s1" @@ "t2" @@ "t1" @@ "v2" @@ "v1"],--      def "Coder" $-        doc "An encoder and decoder; a bidirectional flow between two types" $-        lambda "s1" $ lambda "s2" $ lambda "v1" $ lambda "v2" $ record [-          "encode">: ("v1" --> compute "Flow" @@ "s1" @@ "v2"),-          "decode">: ("v2" --> compute "Flow" @@ "s2" @@ "v1")],--      def "Flow" $-        doc "A variant of the State monad with built-in logging and error handling" $-        lambda "s" $ lambda "x" $-        function "s" (compute "Trace" --> compute "FlowState" @@ "s" @@ "x"),--      def "FlowState" $-        doc "The result of evaluating a Flow" $-        lambda "s" $ lambda "x" $ record [-          "value">: optional "x",-          "state">: "s",-          "trace">: compute "Trace"],--      def "Trace" $-        doc "A container for logging and error information" $-        record [-          "stack">: list string,-          "messages">: list string,-          "other">:-            doc "A map of string keys to arbitrary terms as values, for application-specific use" $-            Types.map (core "Name") (core "Term")]]
− src/main/haskell/Hydra/Sources/Tier0/Constraints.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Constraints where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Query---hydraConstraintsModule :: Module-hydraConstraintsModule = Module ns elements [hydraQueryModule] [hydraCoreModule] $-    Just "A model for path- and pattern-based graph constraints, which may be considered as part of the schema of a graph"-  where-    ns = Namespace "hydra/constraints"-    core = typeref $ moduleNamespace hydraCoreModule-    query = typeref $ moduleNamespace hydraQueryModule-    constraints = typeref ns-    def = datatype ns--    elements = [--      def "PathEquation" $-        doc "A declared equivalence between two abstract paths in a graph" $-        record [-          "left">: query "Path",-          "right">: query "Path"],--      def "PatternImplication" $-        doc "A pattern which, if it matches in a given graph, implies that another pattern must also match. Query variables are shared between the two patterns." $-        record [-          "antecedent">: query "Pattern",-          "consequent">: query "Pattern"]]
− src/main/haskell/Hydra/Sources/Tier0/Grammar.hs 
@@ -1,72 +0,0 @@--- | A model for Hydra labeled-BNF grammars--module Hydra.Sources.Tier0.Grammar where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraGrammarModule :: Module-hydraGrammarModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A common API for BNF-based grammars, specifying context-free languages"-  where-    ns = Namespace "hydra/grammar"-    grammar = typeref ns-    def = datatype ns--    elements = [--      def "Constant" $-        doc "A constant pattern"-        string,--      def "Grammar" $-        doc "An enhanced Backus-Naur form (BNF) grammar" $-        list $ grammar "Production",--      def "Label" $-        doc "A name for a pattern"-        string,--      def "LabeledPattern" $-        doc "A pattern together with a name (label)" $-        record [-        "label">: grammar "Label",-        "pattern">: grammar "Pattern"],--      def "Pattern" $-        doc "A pattern which matches valid expressions in the language" $-        union [-          "nil">: unit,-          "ignored">: grammar "Pattern",-          "labeled">: grammar "LabeledPattern",-          "constant">: grammar "Constant",-          "regex">: grammar "Regex",-          "nonterminal">: grammar "Symbol",-          "sequence">: list $ grammar "Pattern",-          "alternatives">: list $ grammar "Pattern",-          "option">: grammar "Pattern",-          "star">: grammar "Pattern",-          "plus">: grammar "Pattern"],--      def "Production" $-        doc "A BNF production" $-        record [-          "symbol">: grammar "Symbol",-          "pattern">: grammar "Pattern"],--      def "Regex" $-        doc "A regular expression"-        string,--      def "Symbol" $-        doc "A nonterminal symbol"-        string]
− src/main/haskell/Hydra/Sources/Tier0/Graph.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Graph where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Compute---hydraGraphModule :: Module-hydraGraphModule = Module ns elements [hydraComputeModule] [hydraCoreModule] $-    Just "The extension to graphs of Hydra's core type system (hydra/core)"-  where-    ns = Namespace "hydra/graph"-    core = typeref $ moduleNamespace hydraCoreModule-    compute = typeref $ moduleNamespace hydraComputeModule-    graph = typeref ns-    def = datatype ns--    elements = [--      def "Comparison" $-        doc "An equality judgement: less than, equal to, or greater than" $-        enum [-          "lessThan",-          "equalTo",-          "greaterThan"],--      def "Graph" $-        doc "A graph, or set of name/term bindings together with parameters (annotations, primitives) and a schema graph" $-        record [--          -- TODO: remove this; replace it with 'environment'-          "elements">:-            doc "All of the elements in the graph" $-            Types.map (core "Name") (graph "Element"),--          "environment">:-            doc "The lambda environment of this graph context; it indicates whether a variable is bound by a lambda (Nothing) or a let (Just term)" $-            Types.map (core "Name") (optional $ core "Term"),-          "types">:-            doc "The typing environment of the graph" $-            Types.map (core "Name") (core "TypeScheme"),-          "body">:-            doc "The body of the term which generated this context" $-            core "Term",-          "primitives">:-            doc "All supported primitive constants and functions, by name" $-            Types.map (core "Name") (graph "Primitive"),-          "schema">:-            doc "The schema of this graph. If this parameter is omitted (nothing), the graph is its own schema graph." $-            optional $ graph "Graph"],--      def "Element" $-        doc "A graph element, having a name, data term (value), and schema term (type)" $-        record [-          "name">: core "Name",-          "data">: core "Term"],--      def "Primitive" $-        doc "A built-in function" $-        record [-          "name">:-            doc "The unique name of the primitive function" $-            core "Name",-          "type">:-            doc "The type signature of the primitive function" $-            core "TypeScheme",-          "implementation">:-            doc "A concrete implementation of the primitive function" $-            list (core "Term") --> compute "Flow" @@ (graph "Graph") @@ (core "Term")],--      def "TermCoder" $-        doc "A type together with a coder for mapping terms into arguments for primitive functions, and mapping computed results into terms" $-        lambda "x" $ record [-          "type">: core "Type",-          "coder">: compute "Coder" @@ (graph "Graph") @@ (graph "Graph") @@ (core "Term") @@ "x"],--      def "TypeClass" $-        doc "Any of a small number of built-in type classes" $-        enum [-          "equality",-          "ordering"]]
− src/main/haskell/Hydra/Sources/Tier0/Json.hs 
@@ -1,47 +0,0 @@--- | A simple JSON model. This model is part of the Hydra kernel, despite JSON being an external language; JSON support is built in to Hydra--module Hydra.Sources.Tier0.Json where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---jsonModelModule :: Module-jsonModelModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A JSON syntax model. See the BNF at https://www.json.org"-  where-    ns = Namespace "hydra/json"-    def = datatype ns-    json = typeref ns--    elements = [--      def "Value" $-        doc "A JSON value" $-        union [-          "array">:-            doc "A JSON array" $-            list $ json "Value",-          "boolean">:-            doc "A boolean value"-            boolean,-          "null">:-            doc "JSON's null value"-            unit,-          "number">:-            doc "A numeric value"-            bigfloat, -- TODO: JSON numbers are decimal-encoded-          "object">:-            doc "A JSON object as a set of key/value pairs" $-            Types.map string (json "Value"),-          "string">:-            doc "A string value"-            string]]
− src/main/haskell/Hydra/Sources/Tier0/Mantle.hs 
@@ -1,140 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Mantle where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraMantleModule :: Module-hydraMantleModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A set of types which supplement hydra/core with variants and accessors"-  where-    ns = Namespace "hydra/mantle"-    core = typeref $ moduleNamespace hydraCoreModule-    mantle = typeref ns-    def = datatype ns--    elements = [--      def "Either" $-        doc "A disjoint union between a 'left' type and a 'right' type" $-        lambda "a" $ lambda "b" $ union [-          "left">: "a",-          "right">: "b"],--      def "EliminationVariant" $-        doc "The identifier of an elimination constructor" $-        enum [-          "list",-          "optional",-          "product",-          "record",-          "union",-          "wrap"],--      def "FunctionVariant" $-        doc "The identifier of a function constructor" $-        enum [-          "elimination",-          "lambda",-          "primitive"],--      def "LiteralVariant" $-        doc "The identifier of a literal constructor" $-        enum [-          "binary",-          "boolean",-          "float",-          "integer",-          "string"],--      def "Precision" $-        doc "Numeric precision: arbitrary precision, or precision to a specified number of bits" $-        union [-          "arbitrary">: unit,-          "bits">: int32],--      def "TermAccessor" $-        doc "A function which maps from a term to a particular immediate subterm" $-        union [-          "annotatedSubject">: unit,-          "applicationFunction">: unit,-          "applicationArgument">: unit,-          "lambdaBody">: unit,-          "listFold">: unit,-          "optionalCasesNothing">: unit,-          "optionalCasesJust">: unit,-          "unionCasesDefault">: unit,-          "unionCasesBranch">: core "Name",-          "letEnvironment">: unit,-          "letBinding">: core "Name",-          "listElement">: int32,-          "mapKey">: int32,-          "mapValue">: int32,-          "optionalTerm">: unit,-          "productTerm">: int32,-          "recordField">: core "Name",-          "setElement">: int32,-          "sumTerm">: unit,-          "typeAbstractionBody">: unit,-          "typeApplicationTerm">: unit,-          "typedTerm">: unit,-          "injectionTerm">: unit,-          "wrappedTerm">: unit],--      def "TermVariant" $-        doc "The identifier of a term expression constructor" $-        enum [-          "annotated",-          "application",-          "function",-          "let",-          "list",-          "literal",-          "map",-          "optional",-          "product",-          "record",-          "set",-          "sum",-          "typeAbstraction",-          "typeApplication",-          "typed",-          "union",-          "variable",-          "wrap"],--      def "TypeConstraint" $-        doc "An assertion that two types can be unified into a single type" $-        record [-          "left">: core "Type",-          "right">: core "Type",-          "context">: optional string],--      def "TypeVariant" $-        doc "The identifier of a type constructor" $-        enum [-          "annotated",-          "application",-          "function",-          "lambda",-          "list",-          "literal",-          "map",-          "optional",-          "product",-          "record",-          "set",-          "sum",-          "union",-          "variable",-          "wrap"]]
− src/main/haskell/Hydra/Sources/Tier0/Module.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Module where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Graph---hydraModuleModule :: Module-hydraModuleModule = Module ns elements [hydraGraphModule] [hydraCoreModule] $-    Just "A model for Hydra namespaces and modules (collections of elements in the same namespace)"-  where-    ns = Namespace "hydra/module"-    graph = typeref $ moduleNamespace hydraGraphModule-    mod = typeref ns-    def = datatype ns--    elements = [--      def "FileExtension" string,--      def "Library" $-        doc "A library of primitive functions" $-        record [-          "namespace">:-            doc "A common prefix for all primitive function names in the library" $-            mod "Namespace",-          "prefix">:-            doc "A preferred namespace prefix for function names in the library"-            string,-          "primitives">:-            doc "The primitives defined in this library" $-            list $ graph "Primitive"],--      def "Module" $-        doc "A logical collection of elements in the same namespace, having dependencies on zero or more other modules" $-        record [-          "namespace">:-            doc "A common prefix for all element names in the module" $-            mod "Namespace",-          "elements">:-            doc "The elements defined in this module" $-            list $ graph "Element",-          "termDependencies">:-            doc "Any modules which the term expressions of this module directly depend upon" $-            list $ mod "Module",-          "typeDependencies">:-            doc "Any modules which the type expressions of this module directly depend upon" $-            list $ mod "Module",-          "description">:-            doc "An optional human-readable description of the module" $-            optional string],--      def "Namespace" $-        doc "A prefix for element names"-        string,--      def "QualifiedName" $-        doc "A qualified name consisting of an optional namespace together with a mandatory local name" $-        record [-          "namespace">: optional $ mod "Namespace",-          "local">: string]]
− src/main/haskell/Hydra/Sources/Tier0/Phantoms.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Phantoms where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Compute---hydraPhantomsModule :: Module-hydraPhantomsModule = Module ns elements [hydraComputeModule] [hydraCoreModule] $-    Just "Phantom types for use with Hydra DSLs"-  where-    ns = Namespace "hydra/phantoms"-    core = typeref $ moduleNamespace hydraCoreModule-    phantoms = typeref ns-    def = datatype ns--    elements = [--      def "TCase" $-        doc "An association of a field name (as in a case statement) with a phantom type" $-        lambda "a" $ core "Name",--      def "TElement" $-        doc "An association with a named term (element) with a phantom type" $-        lambda "a" $ record [-          "name">: core "Name",-          "term">: phantoms "TTerm" @@ "a"],--      def "TField" $-        doc "An association with a term-level field with a phantom type" $-        lambda "a" $ core "Field",--      def "TTerm" $-        doc "An association of a term with a phantom type" $-        lambda "a" $ core "Term"]
− src/main/haskell/Hydra/Sources/Tier0/Query.hs 
@@ -1,153 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Query where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraQueryModule :: Module-hydraQueryModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A model for language-agnostic graph pattern queries"-  where-    ns = Namespace "hydra/query"-    core = typeref $ moduleNamespace hydraCoreModule-    query = typeref ns-    def = datatype ns--    elements = [-      def "ComparisonConstraint" $-        doc "One of several comparison operators" $-        enum ["equal", "notEqual", "lessThan", "greaterThan", "lessThanOrEqual", "greaterThanOrEqual"],--      def "Edge" $-        doc "An abstract edge based on a record type" $-        record [-          "type">:-            doc "The name of a record type, for which the edge also specifies an out- and an in- projection" $-            core "Name",-          "out">:-            doc "The field representing the out-projection of the edge. Defaults to 'out'." $-            optional $ core "Name",-          "in">:-            doc "The field representing the in-projection of the edge. Defaults to 'in'." $-            optional $ core "Name"],--      def "GraphPattern" $-        doc "A query pattern which matches within a designated component subgraph" $-        record [-          "graph">:-            doc "The name of the component graph" $-            core "Name",-          "patterns">:-            doc "The patterns to match within the subgraph" $-            list (query "Pattern")],--      def "Node" $-        doc "A node in a query expression; it may be a term, a variable, or a wildcard" $-        union [-          "term">:-            doc "A graph term; an expression which is valid in the graph being matched" $-            core "Term",-          "variable">:-            doc "A query variable, not to be confused with a variable term" $-            query "Variable",-          "wildcard">:-            doc "An anonymous variable which we do not care to join across patterns" unit],--      def "Path" $-        doc "A query path" $-        union [-          "step">:-            doc "A path given by a single step" $-            query "Step",-          "regex">:-            doc "A path given by a regular expression quantifier applied to another path" $-            query "RegexSequence",-          "inverse">:-            doc "A path given by the inverse of another path" $-            query "Path"],--      def "Pattern" $-        doc "A query pattern" $-        union [-          "triple">:-            doc "A subject/predicate/object pattern" $-            query "TriplePattern",-          "negation">:-            doc "The negation of another pattern" $-            query "Pattern",-          "conjunction">:-            doc "The conjunction ('and') of several other patterns" $-            list (query "Pattern"),-          "disjunction">:-            doc "The disjunction (inclusive 'or') of several other patterns" $-            list (query "Pattern"),-          "graph">:-            doc "A pattern which matches within a named subgraph" $-            query "GraphPattern"],--      def "Query" $-        doc "A SELECT-style graph pattern matching query" $-        record [-          "variables">:-            doc "The variables selected by the query" $-            list $ query "Variable",-          "patterns">:-            doc "The patterns to be matched" $-            list (query "Pattern")],--      def "Range" $-        doc "A range from min to max, inclusive" $-        record [-          "min">: int32,-          "max">: int32],--      def "RegexQuantifier" $-        doc "A regular expression quantifier" $-        union [-          "one">: doc "No quantifier; matches a single occurrence" unit,-          "zeroOrOne">: doc "The ? quanifier; matches zero or one occurrence" unit,-          "zeroOrMore">: doc "The * quantifier; matches any number of occurrences" unit,-          "oneOrMore">: doc "The + quantifier; matches one or more occurrences" unit,-          "exactly">: doc "The {n} quantifier; matches exactly n occurrences" int32,-          "atLeast">: doc "The {n,} quantifier; matches at least n occurrences" int32,-          "range">: doc "The {n, m} quantifier; matches between n and m (inclusive) occurrences" $ query "Range"],--      def "RegexSequence" $-        doc "A path with a regex quantifier" $-        record [-          "path">: query "Path",-          "quantifier">: query "RegexQuantifier"],--      def "Step" $-        doc "An atomic function as part of a query. When applied to a graph, steps are typed by function types." $-        union [-          "edge">:-            doc "An out-to-in traversal of an abstract edge" $-            query "Edge",-          "project">:-            doc "A projection from a record through one of its fields" $-            core "Projection",-          "compare">:-            doc "A comparison of two terms" $-            query "ComparisonConstraint"],--      def "TriplePattern" $-        doc "A subject/predicate/object pattern" $-        record [-          "subject">: query "Node",-          "predicate">: query "Path",-          "object">: query "Node"],--      def "Variable" $-        doc "A query variable"-        string]
− src/main/haskell/Hydra/Sources/Tier0/Testing.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Testing where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core---hydraTestingModule :: Module-hydraTestingModule = Module ns elements [hydraCoreModule] [hydraCoreModule] $-    Just "A model for unit testing"-  where-    ns = Namespace "hydra/testing"-    def = datatype ns-    core = typeref $ moduleNamespace hydraCoreModule-    testing = typeref ns--    elements = [--      def "EvaluationStyle" $-        doc "One of two evaluation styles: eager or lazy" $-        enum ["eager", "lazy"],--      def "TestCase" $-        doc "A simple test case with an input and an expected output" $-        record [-          "description">: optional string,-          "evaluationStyle">: testing "EvaluationStyle",-          "input">: core "Term",-          "output">: core "Term"],--      def "TestGroup" $-        doc "A collection of test cases with a name and optional description" $-        record [-          "name">: string,-          "description">: optional string,-          "subgroups">: list (testing "TestGroup"),-          "cases">: list (testing "TestCase")]]
− src/main/haskell/Hydra/Sources/Tier0/Workflow.hs 
@@ -1,86 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier0.Workflow where---- Standard Tier-0 imports-import qualified Data.List             as L-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Maybe            as Y-import           Hydra.Dsl.Annotations-import           Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Terms       as Terms-import           Hydra.Dsl.Types       as Types-import           Hydra.Sources.Core--import Hydra.Sources.Tier0.Compute-import Hydra.Sources.Tier0.Graph-import Hydra.Sources.Tier0.Module---hydraWorkflowModule :: Module-hydraWorkflowModule = Module ns elements [hydraModuleModule, hydraComputeModule, hydraGraphModule] [hydraCoreModule] $-    Just "A model for Hydra transformation workflows"-  where-    ns = Namespace "hydra/workflow"-    mod = typeref $ moduleNamespace hydraModuleModule-    compute = typeref $ moduleNamespace hydraComputeModule-    core = typeref $ moduleNamespace hydraCoreModule-    graph = typeref $ moduleNamespace hydraGraphModule-    wf = typeref ns-    def = datatype ns--    elements = [--      def "HydraSchemaSpec" $-        doc "The specification of a Hydra schema, provided as a set of modules and a distinguished type" $-        record [-          "modules">:-            doc "The modules to include in the schema graph" $-            list $ mod "Module",-          "typeName">:-            doc "The name of the top-level type; all data which passes through the workflow will be instances of this type" $-            core "Name"],--      def "LastMile" $-        doc "The last mile of a transformation, which encodes and serializes terms to a file" $-        lambda "s" $ lambda "a" $ record [-          "encoder">:-            doc "An encoder for terms to a list of output objects" $-            core "Type" --> compute "Flow" @@ "s"-              @@ (core "Term" --> graph "Graph" --> compute "Flow" @@ "s" @@ list "a"),-          "serializer">:-            doc "A function which serializes a list of output objects to a string representation" $-            list "a" --> compute "Flow" @@ "s" @@ string,-          "fileExtension">:-            doc "A file extension for the generated file(s)"-            string],--      def "SchemaSpec" $-        doc "The specification of a schema at the source end of a workflow" $-        union [-          "hydra">:-            doc "A native Hydra schema" $-            wf "HydraSchemaSpec",-          "file">:-            doc "A schema provided as a file, available at the given file path" $-            string,-          "provided">:-            doc "A schema which will be provided within the workflow" $-            unit],--      def "TransformWorkflow" $-        doc "The specification of a workflow which takes a schema specification, reads data from a directory, and writes data to another directory" $-        record [-          "name">:-            doc "A descriptive name for the workflow"-            string,-          "schemaSpec">:-            doc "The schema specification" $-            wf "SchemaSpec",-          "srcDir">:-            doc "The source directory"-            string,-          "destDir">:-            doc "The destination directory"-            string]]
− src/main/haskell/Hydra/Sources/Tier1/All.hs 
@@ -1,27 +0,0 @@-module Hydra.Sources.Tier1.All(-  module Hydra.Sources.Tier1.All,-  module Hydra.Sources.Tier0.All,-  module Hydra.Sources.Tier1.Constants,-  module Hydra.Sources.Tier1.CoreEncoding,-  module Hydra.Sources.Tier1.Decode,-  module Hydra.Sources.Tier1.Messages,-  module Hydra.Sources.Tier1.Strip,-  module Hydra.Sources.Tier1.Tier1,-) where--import Hydra.Sources.Tier0.All-import Hydra.Sources.Tier1.Constants-import Hydra.Sources.Tier1.CoreEncoding hiding (ref)-import Hydra.Sources.Tier1.Decode-import Hydra.Sources.Tier1.Messages-import Hydra.Sources.Tier1.Strip-import Hydra.Sources.Tier1.Tier1--tier1Modules :: [Module]-tier1Modules = [-  coreEncodingModule,-  decodeModule,-  hydraConstantsModule,-  hydraMessagesModule,-  hydraStripModule,-  hydraTier1Module]
− src/main/haskell/Hydra/Sources/Tier1/Constants.hs 
@@ -1,51 +0,0 @@-module Hydra.Sources.Tier1.Constants where---- Standard Tier-1 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier0.All---constantsDefinition :: String -> TTerm a -> TElement a-constantsDefinition = definitionInModule hydraConstantsModule--hydraConstantsModule :: Module-hydraConstantsModule = Module (Namespace "hydra/constants") elements [] tier0Modules $-    Just ("A module for tier-0 constants.")-  where-   elements = [-     el ignoredVariableDef,-     el placeholderNameDef,-     el maxTraceDepthDef]--ignoredVariableDef :: TElement String-ignoredVariableDef = constantsDefinition "ignoredVariable" $-  string "_"--placeholderNameDef :: TElement Name-placeholderNameDef = constantsDefinition "placeholderName" $-  doc "A placeholder name for row types as they are being constructed" $-  wrap _Name $ string "Placeholder"--maxTraceDepthDef :: TElement Int-maxTraceDepthDef = constantsDefinition "maxTraceDepth" $ int32 50
− src/main/haskell/Hydra/Sources/Tier1/CoreEncoding.hs 
@@ -1,441 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier1.CoreEncoding where---- TODO: use standard Tier-1 imports-import Hydra.Sources.Tier0.All-import qualified Hydra.Dsl.Terms as Terms-import Hydra.Dsl.ShorthandTypes-import Hydra.Dsl.Base as Base-import qualified Hydra.Dsl.Core as Core-import qualified Hydra.Dsl.Types as Types-import Hydra.Sources.Libraries--import qualified Data.Map as M-import qualified Data.Set as S---coreEncodingModule :: Module-coreEncodingModule = Module (Namespace "hydra/coreEncoding") elements [] tier0Modules $-    Just ("Mapping of hydra/core constructs in a host language like Haskell or Java "-      ++ " to their native Hydra counterparts as terms. "-      ++ " This includes an implementation of LambdaGraph's epsilon encoding (types to terms).")-  where-   elements = [-     el coreEncodeAnnotatedTermDef,-     el coreEncodeAnnotatedTypeDef,-     el coreEncodeApplicationDef,-     el coreEncodeApplicationTypeDef,-     el coreEncodeCaseStatementDef,-     el coreEncodeEliminationDef,-     el coreEncodeFieldDef,-     el coreEncodeFieldTypeDef,-     el coreEncodeFloatTypeDef,-     el coreEncodeFloatValueDef,-     el coreEncodeFunctionDef,-     el coreEncodeFunctionTypeDef,-     el coreEncodeInjectionDef,-     el coreEncodeIntegerTypeDef,-     el coreEncodeIntegerValueDef,-     el coreEncodeLambdaDef,-     el coreEncodeLambdaTypeDef,-     el coreEncodeLetDef,-     el coreEncodeLetBindingDef,-     el coreEncodeLiteralDef,-     el coreEncodeLiteralTypeDef,-     el coreEncodeMapTypeDef,-     el coreEncodeNameDef,-     el coreEncodeOptionalCasesDef,-     el coreEncodeProjectionDef,-     el coreEncodeRecordDef,-     el coreEncodeRowTypeDef,-     el coreEncodeSumDef,-     el coreEncodeTermDef,-     el coreEncodeTupleProjectionDef,-     el coreEncodeTypeDef,-     el coreEncodeTypeAbstractionDef,-     el coreEncodeTypeSchemeDef,-     el coreEncodeTypedTermDef,-     el coreEncodeWrappedTermDef,-     el coreEncodeWrappedTypeDef]--coreEncodingDefinition :: String -> Type -> TTerm x -> TElement x-coreEncodingDefinition label dom datum = definitionInModule coreEncodingModule ("coreEncode" ++ label) $-  function dom termT datum--encodedBinary :: TTerm String -> TTerm Term-encodedBinary = encodedLiteral . Core.literalBinary--encodedBoolean :: TTerm Bool -> TTerm Term-encodedBoolean = encodedLiteral . Core.literalBoolean--encodedCase :: Name -> Name -> TTerm (a -> Term) -> Field-encodedCase tname fname enc = field fname $ lambda "v" $ encodedVariant tname fname (enc @@ var "v")--encodedField :: Name -> TTerm Term -> TTerm Term-encodedField fname term = encodedFieldRaw (encodedName fname) term--encodedFieldRaw :: TTerm Name -> TTerm Term -> TTerm Term-encodedFieldRaw (TTerm fname) (TTerm term) = TTerm $ Terms.record _Field [-  Field _Field_name fname,-  Field _Field_term term]--encodedFloatValue :: TTerm FloatValue -> TTerm Term-encodedFloatValue = encodedLiteral . Core.literalFloat--encodedInjection :: Name -> Name -> TTerm Term -> TTerm Term-encodedInjection tname fname term = TTerm $ Terms.record _Injection [-  field _Injection_typeName $ encodedName tname,-  field _Injection_field $ encodedField fname term]--encodedInt32 :: TTerm Int -> TTerm Term-encodedInt32 v = encodedIntegerValue $ variant _IntegerValue _IntegerValue_int32 v--encodedIntegerValue :: TTerm IntegerValue -> TTerm Term-encodedIntegerValue = encodedLiteral . Core.literalInteger--encodedList :: TTerm [a] -> TTerm Term-encodedList = variant _Term _Term_list--encodedLiteral :: TTerm Literal -> TTerm Term-encodedLiteral = variant _Term _Term_literal--encodedMap :: TTerm (M.Map k v) -> TTerm Term-encodedMap = variant _Term _Term_map--encodedName :: Name -> TTerm Name-encodedName = wrap _Name . string . unName--encodedWrappedTerm :: Name -> TTerm Term -> TTerm Term-encodedWrappedTerm name = encodedWrappedTermRaw (encodedName name)--encodedWrappedTermRaw :: TTerm Name -> TTerm Term -> TTerm Term-encodedWrappedTermRaw (TTerm name) (TTerm term) = TTerm $ Terms.variant _Term _Term_wrap $ Terms.record _WrappedTerm [-  Field _WrappedTerm_typeName name,-  Field _WrappedTerm_object term]--encodedOptional :: TTerm (Maybe a) -> TTerm Term-encodedOptional = variant _Term _Term_optional--encodedRecord :: Name -> [Field] -> TTerm Term-encodedRecord tname fields = TTerm $ Terms.variant _Term _Term_record $ Terms.record _Record [-    field _Record_typeName $ encodedName tname,-    field _Record_fields $ list (encField <$> fields)]-  where-    encField (Field fname term) = encodedField fname $ TTerm term--encodedSet :: TTerm (S.Set a) -> TTerm Term-encodedSet = variant _Term _Term_set--encodedString :: TTerm String -> TTerm Term-encodedString = encodedLiteral . variant _Literal _Literal_string--encodedUnion :: TTerm Term -> TTerm Term-encodedUnion = variant _Term _Term_union--encodedVariant :: Name -> Name -> TTerm Term -> TTerm Term-encodedVariant tname fname term = encodedUnion $ encodedInjection tname fname term--coreEncodeAnnotatedTermDef :: TElement (AnnotatedTerm -> Term)-coreEncodeAnnotatedTermDef = coreEncodingDefinition "AnnotatedTerm" annotatedTermT $-  lambda "a" $ variant _Term _Term_annotated $ record _AnnotatedTerm [-    field _AnnotatedTerm_subject $ ref coreEncodeTermDef @@ (Core.annotatedTermSubject @@ var "a"),-    field _AnnotatedTerm_annotation $ Core.annotatedTermAnnotation @@ var "a"]--coreEncodeAnnotatedTypeDef :: TElement (AnnotatedType -> Term)-coreEncodeAnnotatedTypeDef = coreEncodingDefinition "AnnotatedType" annotatedTypeT $-  lambda "at" $ variant _Term _Term_annotated $ record _AnnotatedTerm [-    field _AnnotatedTerm_subject $ ref coreEncodeTypeDef @@ (Core.annotatedTypeSubject @@ var "at"),-    field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation @@ var "at"]--coreEncodeApplicationDef :: TElement (Application -> Term)-coreEncodeApplicationDef = coreEncodingDefinition "Application" applicationT $-  lambda "app" $ encodedRecord _Application [-    field _Application_function $ ref coreEncodeTermDef @@ (Core.applicationFunction @@ var "app"),-    field _Application_argument $ ref coreEncodeTermDef @@ (Core.applicationArgument @@ var "app")]--coreEncodeApplicationTypeDef :: TElement (ApplicationType -> Term)-coreEncodeApplicationTypeDef = coreEncodingDefinition "ApplicationType" applicationTypeT $-  lambda "at" $ encodedRecord _ApplicationType [-    field _ApplicationType_function $ ref coreEncodeTypeDef @@ (Core.applicationTypeFunction @@ var "at"),-    field _ApplicationType_argument $ ref coreEncodeTypeDef @@ (Core.applicationTypeArgument @@ var "at")]--coreEncodeCaseStatementDef :: TElement (CaseStatement -> Term)-coreEncodeCaseStatementDef = coreEncodingDefinition "CaseStatement" caseStatementT $-  lambda "cs" $ encodedRecord _CaseStatement [-    field _CaseStatement_typeName $ ref coreEncodeNameDef @@ (Core.caseStatementTypeName @@ var "cs"),-    field _CaseStatement_default $ encodedOptional-      (primitive _optionals_map @@ ref coreEncodeTermDef @@ (Core.caseStatementDefault @@ var "cs")),-    field _CaseStatement_cases $ encodedList-      (primitive _lists_map @@ ref coreEncodeFieldDef @@ (Core.caseStatementCases @@ var "cs"))]--coreEncodeEliminationDef :: TElement (Elimination -> Term)-coreEncodeEliminationDef = coreEncodingDefinition "Elimination" eliminationT $-    match _Elimination Nothing [-      ecase _Elimination_list coreEncodeTermDef,-      ecase _Elimination_optional coreEncodeOptionalCasesDef,-      ecase _Elimination_product coreEncodeTupleProjectionDef,-      ecase _Elimination_record coreEncodeProjectionDef,-      ecase _Elimination_union coreEncodeCaseStatementDef,-      ecase _Elimination_wrap coreEncodeNameDef]-  where-    ecase fname funname = encodedCase _Elimination fname (ref funname)--coreEncodeFieldDef :: TElement (Field -> Term)-coreEncodeFieldDef = coreEncodingDefinition "Field" fieldT $-  lambda "f" $ encodedRecord _Field [-    field _Field_name $ encodedWrappedTerm _Name $ encodedString $ (unwrap _Name @@ (Core.fieldName @@ var "f")),-    field _Field_term $ ref coreEncodeTermDef @@ (Core.fieldTerm @@ var "f")]--coreEncodeFieldTypeDef :: TElement (FieldType -> Term)-coreEncodeFieldTypeDef = coreEncodingDefinition "FieldType" fieldTypeT $-  lambda "ft" $ encodedRecord _FieldType [-    field _FieldType_name $ ref coreEncodeNameDef @@ (Core.fieldTypeName @@ var "ft"),-    field _FieldType_type $ ref coreEncodeTypeDef @@ (Core.fieldTypeType @@ var "ft")]--coreEncodeFloatTypeDef :: TElement (FloatType -> Term)-coreEncodeFloatTypeDef = coreEncodingDefinition "FloatType" floatTypeT $-    match _FloatType Nothing (cs <$> [-      _FloatType_bigfloat,-      _FloatType_float32,-      _FloatType_float64])-  where-    cs fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ unitVariant _FloatType fname--coreEncodeFloatValueDef :: TElement (FloatValue -> Term)-coreEncodeFloatValueDef = coreEncodingDefinition "FloatValue" floatValueT $-  match _FloatValue Nothing (varField <$> [-    _FloatValue_bigfloat,-    _FloatValue_float32,-    _FloatValue_float64])-  where-    varField fname = field fname $ lambda "v" $ encodedVariant _FloatValue fname $ encodedFloatValue $-      variant _FloatValue fname $ var "v"--coreEncodeFunctionDef :: TElement (Function -> Term)-coreEncodeFunctionDef = coreEncodingDefinition "Function" functionT $-    match _Function Nothing [-      ecase _Function_elimination coreEncodeEliminationDef,-      ecase _Function_lambda coreEncodeLambdaDef,-      ecase _Function_primitive coreEncodeNameDef]-  where-    ecase fname funname = encodedCase _Function fname (ref funname)--coreEncodeFunctionTypeDef :: TElement (FunctionType -> Term)-coreEncodeFunctionTypeDef = coreEncodingDefinition "FunctionType" functionTypeT $-  lambda "ft" $ encodedRecord _FunctionType [-    field _FunctionType_domain $ ref coreEncodeTypeDef @@ (Core.functionTypeDomain @@ var "ft"),-    field _FunctionType_codomain $ ref coreEncodeTypeDef @@ (Core.functionTypeCodomain @@ var "ft")]--coreEncodeInjectionDef :: TElement (Injection -> Term)-coreEncodeInjectionDef = coreEncodingDefinition "Injection" injectionT $-  lambda "i" $ encodedRecord _Injection [-    field _Injection_typeName $ ref coreEncodeNameDef @@ (Core.injectionTypeName @@ var "i"),-    field _Injection_field $ ref coreEncodeFieldDef @@ (Core.injectionField @@ var "i")]--coreEncodeIntegerTypeDef :: TElement (IntegerType -> Term)-coreEncodeIntegerTypeDef = coreEncodingDefinition "IntegerType" integerTypeT $-    match _IntegerType Nothing (cs <$> [-      _IntegerType_bigint,-      _IntegerType_int8,-      _IntegerType_int16,-      _IntegerType_int32,-      _IntegerType_int64,-      _IntegerType_uint8,-      _IntegerType_uint16,-      _IntegerType_uint32,-      _IntegerType_uint64])-  where-    cs fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ unitVariant _IntegerType fname--coreEncodeIntegerValueDef :: TElement (IntegerValue -> Term)-coreEncodeIntegerValueDef = coreEncodingDefinition "IntegerValue" integerValueT $-  match _IntegerValue Nothing (varField <$> [-    _IntegerValue_bigint,-    _IntegerValue_int8,-    _IntegerValue_int16,-    _IntegerValue_int32,-    _IntegerValue_int64,-    _IntegerValue_uint8,-    _IntegerValue_uint16,-    _IntegerValue_uint32,-    _IntegerValue_uint64])-  where-    varField fname = field fname $ lambda "v" $ encodedVariant _IntegerValue fname $ encodedIntegerValue $-      variant _IntegerValue fname $ var "v"--coreEncodeLambdaDef :: TElement (Lambda -> Term)-coreEncodeLambdaDef = coreEncodingDefinition "Lambda" lambdaT $-  lambda "l" $ encodedRecord _Lambda [-    field _Lambda_parameter $ ref coreEncodeNameDef @@ (Core.lambdaParameter @@ var "l"),-    field _Lambda_domain $ encodedOptional $ primitive _optionals_map @@ ref coreEncodeTypeDef @@ (Core.lambdaDomain @@ var "l"),-    field _Lambda_body $ ref coreEncodeTermDef @@ (Core.lambdaBody @@ var "l")]--coreEncodeLambdaTypeDef :: TElement (LambdaType -> Term)-coreEncodeLambdaTypeDef = coreEncodingDefinition "LambdaType" lambdaTypeT $-  lambda "lt" $ encodedRecord _LambdaType [-    field _LambdaType_parameter $ ref coreEncodeNameDef @@ (Core.lambdaTypeParameter @@ var "lt"),-    field _LambdaType_body $ ref coreEncodeTypeDef @@ (Core.lambdaTypeBody @@ var "lt")]--coreEncodeLetDef :: TElement (Let -> Term)-coreEncodeLetDef = coreEncodingDefinition "Let" letT $-  lambda "l" $ encodedRecord _Let [-    field _Let_bindings $ encodedList (primitive _lists_map @@ ref coreEncodeLetBindingDef @@ (Core.letBindings @@ var "l")),-    field _Let_environment $ ref coreEncodeTermDef @@ (Core.letEnvironment @@ var "l")]--coreEncodeLetBindingDef :: TElement (LetBinding -> Term)-coreEncodeLetBindingDef = coreEncodingDefinition "LetBinding" letBindingT $-  lambda "b" $ encodedRecord _LetBinding [-    field _LetBinding_name $ ref coreEncodeNameDef @@ (Core.letBindingName @@ var "b"),-    field _LetBinding_term $ ref coreEncodeTermDef @@ (Core.letBindingTerm @@ var "b"),-    field _LetBinding_type $ encodedOptional $ primitive _optionals_map @@ ref coreEncodeTypeSchemeDef @@ (Core.letBindingType @@ var "b")]--coreEncodeLiteralDef :: TElement (Literal -> Term)-coreEncodeLiteralDef = coreEncodingDefinition "Literal" literalT $-  match _Literal Nothing [-    varField _Literal_binary $ encodedBinary $ var "v",-    varField _Literal_boolean $ encodedBoolean $ var "v",-    varField _Literal_float (ref coreEncodeFloatValueDef @@ var "v"),-    varField _Literal_integer (ref coreEncodeIntegerValueDef @@ var "v"),-    varField _Literal_string $ encodedString $ var "v"]-  where-    varField fname = field fname . lambda "v" . encodedVariant _Literal fname--coreEncodeLiteralTypeDef :: TElement (LiteralType -> Term)-coreEncodeLiteralTypeDef = coreEncodingDefinition "LiteralType" literalTypeT $-  match _LiteralType Nothing [-    csunit _LiteralType_binary,-    csunit _LiteralType_boolean,-    cs _LiteralType_float coreEncodeFloatTypeDef,-    cs _LiteralType_integer coreEncodeIntegerTypeDef,-    csunit _LiteralType_string]-  where-    cs fname fun = field fname $ lambda "v" $ encodedVariant _LiteralType fname (ref fun @@ var "v")-    csunit fname = field fname $ constant $ TTerm $ coreEncodeTerm $ unTTerm $ variant _LiteralType fname unit--coreEncodeMapTypeDef :: TElement (MapType -> Term)-coreEncodeMapTypeDef = coreEncodingDefinition "MapType" mapTypeT $-    lambda "mt" $ encodedRecord _MapType [-      field _MapType_keys $ ref coreEncodeTypeDef @@ (Core.mapTypeKeys @@ var "mt"),-      field _MapType_values $ ref coreEncodeTypeDef @@ (Core.mapTypeValues @@ var "mt")]--coreEncodeNameDef :: TElement (Name -> Term)-coreEncodeNameDef = coreEncodingDefinition "Name" nameT $-  lambda "fn" $ encodedWrappedTerm _Name $ encodedString $ unwrap _Name @@ var "fn"--coreEncodeOptionalCasesDef :: TElement (OptionalCases -> Term)-coreEncodeOptionalCasesDef = coreEncodingDefinition "OptionalCases" optionalCasesT $-  lambda "oc" $ encodedRecord _OptionalCases [-    field _OptionalCases_nothing $ ref coreEncodeTermDef @@ (Core.optionalCasesNothing @@ var "oc"),-    field _OptionalCases_just $ ref coreEncodeTermDef @@ (Core.optionalCasesJust @@ var "oc")]--coreEncodeProjectionDef :: TElement (Projection -> Term)-coreEncodeProjectionDef = coreEncodingDefinition "Projection" projectionT $-  lambda "p" $ encodedRecord _Projection [-    field _Projection_typeName $ ref coreEncodeNameDef @@ (Core.projectionTypeName @@ var "p"),-    field _Projection_field $ ref coreEncodeNameDef @@ (Core.projectionField @@ var "p")]--coreEncodeRecordDef :: TElement (Record -> Term)-coreEncodeRecordDef = coreEncodingDefinition "Record" recordT $-  lambda "r" $ encodedRecord _Record [-    field _Record_typeName $ ref coreEncodeNameDef @@ (Core.recordTypeName @@ var "r"),-    field _Record_fields $ encodedList (primitive _lists_map @@ (ref coreEncodeFieldDef) @@ (Core.recordFields @@ var "r"))]--coreEncodeRowTypeDef :: TElement (RowType -> Term)-coreEncodeRowTypeDef = coreEncodingDefinition "RowType" rowTypeT $-  lambda "rt" $ encodedRecord _RowType [-    field _RowType_typeName $ ref coreEncodeNameDef @@ (Core.rowTypeTypeName @@ var "rt"),-    field _RowType_fields $ encodedList (primitive _lists_map @@ ref coreEncodeFieldTypeDef @@ (Core.rowTypeFields @@ var "rt"))]--coreEncodeSumDef :: TElement (Sum -> Term)-coreEncodeSumDef = coreEncodingDefinition "Sum" sumT $-  lambda "s" $ encodedRecord _Sum [-    field _Sum_index $ encodedInt32 $ Core.sumIndex @@ var "s",-    field _Sum_size $ encodedInt32 $ Core.sumSize @@ var "s",-    field _Sum_term $ ref coreEncodeTermDef @@ (Core.sumTerm @@ var "s")]--coreEncodeTermDef :: TElement (Term -> Term)-coreEncodeTermDef = coreEncodingDefinition "Term" termT $-  match _Term (Just $ encodedString $ string "not implemented") [-    ecase _Term_annotated (ref coreEncodeAnnotatedTermDef),-    ecase _Term_application (ref coreEncodeApplicationDef),-    ecase _Term_function (ref coreEncodeFunctionDef),-    ecase _Term_let (ref coreEncodeLetDef),-    ecase _Term_literal (ref coreEncodeLiteralDef),-    ecase' _Term_list $ encodedList $ primitive _lists_map @@ (ref coreEncodeTermDef) @@ var "v",---     -- TODO: map encoding---     ecase' _Term_map $ encodedMap-    ecase' _Term_optional $ encodedOptional (primitive _optionals_map @@ ref coreEncodeTermDef @@ var "v"),-    ecase' _Term_product $ encodedList (primitive _lists_map @@ ref coreEncodeTermDef @@ var "v"),-    ecase _Term_record (ref coreEncodeRecordDef),-    ecase' _Term_set $ encodedSet $ primitive _sets_map @@ (ref coreEncodeTermDef) @@ var "v",-    ecase _Term_sum (ref coreEncodeSumDef),-    ecase _Term_typeAbstraction $ ref coreEncodeTypeAbstractionDef,-    ecase _Term_typeApplication $ ref coreEncodeTypedTermDef,-    ecase _Term_typed $ ref coreEncodeTypedTermDef,-    ecase _Term_union (ref coreEncodeInjectionDef),-    ecase _Term_variable $ ref coreEncodeNameDef,-    ecase _Term_wrap $ ref coreEncodeWrappedTermDef]-  where-    ecase = encodedCase _Term-    ecase' fname = field fname . lambda "v" . encodedVariant _Term fname--coreEncodeTupleProjectionDef :: TElement (TupleProjection -> Term)-coreEncodeTupleProjectionDef = coreEncodingDefinition "TupleProjection" tupleProjectionT $-  lambda "tp" $ encodedRecord _TupleProjection [-    field _TupleProjection_arity $ encodedInt32 $ Core.tupleProjectionArity @@ var "tp",-    field _TupleProjection_index $ encodedInt32 $ Core.tupleProjectionIndex @@ var "tp"]--coreEncodeTypeDef :: TElement (Type -> Term)-coreEncodeTypeDef = coreEncodingDefinition "Type" typeT $-  match _Type Nothing [-    field _Type_annotated $ lambda "v" $ variant _Term _Term_annotated $ record _AnnotatedTerm [-      field _AnnotatedTerm_subject $ ref coreEncodeTypeDef @@ (Core.annotatedTypeSubject @@ var "v"),-      field _AnnotatedTerm_annotation $ Core.annotatedTypeAnnotation @@ var "v"],-    csref _Type_application coreEncodeApplicationTypeDef,-    csref _Type_function coreEncodeFunctionTypeDef,-    csref _Type_lambda coreEncodeLambdaTypeDef,-    csref _Type_list coreEncodeTypeDef,-    csref _Type_literal coreEncodeLiteralTypeDef,-    csref _Type_map coreEncodeMapTypeDef,-    csref _Type_optional coreEncodeTypeDef,-    cs _Type_product $ encodedList $ primitive _lists_map @@ ref coreEncodeTypeDef @@ var "v",-    csref _Type_record coreEncodeRowTypeDef,-    csref _Type_set coreEncodeTypeDef,-    cs _Type_sum $ encodedList $ primitive _lists_map @@ ref coreEncodeTypeDef @@ var "v",-    csref _Type_union coreEncodeRowTypeDef,-    csref _Type_variable coreEncodeNameDef,-    csref _Type_wrap coreEncodeWrappedTypeDef]-  where-    cs fname term = field fname $ lambda "v" $ encodedVariant _Type fname term-    csref fname fun = cs fname (ref fun @@ var "v")--coreEncodeTypeAbstractionDef :: TElement (TypeAbstraction -> Term)-coreEncodeTypeAbstractionDef = coreEncodingDefinition "TypeAbstraction" typeAbstractionT $-  lambda "l" $ encodedRecord _TypeAbstraction [-    field _TypeAbstraction_parameter $ ref coreEncodeNameDef @@ (project _TypeAbstraction _TypeAbstraction_parameter @@ var "l"),-    field _TypeAbstraction_body $ ref coreEncodeTermDef @@ (project _TypeAbstraction _TypeAbstraction_body @@ var "l")]--coreEncodeTypeSchemeDef :: TElement (TypeScheme -> Term)-coreEncodeTypeSchemeDef = coreEncodingDefinition "TypeScheme" typeSchemeT $-  lambda "ts" $ encodedRecord _TypeScheme [-    field _TypeScheme_variables $ encodedList (primitive _lists_map @@ ref coreEncodeNameDef @@ (Core.typeSchemeVariables @@ var "ts")),-    field _TypeScheme_type $ ref coreEncodeTypeDef @@ (Core.typeSchemeType @@ var "ts")]--coreEncodeTypedTermDef :: TElement (TypedTerm -> Term)-coreEncodeTypedTermDef = coreEncodingDefinition "TypedTerm" typedTermT $-  lambda "tt" $ encodedRecord _TypedTerm [-    field _TypedTerm_term $ ref coreEncodeTermDef @@ (project _TypedTerm _TypedTerm_term @@ var "tt"),-    field _TypedTerm_type $ ref coreEncodeTypeDef @@ (project _TypedTerm _TypedTerm_type @@ var "tt")]--coreEncodeWrappedTermDef :: TElement (WrappedTerm -> Term)-coreEncodeWrappedTermDef = coreEncodingDefinition "WrappedTerm" wrappedTermT $-  lambda "n" $ encodedRecord _WrappedTerm [-    field _WrappedTerm_typeName $ ref coreEncodeNameDef @@ (Core.wrappedTermTypeName @@ var "n"),-    field _WrappedTerm_object $ ref coreEncodeTermDef @@ (Core.wrappedTermObject @@ var "n")]--coreEncodeWrappedTypeDef :: TElement (WrappedType -> Term)-coreEncodeWrappedTypeDef = coreEncodingDefinition "WrappedType" wrappedTypeT $-  lambda "nt" $ encodedRecord _WrappedType [-    field _WrappedType_typeName $ ref coreEncodeNameDef @@ (Core.wrappedTypeTypeName @@ var "nt"),-    field _WrappedType_object $ ref coreEncodeTypeDef @@ (Core.wrappedTypeObject @@ var "nt")]
− src/main/haskell/Hydra/Sources/Tier1/Decode.hs 
@@ -1,419 +0,0 @@-module Hydra.Sources.Tier1.Decode where---- Standard Tier-1 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier0.All--import Hydra.Sources.Tier1.Strip--import qualified Data.Map as M-import qualified Data.Set as S---decodeDefinition :: String -> TTerm a -> TElement a-decodeDefinition = definitionInModule decodeModule--decodeFunctionDefinition :: String -> Type -> Type -> TTerm a -> TElement a-decodeFunctionDefinition name dom cod term = decodeDefinition name $-  function dom (optionalT cod) term--decodeNominalFunctionDefinition :: String -> Type -> TTerm a -> TElement a-decodeNominalFunctionDefinition name cod term = decodeDefinition name $-  function nameT (funT termT $ optionalT cod) term--decodeModule :: Module-decodeModule = Module (Namespace "hydra/decode") elements [hydraStripModule] tier0Modules $-    Just "A module for decoding terms to native objects"-  where-   elements = [-    el bigfloatDef,-    el bigfloatValueDef,-    el bigintDef,-    el bigintValueDef,-    el binaryDef,-    el binaryLiteralDef,-    el booleanDef,-    el booleanLiteralDef,-    el casesCaseDef,-    el casesDef,-    el fieldDef,-    el float32Def,-    el float32ValueDef,-    el float64Def,-    el float64ValueDef,-    el floatLiteralDef,-    el int16Def,-    el int16ValueDef,-    el int32Def,-    el int32ValueDef,-    el int64Def,-    el int64ValueDef,-    el int8Def,-    el int8ValueDef,-    el integerLiteralDef,-    el lambdaDef,-    el letBindingDef,-    el letBindingWithKeyDef,-    el letTermDef,-    el listDef,-    el literalDef,-    el mapDef,-    el nameDef,-    el nominalDef,-    el optCasesDef,-    el optCasesJustDef,-    el optCasesNothingDef,-    el optionalDef,-    el pairDef,-    el recordDef,-    el setDef,-    el stringDef,-    el stringLiteralDef,-    el uint16Def,-    el uint16ValueDef,-    el uint32Def,-    el uint32ValueDef,-    el uint64Def,-    el uint64ValueDef,-    el uint8Def,-    el uint8ValueDef,-    el unitDef,-    el unitVariantDef,-    el variableDef,-    el variantDef,-    el wrapDef]--bigfloatDef :: TElement (Term -> Maybe Float)-bigfloatDef = decodeFunctionDefinition "bigfloat" termT bigfloatT $-  compose3 (ref literalDef) (ref floatLiteralDef) (ref bigfloatValueDef)--bigfloatValueDef :: TElement (FloatValue -> Maybe Float)-bigfloatValueDef = decodeFunctionDefinition "bigfloatValue" floatValueT bigfloatT $-  matchVariant _FloatValue _FloatValue_bigfloat--bigintDef :: TElement (Term -> Maybe Int)-bigintDef = decodeFunctionDefinition "bigint" termT bigintT $-  compose3 (ref literalDef) (ref integerLiteralDef) (ref bigintValueDef)--bigintValueDef :: TElement (IntegerValue -> Maybe Int)-bigintValueDef = decodeFunctionDefinition "bigintValue" integerValueT bigintT $-  matchVariant _IntegerValue _IntegerValue_bigint--binaryDef :: TElement (Term -> Maybe String)-binaryDef = decodeFunctionDefinition "binary" termT binaryT $-  compose2 (ref literalDef) (ref binaryLiteralDef)--binaryLiteralDef :: TElement (Literal -> Maybe String)-binaryLiteralDef = decodeFunctionDefinition "binaryLiteral" literalT binaryT $-  matchVariant _Literal _Literal_binary--booleanDef :: TElement (Term -> Maybe Bool)-booleanDef = decodeFunctionDefinition "boolean" termT booleanT $-  compose2 (ref literalDef) (ref booleanLiteralDef)--booleanLiteralDef :: TElement (Literal -> Maybe Bool)-booleanLiteralDef = decodeFunctionDefinition "booleanLiteral" literalT booleanT $-  matchVariant _Literal _Literal_boolean--casesDef :: TElement (Name -> Term -> Maybe [Field])-casesDef = decodeNominalFunctionDefinition "cases" (listT fieldT) $-  ref nominalDef-    @@ Core.caseStatementTypeName-    @@ Core.caseStatementCases-    @@ compose3-      (matchTermVariant _Term_function)-      (matchVariant _Function _Function_elimination)-      (matchVariant _Elimination _Elimination_union)--casesCaseDef :: TElement (Name -> Name -> Term -> Y.Maybe Term)-casesCaseDef = decodeDefinition "casesCase" $- functionN [nameT, nameT, termT, optionalT termT] $- lambda "tname" $ lambda "fname" $-   compose2-     (ref casesDef @@ var "tname" )-     (ref fieldDef @@ var "fname")--fieldDef :: TElement (Name -> [Field] -> Maybe Term)-fieldDef = decodeDefinition "field" $-  functionN [nameT, listT fieldT, optionalT termT] $-  lambda "fname" $ lambda "fields" ((Logic.ifElse-        @@ just (Core.fieldTerm @@ (Lists.head @@ var "matches"))-        @@ nothing-        @@ (Equality.equal @@ int32 1 @@ (Lists.length @@ var "matches"))-    ) `with` [-      "matches">: Lists.filter @@ (lambda "f" $ Equality.equal @@ (Core.fieldName @@ var "f") @@ var "fname") @@ var "fields"])--float32Def :: TElement (Term -> Maybe Float)-float32Def = decodeFunctionDefinition "float32" termT float32T $-  compose3-    (ref literalDef)-    (ref floatLiteralDef)-    (ref float32ValueDef)--float32ValueDef :: TElement (FloatValue -> Maybe Float)-float32ValueDef = decodeFunctionDefinition "float32Value" floatValueT float32T $-  matchVariant _FloatValue _FloatValue_float32--float64Def :: TElement (Term -> Maybe Float)-float64Def = decodeFunctionDefinition "float64" termT float64T $-  compose3-    (ref literalDef)-    (ref floatLiteralDef)-    (ref float64ValueDef)--float64ValueDef :: TElement (FloatValue -> Maybe Float)-float64ValueDef = decodeFunctionDefinition "float64Value" floatValueT float64T $-  matchVariant _FloatValue _FloatValue_float64--floatLiteralDef = decodeFunctionDefinition "floatLiteral" literalT floatValueT $-  matchVariant _Literal _Literal_float--int8Def :: TElement (Term -> Maybe Int)-int8Def = decodeFunctionDefinition "int8" termT int8T $-  compose3-    (ref literalDef)-    (ref integerLiteralDef)-    (ref int8ValueDef)--int8ValueDef :: TElement (IntegerValue -> Maybe Int)-int8ValueDef = decodeFunctionDefinition "int8Value" integerValueT int8T $-  matchVariant _IntegerValue _IntegerValue_int8--int16Def :: TElement (Term -> Maybe Int)-int16Def = decodeFunctionDefinition "int16" termT int16T $-  compose3-    (ref literalDef)-    (ref integerLiteralDef)-    (ref int16ValueDef)--int16ValueDef :: TElement (IntegerValue -> Maybe Int)-int16ValueDef = decodeFunctionDefinition "int16Value" integerValueT int16T $-  matchVariant _IntegerValue _IntegerValue_int16--int32Def :: TElement (Term -> Maybe Int)-int32Def = decodeFunctionDefinition "int32" termT int32T $-  compose3-    (ref literalDef)-    (ref integerLiteralDef)-    (ref int32ValueDef)--int32ValueDef :: TElement (IntegerValue -> Maybe Int)-int32ValueDef = decodeFunctionDefinition "int32Value" integerValueT int32T $-  matchVariant _IntegerValue _IntegerValue_int32--int64Def :: TElement (Term -> Maybe Int)-int64Def = decodeFunctionDefinition "int64" termT int64T $-  compose3-    (ref literalDef)-    (ref integerLiteralDef)-    (ref int64ValueDef)--int64ValueDef :: TElement (IntegerValue -> Maybe Int)-int64ValueDef = decodeFunctionDefinition "int64Value" integerValueT int64T $-  matchVariant _IntegerValue _IntegerValue_int64--integerLiteralDef :: TElement (Literal -> Maybe IntegerValue)-integerLiteralDef = decodeFunctionDefinition "integerLiteral" literalT integerValueT $-  matchVariant _Literal _Literal_integer--lambdaDef :: TElement (Term -> Maybe Lambda)-lambdaDef = decodeFunctionDefinition "lambda" termT lambdaT $-  compose2-    (matchTermVariant _Term_function)-    (matchVariant _Function _Function_lambda)--letBindingDef :: TElement (Name -> Term -> Maybe LetBinding)-letBindingDef = decodeDefinition "letBinding" $-  functionN [nameT, termT, optionalT letBindingT] $-  lambda "fname" $ lambda "term" $ Optionals.bind-    @@ (Optionals.map-      @@ Core.letBindings-      @@ (ref letTermDef @@ var "term"))-    @@ (ref letBindingWithKeyDef @@ var "fname")--letBindingWithKeyDef :: TElement (Name -> [LetBinding] -> Maybe LetBinding)-letBindingWithKeyDef = decodeDefinition "letBindingWithKey" $-  functionN [nameT, listT letBindingT, optionalT letBindingT] $-  lambda "fname" $ lambda "bindings" ((Logic.ifElse-        @@ just (Lists.head @@ var "matches")-        @@ nothing-        @@ (Equality.equal @@ int32 1 @@ (Lists.length @@ var "matches"))-    ) `with` [-      "matches">: Lists.filter @@ (lambda "b" $ Equality.equal @@ (Core.letBindingName @@ var "b") @@ var "fname") @@ var "bindings"])--letTermDef :: TElement (Term -> Maybe Let)-letTermDef = decodeFunctionDefinition "letTerm" termT letT $-  matchTermVariant _Term_let--listDef :: TElement (Term -> Maybe [Term])-listDef = decodeFunctionDefinition "list" termT (listT termT) $-  matchTermVariant _Term_list--literalDef :: TElement (Term -> Maybe Literal)-literalDef = decodeFunctionDefinition "literal" termT literalT $-  matchTermVariant _Term_literal--mapDef :: TElement (Term -> Maybe (M.Map Term Term))-mapDef = decodeFunctionDefinition "map" termT (mapT termT termT) $-  matchTermVariant _Term_map--nameDef :: TElement (Term -> Name)-nameDef = decodeFunctionDefinition "name" termT nameT $-  lambda "term" $ Optionals.map-    @@ nm-    @@ (Optionals.bind-      @@ (ref wrapDef @@ Core.name _Name @@ var "term")-      @@ ref stringDef)-  where-    nm :: TTerm (String -> Name)-    nm = TTerm $ Terms.lambda "s" $ TermWrap $ WrappedTerm _Name $ Terms.var "s"--nominalDef :: TElement ((a -> Name) -> (a -> b) -> (c -> Maybe a) -> Name -> c -> Maybe b)-nominalDef = decodeDefinition "nominal" $-    functionN [funT aT nameT, funT aT bT, funT cT (optionalT aT), nameT, cT, optionalT bT] $-    lambda "getName" $ lambda "getB" $ lambda "getA" $ lambda "expected" $-    compose2-      (var "getA")-      (lambda "a" $ (Logic.ifElse-        @@ (just (var "getB" @@ var "a"))-        @@ nothing-        @@ (Equality.equal @@ (var "getName" @@ var "a") @@ var "expected")))--optCasesDef :: TElement (Term -> Maybe OptionalCases)-optCasesDef = decodeFunctionDefinition "optCases" termT optionalCasesT $-  compose3-    (matchTermVariant _Term_function)-    (matchVariant _Function _Function_elimination)-    (matchVariant _Elimination _Elimination_optional)--optCasesJustDef :: TElement (Term -> Maybe Term)-optCasesJustDef = decodeFunctionDefinition "optCasesJust" termT termT $-  lambda "term" $ Optionals.map @@ Core.optionalCasesJust @@ (ref optCasesDef @@ var "term")--optCasesNothingDef :: TElement (Term -> Maybe Term)-optCasesNothingDef = decodeFunctionDefinition "optCasesNothing" termT termT $-  lambda "term" $ Optionals.map @@ Core.optionalCasesNothing @@ (ref optCasesDef @@ var "term")--optionalDef :: TElement (Term -> Maybe (Maybe Term))-optionalDef = decodeFunctionDefinition "optional" termT (optionalT termT) $-  matchTermVariant _Term_optional--pairDef :: TElement (Term -> Maybe (Term, Term))-pairDef = decodeFunctionDefinition "pair" termT (pairT termT termT) $-  compose2-    (matchTermVariant _Term_product)-    (lambda "l" $ Logic.ifElse-      @@ (just $ pair (Lists.at @@ int32 0 @@ var "l") (Lists.at @@ int32 1 @@ var "l"))-      @@ nothing-      @@ (Equality.equal @@ int32 2 @@ (Lists.length @@ var "l")))--recordDef :: TElement (Name -> Term -> Maybe [Field])-recordDef = decodeNominalFunctionDefinition "record" (listT fieldT) $-  matchNominal _Term_record Core.recordTypeName Core.recordFields--setDef :: TElement (Term -> Maybe (S.Set Term))-setDef = decodeFunctionDefinition "set" termT (setT termT) $-  matchTermVariant _Term_set--stringDef :: TElement (Term -> Maybe String)-stringDef = decodeFunctionDefinition "string" termT stringT $-  compose2 (ref literalDef) (ref stringLiteralDef)--stringLiteralDef :: TElement (Literal -> Maybe String)-stringLiteralDef = decodeFunctionDefinition "stringLiteral" literalT stringT $-  matchVariant _Literal _Literal_string--uint8Def :: TElement (Term -> Maybe Int)-uint8Def = decodeFunctionDefinition "uint8" termT uint8T $-  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint8ValueDef)--uint8ValueDef :: TElement (IntegerValue -> Maybe Int)-uint8ValueDef = decodeFunctionDefinition "uint8Value" integerValueT uint8T $-  matchVariant _IntegerValue _IntegerValue_uint8--uint16Def :: TElement (Term -> Maybe Int)-uint16Def = decodeFunctionDefinition "uint16" termT uint16T $-  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint16ValueDef)--uint16ValueDef :: TElement (IntegerValue -> Maybe Int)-uint16ValueDef = decodeFunctionDefinition "uint16Value" integerValueT uint16T $-  matchVariant _IntegerValue _IntegerValue_uint16--uint32Def :: TElement (Term -> Maybe Int)-uint32Def = decodeFunctionDefinition "uint32" termT uint32T $-  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint32ValueDef)--uint32ValueDef :: TElement (IntegerValue -> Maybe Int)-uint32ValueDef = decodeFunctionDefinition "uint32Value" integerValueT uint32T $-  matchVariant _IntegerValue _IntegerValue_uint32--uint64Def :: TElement (Term -> Maybe Int)-uint64Def = decodeFunctionDefinition "uint64" termT uint64T $-  compose3 (ref literalDef) (ref integerLiteralDef) (ref uint64ValueDef)--uint64ValueDef :: TElement (IntegerValue -> Maybe Int)-uint64ValueDef = decodeFunctionDefinition "uint64Value" integerValueT uint64T $-  matchVariant _IntegerValue _IntegerValue_uint64--unitDef :: TElement (Term -> Maybe ())-unitDef = decodeFunctionDefinition "unit" termT unitT $-  lambda "term" $ Optionals.map-    @@ (constant unit)-    @@ (ref recordDef @@ Core.name _Unit @@ var "term")--unitVariantDef :: TElement (Name -> Term -> Maybe Name)-unitVariantDef = decodeDefinition "unitVariant" $-  functionN [nameT, termT, optionalT nameT] $-  lambda "tname" $ lambda "term" $ Optionals.map-    @@ Core.fieldName-    @@ (ref variantDef @@ var "tname" @@ var "term")--variableDef :: TElement (Term -> Y.Maybe Name)-variableDef = decodeFunctionDefinition "variable" termT nameT $-  matchTermVariant _Term_variable <.> ref fullyStripTermDef--variantDef :: TElement (Name -> Term -> Maybe Field)-variantDef = decodeNominalFunctionDefinition "variant" fieldT $-  matchNominal _Term_union Core.injectionTypeName Core.injectionField--wrapDef :: TElement (Name -> Term -> Maybe Term)-wrapDef = decodeNominalFunctionDefinition "wrap" termT $-  matchNominal _Term_wrap Core.wrappedTermTypeName Core.wrappedTermObject------compose2 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (a -> Maybe c)-compose2 f g = Optionals.compose @@ f @@ g--compose3 :: TTerm (a -> Maybe b) -> TTerm (b -> Maybe c) -> TTerm (c -> Maybe d) -> TTerm (a -> Maybe d)-compose3 f g h = Optionals.compose @@ (Optionals.compose @@ f @@ g) @@ h--matchNominal :: Name -> TTerm (a -> Name) -> TTerm (a -> b) -> TTerm (Name -> Term -> Maybe b)-matchNominal fname getName getB = ref nominalDef @@ getName @@ getB @@ matchTermVariant fname--matchTermVariant :: Name -> TTerm (Term -> Maybe a)-matchTermVariant fname = matchVariant _Term fname <.> ref fullyStripTermDef--matchVariant :: Name -> Name -> TTerm (a -> Maybe b)-matchVariant tname fname = match tname (Just nothing) [TCase fname --> Optionals.pure]
− src/main/haskell/Hydra/Sources/Tier1/Messages.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier1.Messages where---- Standard Tier-1 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier0.All---messagesDefinition :: String -> TTerm a -> TElement a-messagesDefinition = definitionInModule hydraMessagesModule--hydraMessagesModule :: Module-hydraMessagesModule = Module (Namespace "hydra/messages") elements [] tier0Modules $-    Just "A collection of standard error and warning messages"-  where-   elements = [-     el warningAutoGeneratedFileDef]--warningAutoGeneratedFileDef :: TElement String-warningAutoGeneratedFileDef = messagesDefinition "warningAutoGeneratedFile" $-  string "Note: this is an automatically generated file. Do not edit."
− src/main/haskell/Hydra/Sources/Tier1/Strip.hs 
@@ -1,73 +0,0 @@-module Hydra.Sources.Tier1.Strip where---- Standard Tier-1 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier0.All---stripDefinition :: String -> TTerm a -> TElement a-stripDefinition = definitionInModule hydraStripModule--hydraStripModule :: Module-hydraStripModule = Module (Namespace "hydra/strip") elements [] tier0Modules $-    Just "Several functions for stripping annotations from types and terms."-  where-   elements = [-     el fullyStripTermDef,-     el stripTermDef,-     el stripTypeDef,-     el stripTypeParametersDef]--fullyStripTermDef :: TElement (Term -> Term)-fullyStripTermDef = stripDefinition "fullyStripTerm" $-    doc "Strip all annotations from a term, including first-class type annotations" $-    function termT termT $-      lambda "t" (match _Term (Just $ var "t") [-        TCase _Term_annotated --> ref fullyStripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject),-        TCase _Term_typed --> ref fullyStripTermDef <.> (project _TypedTerm _TypedTerm_term)-        ] @@ (var "t"))--stripTermDef :: TElement (Term -> Term)-stripTermDef = stripDefinition "stripTerm" $-    doc "Strip all annotations from a term" $-    function termT termT $-      lambda "t" (match _Term (Just $ var "t") [-        TCase _Term_annotated --> ref stripTermDef <.> (project _AnnotatedTerm _AnnotatedTerm_subject)-        ] @@ (var "t"))--stripTypeDef :: TElement (Type -> Type)-stripTypeDef = stripDefinition "stripType" $-    doc "Strip all annotations from a term" $-    function typeT typeT $-      lambda "t" (match _Type (Just $ var "t") [-        TCase _Type_annotated --> ref stripTypeDef <.> (project _AnnotatedType _AnnotatedType_subject)-        ] @@ (var "t"))--stripTypeParametersDef :: TElement (Type -> Type)-stripTypeParametersDef = stripDefinition "stripTypeParameters" $-    doc "Strip any top-level type lambdas from a type, extracting the (possibly nested) type body" $-    function typeT typeT $-      lambda "t" $ match _Type (Just $ var "t") [-        TCase _Type_lambda --> lambda "lt" (ref stripTypeParametersDef @@ (project _LambdaType _LambdaType_body @@ var "lt"))-        ] @@ (ref stripTypeDef @@ var "t")
− src/main/haskell/Hydra/Sources/Tier1/Tier1.hs 
@@ -1,439 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier1.Tier1 where---- Standard Tier-1 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier0.All--import Hydra.Sources.Tier1.Constants-import Hydra.Sources.Tier1.Strip-import Hydra.Dsl.Mantle---tier1Definition :: String -> TTerm a -> TElement a-tier1Definition = definitionInModule hydraTier1Module--hydraTier1Module :: Module-hydraTier1Module = Module (Namespace "hydra/tier1") elements-    [hydraComputeModule, hydraConstantsModule, hydraStripModule] tier0Modules $-    Just ("A module for miscellaneous tier-1 functions and constants.")-  where-   elements = [-     el floatValueToBigfloatDef,-     el integerValueToBigintDef,-     el isLambdaDef,-     el unqualifyNameDef,-     -- Rewriting.hs-     el foldOverTermDef,-     el foldOverTypeDef,-     el freeVariablesInTermDef,-     el freeVariablesInTypeDef,-     el subtermsDef,-     el subtermsWithAccessorsDef,-     el subtypesDef,-     -- Flows.hs-     el emptyTraceDef,-     el flowSucceedsDef,-     el fromFlowDef,-     el mutateTraceDef,-     el pushErrorDef,-     el warnDef,-     el withFlagDef,-     el withStateDef,-     el withTraceDef-     ]--floatValueToBigfloatDef :: TElement (Double -> Double)-floatValueToBigfloatDef = tier1Definition "floatValueToBigfloat" $-  doc "Convert a floating-point value of any precision to a bigfloat" $-  function floatValueT Types.bigfloat $-  match _FloatValue Nothing [-    _FloatValue_bigfloat>>: Equality.identity,-    _FloatValue_float32>>: Literals.float32ToBigfloat,-    _FloatValue_float64>>: Literals.float64ToBigfloat]--integerValueToBigintDef :: TElement (IntegerValue -> Integer)-integerValueToBigintDef = tier1Definition "integerValueToBigint" $-  doc "Convert an integer value of any precision to a bigint" $-  function integerValueT Types.bigint $-  match _IntegerValue Nothing [-    _IntegerValue_bigint>>: Equality.identity,-    _IntegerValue_int8>>: Literals.int8ToBigint,-    _IntegerValue_int16>>: Literals.int16ToBigint,-    _IntegerValue_int32>>: Literals.int32ToBigint,-    _IntegerValue_int64>>: Literals.int64ToBigint,-    _IntegerValue_uint8>>: Literals.uint8ToBigint,-    _IntegerValue_uint16>>: Literals.uint16ToBigint,-    _IntegerValue_uint32>>: Literals.uint32ToBigint,-    _IntegerValue_uint64>>: Literals.uint64ToBigint]--isLambdaDef :: TElement (Term -> Bool)-isLambdaDef = tier1Definition "isLambda" $-  doc "Check whether a term is a lambda, possibly nested within let and/or annotation terms" $-  function termT Types.boolean $-  lambda "term" $ (match _Term (Just false) [-      _Term_function>>: match _Function (Just false) [-        _Function_lambda>>: constant true],-      _Term_let>>: lambda "lt" (ref isLambdaDef @@ (project _Let _Let_environment @@ var "lt"))])-    @@ (ref fullyStripTermDef @@ var "term")---- Rewriting.hs--foldOverTermDef :: TElement (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x)-foldOverTermDef = tier1Definition "foldOverTerm" $-  doc "Fold over a term, traversing its subterms in the specified order" $-  functionN [TypeVariable _TraversalOrder, funT xT (funT termT xT), xT, termT, xT] $-  lambda "order" $ lambda "fld" $ lambda "b0" $ lambda "term" $ (match _TraversalOrder Nothing [-    _TraversalOrder_pre>>: constant (Base.fold (ref foldOverTermDef @@ var "order" @@ var "fld")-      @@ (var "fld" @@ var "b0" @@ var "term")-      @@ (ref subtermsDef @@ var "term")),-    _TraversalOrder_post>>: constant (var "fld"-      @@ (Base.fold (ref foldOverTermDef @@ var "order" @@ var "fld")-        @@ (var "b0")-        @@ (ref subtermsDef @@ var "term"))-      @@ var "term")] @@ var "order")--foldOverTypeDef :: TElement (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x)-foldOverTypeDef = tier1Definition "foldOverType" $-  doc "Fold over a type, traversing its subtypes in the specified order" $-  functionN [TypeVariable _TraversalOrder, funT xT (funT typeT xT), xT, typeT, xT] $-  lambda "order" $ lambda "fld" $ lambda "b0" $ lambda "typ" $ (match _TraversalOrder Nothing [-    _TraversalOrder_pre>>: constant (Base.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")-      @@ (var "fld" @@ var "b0" @@ var "typ")-      @@ (ref subtypesDef @@ var "typ")),-    _TraversalOrder_post>>: constant (var "fld"-      @@ (Base.fold (ref foldOverTypeDef @@ var "order" @@ var "fld")-        @@ (var "b0")-        @@ (ref subtypesDef @@ var "typ"))-      @@ var "typ")] @@ var "order")--freeVariablesInTermDef :: TElement (Term -> S.Set Name)-freeVariablesInTermDef = tier1Definition "freeVariablesInTerm" $-  doc "Find the free variables (i.e. variables not bound by a lambda or let) in a term" $-  function termT (setT nameT) $-  lambda "term" (-    (match _Term (Just $ var "dfltVars") [-      _Term_function>>: match _Function (Just $ var "dfltVars") [-        _Function_lambda>>: lambda "l" (Sets.remove-          @@ (Core.lambdaParameter @@ var "l")-          @@ (ref freeVariablesInTermDef @@ (Core.lambdaBody @@ var "l")))],---      TODO: restore the following---      _Term_let>>: lambda "l" (Sets.difference---        @@ (ref freeVariablesInTermDef @@ (Core.letEnvironment @@ var "l"))---        @@ (Sets.fromList @@ (Lists.map @@ first @@ (Maps.toList @@ (Core.letBindings @@ var "l"))))),-      _Term_variable>>: lambda "v" (Sets.singleton @@ var "v")] @@ var "term")-    `with` [-      "dfltVars">: typed (setT nameT) $ Base.fold (lambda "s" $ lambda "t" $ Sets.union @@ var "s" @@ (ref freeVariablesInTermDef @@ var "t"))-        @@ Sets.empty-        @@ (ref subtermsDef @@ var "term")])--freeVariablesInTypeDef :: TElement (Type -> S.Set Name)-freeVariablesInTypeDef = tier1Definition "freeVariablesInType" $-  doc "Find the free variables (i.e. variables not bound by a lambda or let) in a type" $-  function typeT (setT nameT) $-  lambda "typ" (-    (match _Type (Just $ var "dfltVars") [-      _Type_lambda>>: lambda "lt" (Sets.remove-          @@ (Core.lambdaTypeParameter @@ var "lt")-          @@ (ref freeVariablesInTypeDef @@ (Core.lambdaTypeBody @@ var "lt"))),-      -- TODO: let-types-      _Type_variable>>: lambda "v" (Sets.singleton @@ var "v")] @@ var "typ")-    `with` [-      "dfltVars">: typed (setT nameT) $ Base.fold (lambda "s" $ lambda "t" $ Sets.union @@ var "s" @@ (ref freeVariablesInTypeDef @@ var "t"))-        @@ Sets.empty-        @@ (ref subtypesDef @@ var "typ")])--subtermsDef :: TElement (Term -> [Term])-subtermsDef = tier1Definition "subterms" $-  doc "Find the children of a given term" $-  function termT (listT termT) $-  match _Term Nothing [-    _Term_annotated>>: lambda "at" $ list [Core.annotatedTermSubject @@ var "at"],-    _Term_application>>: lambda "p" $ list [-      Core.applicationFunction @@ var "p",-      Core.applicationArgument @@ var "p"],-    _Term_function>>: match _Function (Just $ list []) [-        _Function_elimination>>: match _Elimination (Just $ list []) [-            _Elimination_list>>: lambda "fld" $ list [var "fld"],-            _Elimination_optional>>: lambda "oc" $ list [-              Core.optionalCasesNothing @@ var "oc",-              Core.optionalCasesJust @@ var "oc"],-            _Elimination_union>>: lambda "cs" $ Lists.concat2-              @@ ((matchOpt (list []) (lambda "t" $ list [var "t"])) @@ (Core.caseStatementDefault @@ var "cs"))-              @@ (Lists.map @@ Core.fieldTerm @@ (Core.caseStatementCases @@ var "cs"))],-        _Function_lambda>>: lambda "l" $ list [Core.lambdaBody @@ var "l"]],-    _Term_let>>: lambda "lt" $ Lists.cons-      @@ (Core.letEnvironment @@ var "lt")-      @@ (Lists.map @@ Core.letBindingTerm @@ (Core.letBindings @@ var "lt")),-    _Term_list>>: lambda "l" $ var "l",-    _Term_literal>>: constant $ list [],-    _Term_map>>: lambda "m" (Lists.concat @@-      (Lists.map @@ (lambda "p" $ list [first @@ var "p", second @@ var "p"]) @@ (Maps.toList @@ var "m"))),-    _Term_optional>>: matchOpt (list []) (lambda "t" $ list [var "t"]),-    _Term_product>>: lambda "tuple" $ var "tuple",-    _Term_record>>: lambda "rt" (Lists.map @@ Core.fieldTerm @@ (Core.recordFields @@ var "rt")),-    _Term_set>>: Sets.toList,-    _Term_sum>>: lambda "st" $ list [Core.sumTerm @@ var "st"],-    _Term_typeAbstraction>>: lambda "ta" $ list [Core.typeAbstractionBody @@ var "ta"],-    _Term_typeApplication>>: lambda "ta" $ list [Core.typedTermTerm @@ var "ta"],-    _Term_typed>>: lambda "tt" $ list [Core.typedTermTerm @@ var "tt"],-    _Term_union>>: lambda "ut" $ list [Core.fieldTerm @@ (Core.injectionField @@ var "ut")],-    _Term_variable>>: constant $ list [],-    _Term_wrap>>: lambda "n" $ list [Core.wrappedTermObject @@ var "n"]]--subtermsWithAccessorsDef :: TElement (Term -> [(TermAccessor, Term)])-subtermsWithAccessorsDef = tier1Definition "subtermsWithAccessors" $-  doc "Find the children of a given term" $-  function termT (listT $ pairT termAccessorT termT) $-  match _Term Nothing [-    _Term_annotated>>: lambda "at" $ single termAccessorAnnotatedSubject $ Core.annotatedTermSubject @@ var "at",-    _Term_application>>: lambda "p" $ list [-      result termAccessorApplicationFunction $ Core.applicationFunction @@ var "p",-      result termAccessorApplicationArgument $ Core.applicationArgument @@ var "p"],-    _Term_function>>: match _Function (Just none) [-        _Function_elimination>>: match _Elimination (Just none) [-            _Elimination_list>>: lambda "fld" $ single termAccessorListFold $ var "fld",-            _Elimination_optional>>: lambda "oc" $ list [-              result termAccessorOptionalCasesNothing $ Core.optionalCasesNothing @@ var "oc",-              result termAccessorOptionalCasesJust $ Core.optionalCasesJust @@ var "oc"],-            _Elimination_union>>: lambda "cs" $ Lists.concat2-              @@ ((matchOpt none (lambda "t" $ single termAccessorUnionCasesDefault $ var "t")) @@ (Core.caseStatementDefault @@ var "cs"))-              @@ (Lists.map-                @@ (lambda "f" $ result (termAccessorUnionCasesBranch $ Core.fieldName @@ var "f") $ Core.fieldTerm @@ var "f")-                @@ (Core.caseStatementCases @@ var "cs"))],-        _Function_lambda>>: lambda "l" $ single termAccessorLambdaBody $ Core.lambdaBody @@ var "l"],-    _Term_let>>: lambda "lt" $ Lists.cons-      @@ (result termAccessorLetEnvironment $ Core.letEnvironment @@ var "lt")-      @@ (Lists.map-        @@ (lambda "b" $ result (termAccessorLetBinding $ Core.letBindingName @@ var "b") $ Core.letBindingTerm @@ var "b")-        @@ (Core.letBindings @@ var "lt")),-    _Term_list>>: Lists.map-      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0-      @@ (lambda "e" $ result (termAccessorListElement $ int32 0) $ var "e"),-    _Term_literal>>: constant none,-    _Term_map>>: lambda "m" (Lists.concat @@-      (Lists.map-        @@ (lambda "p" $ list [-          -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0-          result (termAccessorMapKey $ int32 0) $ first @@ var "p",-          result (termAccessorMapValue $ int32 0) $ second @@ var "p"])-        @@ (Maps.toList @@ var "m"))),-    _Term_optional>>: matchOpt none (lambda "t" $ single termAccessorOptionalTerm $ var "t"),-    _Term_product>>: Lists.map-      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0-      @@ (lambda "e" $ result (termAccessorProductTerm $ int32 0) $ var "e"),-    _Term_record>>: lambda "rt" (Lists.map-      @@ (lambda "f" $ result (termAccessorRecordField $ Core.fieldName @@ var "f") $ Core.fieldTerm @@ var "f")-      @@ (Core.recordFields @@ var "rt")),-    _Term_set>>: lambda "s" $ Lists.map-      -- TODO: use a range of indexes from 0 to len(l)-1, rather than just 0-      @@ (lambda "e" $ result (termAccessorListElement $ int32 0) $ var "e")-      @@ (Sets.toList @@ var "s"),-    _Term_sum>>: lambda "st" $-      single termAccessorSumTerm $-      Core.sumTerm @@ var "st",-    _Term_typeAbstraction>>: lambda "ta" $-      single termAccessorTypeAbstractionBody $-      Core.typeAbstractionBody @@ var "ta",-    _Term_typeApplication>>: lambda "ta" $-      single termAccessorTypeApplicationTerm $-      Core.typedTermTerm @@ var "ta",-    _Term_typed>>: lambda "tt" $-      single termAccessorTypedTerm $-      Core.typedTermTerm @@ var "tt",-    _Term_union>>: lambda "ut" $-      single termAccessorInjectionTerm $-      Core.fieldTerm @@ (Core.injectionField @@ var "ut"),-    _Term_variable>>: constant none,-    _Term_wrap>>: lambda "n" $ single termAccessorWrappedTerm $ Core.wrappedTermObject @@ var "n"]-  where-    none = list []-    single accessor term = list [result accessor term]-    result accessor term = pair accessor term-    simple term = result termAccessorAnnotatedSubject term--subtypesDef :: TElement (Type -> [Type])-subtypesDef = tier1Definition "subtypes" $-  doc "Find the children of a given type expression" $-  function typeT (listT typeT) $-  match _Type Nothing [-    _Type_annotated>>: lambda "at" $ list [Core.annotatedTypeSubject @@ var "at"],-    _Type_application>>: lambda "at" $ list [-      Core.applicationTypeFunction @@ var "at",-      Core.applicationTypeArgument @@ var "at"],-    _Type_function>>: lambda "ft" $ list [-      Core.functionTypeDomain @@ var "ft",-      Core.functionTypeCodomain @@ var "ft"],-    _Type_lambda>>: lambda "lt" $ list [Core.lambdaTypeBody @@ var "lt"],-    _Type_list>>: lambda "lt" $ list [var "lt"],-    _Type_literal>>: constant $ list [],-    _Type_map>>: lambda "mt" $ list [-      Core.mapTypeKeys @@ var "mt",-      Core.mapTypeValues @@ var "mt"],-    _Type_optional>>: lambda "ot" $ list [var "ot"],-    _Type_product>>: lambda "pt" $ var "pt",-    _Type_record>>: lambda "rt" (Lists.map @@ Core.fieldTypeType @@ (Core.rowTypeFields @@ var "rt")),-    _Type_set>>: lambda "st" $ list [var "st"],-    _Type_sum>>: lambda "st" $ var "st",-    _Type_union>>: lambda "rt" (Lists.map @@ Core.fieldTypeType @@ (Core.rowTypeFields @@ var "rt")),-    _Type_variable>>: constant $ list [],-    _Type_wrap>>: lambda "nt" $ list [Core.wrappedTypeObject @@ var "nt"]]--unqualifyNameDef :: TElement (QualifiedName -> Name)-unqualifyNameDef = tier1Definition "unqualifyName" $-  doc "Convert a qualified name to a dot-separated name" $-  function qualifiedNameT nameT $-  lambda "qname" $ (wrap _Name $ var "prefix" ++ (project _QualifiedName _QualifiedName_local @@ var "qname"))-    `with` [-      "prefix">: matchOpt (string "") (lambda "n" $ (unwrap _Namespace @@ var "n") ++ string ".")-        @@ (project _QualifiedName _QualifiedName_namespace @@ var "qname")]---- Flows.hs--emptyTraceDef :: TElement Trace-emptyTraceDef = tier1Definition "emptyTrace" $-  record _Trace [-    _Trace_stack>>: list [],-    _Trace_messages>>: list [],-    _Trace_other>>: Maps.empty]--flowSucceedsDef :: TElement (Flow s a -> Bool)-flowSucceedsDef = tier1Definition "flowSucceeds" $-  doc "Check whether a flow succeeds" $-  function (Types.var "s") (Types.function flowSAT Types.boolean) $-  lambda "cx" $ lambda "f" $-    Optionals.isJust @@ (Flows.flowStateValue @@ (Flows.unFlow @@ var "f" @@ var "cx" @@ ref emptyTraceDef))--fromFlowDef :: TElement (a -> s -> Flow s a -> a)-fromFlowDef = tier1Definition "fromFlow" $-  doc "Get the value of a flow, or a default value if the flow fails" $-  function (Types.var "a") (Types.function (Types.var "s") (Types.function flowSAT (Types.var "a"))) $-  lambda "def" $ lambda "cx" $ lambda "f" $-      matchOpt (var "def") (lambda "x" $ var "x")-        @@ (Flows.flowStateValue @@ (Flows.unFlow @@ var "f" @@ var "cx" @@ ref emptyTraceDef))--mutateTraceDef :: TElement ((Trace -> Either_ String Trace) -> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a)-mutateTraceDef = tier1Definition "mutateTrace" $-    functionN [-      Types.function traceT (eitherT Types.string traceT),-      Types.functionN [traceT, traceT, traceT],-      flowSAT,-      flowSAT] $-    lambda "mutate" $ lambda "restore" $ lambda "f" $ wrap _Flow (-      lambda "s0" $ lambda "t0" (-        ((match _Either Nothing [-            _Either_left>>: var "forLeft",-            _Either_right>>: var "forRight"])-          @@ (var "mutate" @@ var "t0"))-        `with` [-          "forLeft">:-            lambda "msg" $ Flows.flowState nothing (var "s0") (ref pushErrorDef @@ var "msg" @@ var "t0"),-          -- retain the updated state, but reset the trace after execution-          "forRight">:-            function traceT (flowStateT (Types.var "s") (Types.var "s")) $-            lambda "t1" ((Flows.flowState-                (Flows.flowStateValue @@ var "f2")-                (Flows.flowStateState @@ var "f2")-                (var "restore" @@ var "t0" @@ (Flows.flowStateTrace @@ var "f2")))-              `with` [-                 -- execute the internal flow after augmenting the trace-                 "f2">: Flows.unFlow @@ var "f" @@ var "s0" @@ var "t1"-              ])]))-  where-    eitherT l r = Types.applyN [TypeVariable _Either, l, r]--pushErrorDef :: TElement (String -> Trace -> Trace)-pushErrorDef = tier1Definition "pushError" $-  doc "Push an error message" $-  functionN [Types.string, traceT, traceT] $-  lambda "msg" $ lambda "t" $ ((Flows.trace-      (Flows.traceStack @@ var "t")-      (Lists.cons @@ var "errorMsg" @@ (Flows.traceMessages @@ var "t"))-      (Flows.traceOther @@ var "t"))-    `with` [-      "errorMsg">: Strings.concat ["Error: ", var "msg", " (", (Strings.intercalate @@ " > " @@ (Lists.reverse @@ (Flows.traceStack @@ var "t"))), ")"]])--warnDef :: TElement (String -> Flow s a -> Flow s a)-warnDef = tier1Definition "warn" $-  doc "Continue the current flow after adding a warning message" $-  functionN [Types.string, flowSAT, flowSAT] $-  lambda "msg" $ lambda "b" $ wrap _Flow $ lambda "s0" $ lambda "t0" (-    (Flows.flowState-      (Flows.flowStateValue @@ var "f1")-      (Flows.flowStateState @@ var "f1")-      (var "addMessage" @@ (Flows.flowStateTrace @@ var "f1")))-    `with` [-      "f1">: Flows.unFlow @@ var "b" @@ var "s0" @@ var "t0",-      "addMessage">: lambda "t" $ Flows.trace-        (Flows.traceStack @@ var "t")-        (Lists.cons @@ ("Warning: " ++ var "msg") @@ (Flows.traceMessages @@ var "t"))-        (Flows.traceOther @@ var "t")])--withFlagDef :: TElement (String -> Flow s a -> Flow s a)-withFlagDef = tier1Definition "withFlag" $-  doc "Continue the current flow after setting a flag" $-  function nameT (Types.function flowSAT flowSAT) $-  lambda "flag" ((ref mutateTraceDef @@ var "mutate" @@ var "restore")-  `with` [-    "mutate">: lambda "t" $ inject _Either _Either_right $ (Flows.trace-      (Flows.traceStack @@ var "t")-      (Flows.traceMessages @@ var "t")-      (Maps.insert @@ var "flag" @@ (inject _Term _Term_literal $ inject _Literal _Literal_boolean $ boolean True) @@ (Flows.traceOther @@ var "t"))),-    "restore">: lambda "ignored" $ lambda "t1" $ Flows.trace-      (Flows.traceStack @@ var "t1")-      (Flows.traceMessages @@ var "t1")-      (Maps.remove @@ var "flag" @@ (Flows.traceOther @@ var "t1"))])--withStateDef :: TElement (s1 -> Flow s1 a -> Flow s2 a)-withStateDef = tier1Definition "withState" $-  doc "Continue a flow using a given state" $-  function (Types.var "s1") (Types.function flowS1AT flowS2AT) $-  lambda "cx0" $ lambda "f" $-    wrap _Flow $ lambda "cx1" $ lambda "t1" (-      (Flows.flowState (Flows.flowStateValue @@ var "f1") (var "cx1") (Flows.flowStateTrace @@ var "f1"))-      `with` [-        "f1">:-          typed (Types.apply (Types.apply (TypeVariable _FlowState) (Types.var "s1")) (Types.var "a")) $-          Flows.unFlow @@ var "f" @@ var "cx0" @@ var "t1"])--withTraceDef :: TElement (String -> Flow s a -> Flow s a)-withTraceDef = tier1Definition "withTrace" $-  doc "Continue the current flow after augmenting the trace" $-  functionN [Types.string, flowSAT, flowSAT] $-  lambda "msg" ((ref mutateTraceDef @@ var "mutate" @@ var "restore")-    `with` [-      -- augment the trace-      "mutate">: lambda "t" $ Logic.ifElse-        @@ (inject _Either _Either_left $ string "maximum trace depth exceeded. This may indicate an infinite loop")-        @@ (inject _Either _Either_right $ Flows.trace-          (Lists.cons @@ var "msg" @@ (Flows.traceStack @@ var "t"))-          (Flows.traceMessages @@ var "t")-          (Flows.traceOther @@ var "t"))-        @@ (Equality.gteInt32 @@ (Lists.length @@ (Flows.traceStack @@ var "t")) @@ ref maxTraceDepthDef),-      -- reset the trace stack after execution-      "restore">: lambda "t0" $ lambda "t1" $ Flows.trace-        (Flows.traceStack @@ var "t0")-        (Flows.traceMessages @@ var "t1")-        (Flows.traceOther @@ var "t1")])
− src/main/haskell/Hydra/Sources/Tier2/All.hs 
@@ -1,25 +0,0 @@-module Hydra.Sources.Tier2.All(-  module Hydra.Sources.Tier2.All,-  module Hydra.Sources.Tier1.All,-  module Hydra.Sources.Tier2.Basics,-  module Hydra.Sources.Tier2.CoreLanguage,-  module Hydra.Sources.Tier2.Extras,-  module Hydra.Sources.Tier2.Printing,-  module Hydra.Sources.Tier2.Tier2,-) where--import Hydra.Sources.Tier1.All-import Hydra.Sources.Tier2.Basics-import Hydra.Sources.Tier2.CoreLanguage-import Hydra.Sources.Tier2.Extras-import Hydra.Sources.Tier2.Printing-import Hydra.Sources.Tier2.Tier2--tier2Modules :: [Module]-tier2Modules = [-  hydraBasicsModule,-  hydraCoreLanguageModule,-  hydraExtrasModule,-  hydraPrintingModule,-  hydraStripModule,-  hydraTier2Module]
− src/main/haskell/Hydra/Sources/Tier2/Basics.hs 
@@ -1,490 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier2.Basics where---- Standard Tier-2 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier1.All---basicsDefinition :: String -> TTerm a -> TElement a-basicsDefinition = definitionInModule hydraBasicsModule--hydraBasicsModule :: Module-hydraBasicsModule = Module (Namespace "hydra/basics") elements-    [hydraTier1Module]-    tier0Modules $-    Just "A tier-2 module of basic functions for working with types and terms."-  where-   elements = [-     el eliminationVariantDef,-     el eliminationVariantsDef,-     el floatTypePrecisionDef,-     el floatTypesDef,-     el floatValueTypeDef,-     el functionVariantDef,-     el functionVariantsDef,-     el idDef,-     el integerTypeIsSignedDef,-     el integerTypePrecisionDef,-     el integerTypesDef,-     el integerValueTypeDef,-     el literalTypeDef,-     el literalTypeVariantDef,-     el literalVariantDef,-     el literalVariantsDef,-     el termVariantDef,-     el termVariantsDef,-     el typeVariantDef,-     el typeVariantsDef,-     -- Formatting.hs-     el capitalizeDef,-     el decapitalizeDef,-     el mapFirstLetterDef,-     -- Common.hs-     el fieldMapDef,-     el fieldTypeMapDef,-     el isEncodedTypeDef,-     el isTypeDef,-     el isUnitTermDef,-     el isUnitTypeDef,-     el elementsToGraphDef,-     el localNameOfEagerDef,-     el localNameOfLazyDef,-     el namespaceOfEagerDef,-     el namespaceOfLazyDef,-     el namespaceToFilePathDef,-     el qualifyNameEagerDef,-     el qualifyNameLazyDef-     ]--eliminationVariantDef :: TElement (Elimination -> EliminationVariant)-eliminationVariantDef = basicsDefinition "eliminationVariant" $-  doc "Find the elimination variant (constructor) for a given elimination term" $-  function eliminationT eliminationVariantT $-  matchToEnum _Elimination _EliminationVariant Nothing [-    _Elimination_list     @-> _EliminationVariant_list,-    _Elimination_optional @-> _EliminationVariant_optional,-    _Elimination_product  @-> _EliminationVariant_product,-    _Elimination_record   @-> _EliminationVariant_record,-    _Elimination_union    @-> _EliminationVariant_union,-    _Elimination_wrap     @-> _EliminationVariant_wrap]--eliminationVariantsDef :: TElement [EliminationVariant]-eliminationVariantsDef = basicsDefinition "eliminationVariants" $-  doc "All elimination variants (constructors), in a canonical order" $-  typed (listT eliminationVariantT) $-  list $ unitVariant _EliminationVariant <$> [-    _EliminationVariant_list,-    _EliminationVariant_wrap,-    _EliminationVariant_optional,-    _EliminationVariant_product,-    _EliminationVariant_record,-    _EliminationVariant_union]--floatTypePrecisionDef :: TElement (FloatType -> Precision)-floatTypePrecisionDef = basicsDefinition "floatTypePrecision" $-  doc "Find the precision of a given floating-point type" $-  function floatTypeT precisionT $-  matchToUnion _FloatType _Precision Nothing [-    _FloatType_bigfloat @-> field _Precision_arbitrary unit,-    _FloatType_float32  @-> field _Precision_bits $ int 32,-    _FloatType_float64  @-> field _Precision_bits $ int 64]--floatTypesDef :: TElement [FloatType]-floatTypesDef = basicsDefinition "floatTypes" $-  doc "All floating-point types in a canonical order" $-  typed (listT floatTypeT) $-  list $ unitVariant _FloatType <$> [-    _FloatType_bigfloat,-    _FloatType_float32,-    _FloatType_float64]--floatValueTypeDef :: TElement (FloatValue -> FloatType)-floatValueTypeDef = basicsDefinition "floatValueType" $-  doc "Find the float type for a given floating-point value" $-  function floatValueT floatTypeT $-  matchToEnum _FloatValue _FloatType Nothing [-    _FloatValue_bigfloat @-> _FloatType_bigfloat,-    _FloatValue_float32  @-> _FloatType_float32,-    _FloatValue_float64  @-> _FloatType_float64]--functionVariantDef :: TElement (Function -> FunctionVariant)-functionVariantDef = basicsDefinition "functionVariant" $-  doc "Find the function variant (constructor) for a given function" $-  function functionT functionVariantT $-  matchToEnum _Function _FunctionVariant Nothing [-    _Function_elimination @-> _FunctionVariant_elimination,-    _Function_lambda      @-> _FunctionVariant_lambda,-    _Function_primitive   @-> _FunctionVariant_primitive]--functionVariantsDef :: TElement [FunctionVariant]-functionVariantsDef = basicsDefinition "functionVariants" $-  doc "All function variants (constructors), in a canonical order" $-  typed (listT functionVariantT) $-  list $ unitVariant _FunctionVariant <$> [-    _FunctionVariant_elimination,-    _FunctionVariant_lambda,-    _FunctionVariant_primitive]--idDef :: TElement (a -> a)-idDef = basicsDefinition "id" $-  doc "The identity function" $-  function aT aT $-  lambda "x" $ var "x"--integerTypeIsSignedDef :: TElement (IntegerType -> Bool)-integerTypeIsSignedDef = basicsDefinition "integerTypeIsSigned" $-  doc "Find whether a given integer type is signed (true) or unsigned (false)" $-  function integerTypeT booleanT $-  matchData _IntegerType Nothing [-    _IntegerType_bigint @-> constant true,-    _IntegerType_int8   @-> constant true,-    _IntegerType_int16  @-> constant true,-    _IntegerType_int32  @-> constant true,-    _IntegerType_int64  @-> constant true,-    _IntegerType_uint8  @-> constant false,-    _IntegerType_uint16 @-> constant false,-    _IntegerType_uint32 @-> constant false,-    _IntegerType_uint64 @-> constant false]--integerTypePrecisionDef :: TElement (IntegerType -> Precision)-integerTypePrecisionDef = basicsDefinition "integerTypePrecision" $-  doc "Find the precision of a given integer type" $-  function integerTypeT precisionT $-  matchToUnion _IntegerType _Precision Nothing [-    _IntegerType_bigint @-> field _Precision_arbitrary unit,-    _IntegerType_int8   @-> field _Precision_bits $ int 8,-    _IntegerType_int16  @-> field _Precision_bits $ int 16,-    _IntegerType_int32  @-> field _Precision_bits $ int 32,-    _IntegerType_int64  @-> field _Precision_bits $ int 64,-    _IntegerType_uint8  @-> field _Precision_bits $ int 8,-    _IntegerType_uint16 @-> field _Precision_bits $ int 16,-    _IntegerType_uint32 @-> field _Precision_bits $ int 32,-    _IntegerType_uint64 @-> field _Precision_bits $ int 64]--integerTypesDef :: TElement [IntegerType]-integerTypesDef = basicsDefinition "integerTypes" $-  doc "All integer types, in a canonical order" $-  typed (listT integerTypeT) $-  list $ unitVariant _IntegerType <$> [-    _IntegerType_bigint,-    _IntegerType_int8,-    _IntegerType_int16,-    _IntegerType_int32,-    _IntegerType_int64,-    _IntegerType_uint8,-    _IntegerType_uint16,-    _IntegerType_uint32,-    _IntegerType_uint64]--integerValueTypeDef :: TElement (IntegerValue -> IntegerType)-integerValueTypeDef = basicsDefinition "integerValueType" $-  doc "Find the integer type for a given integer value" $-  function integerValueT integerTypeT $-  matchToEnum _IntegerValue _IntegerType Nothing [-    _IntegerValue_bigint @-> _IntegerType_bigint,-    _IntegerValue_int8   @-> _IntegerType_int8,-    _IntegerValue_int16  @-> _IntegerType_int16,-    _IntegerValue_int32  @-> _IntegerType_int32,-    _IntegerValue_int64  @-> _IntegerType_int64,-    _IntegerValue_uint8  @-> _IntegerType_uint8,-    _IntegerValue_uint16 @-> _IntegerType_uint16,-    _IntegerValue_uint32 @-> _IntegerType_uint32,-    _IntegerValue_uint64 @-> _IntegerType_uint64]--literalTypeDef :: TElement (Literal -> LiteralType)-literalTypeDef = basicsDefinition "literalType" $-  doc "Find the literal type for a given literal value" $-  function literalT literalTypeT $-  match _Literal Nothing [-    TCase _Literal_binary  --> constant $ variant _LiteralType _LiteralType_binary unit,-    TCase _Literal_boolean --> constant $ variant _LiteralType _LiteralType_boolean unit,-    TCase _Literal_float   --> inject2 _LiteralType _LiteralType_float <.> ref floatValueTypeDef,-    TCase _Literal_integer --> inject2 _LiteralType _LiteralType_integer <.> ref integerValueTypeDef,-    TCase _Literal_string  --> constant $ variant _LiteralType _LiteralType_string unit]--literalTypeVariantDef :: TElement (LiteralType -> LiteralVariant)-literalTypeVariantDef = basicsDefinition "literalTypeVariant" $-  doc "Find the literal type variant (constructor) for a given literal value" $-  function literalTypeT literalVariantT $-  matchToEnum _LiteralType _LiteralVariant Nothing [-    _LiteralType_binary  @-> _LiteralVariant_binary,-    _LiteralType_boolean @-> _LiteralVariant_boolean,-    _LiteralType_float   @-> _LiteralVariant_float,-    _LiteralType_integer @-> _LiteralVariant_integer,-    _LiteralType_string  @-> _LiteralVariant_string]--literalVariantDef :: TElement (Literal -> LiteralVariant)-literalVariantDef = basicsDefinition "literalVariant" $-  doc "Find the literal variant (constructor) for a given literal value" $-  function literalT literalVariantT $-  ref literalTypeVariantDef <.> ref literalTypeDef--literalVariantsDef :: TElement [LiteralVariant]-literalVariantsDef = basicsDefinition "literalVariants" $-  doc "All literal variants, in a canonical order" $-  typed (listT literalVariantT) $-  list $ unitVariant _LiteralVariant <$> [-    _LiteralVariant_binary,-    _LiteralVariant_boolean,-    _LiteralVariant_float,-    _LiteralVariant_integer,-    _LiteralVariant_string]--termVariantDef :: TElement (Term -> TermVariant)-termVariantDef = basicsDefinition "termVariant" $-  doc "Find the term variant (constructor) for a given term" $-  function termT termVariantT $-  matchToEnum _Term _TermVariant Nothing [-    _Term_annotated   @-> _TermVariant_annotated,-    _Term_application @-> _TermVariant_application,-    _Term_function    @-> _TermVariant_function,-    _Term_let         @-> _TermVariant_let,-    _Term_list        @-> _TermVariant_list,-    _Term_literal     @-> _TermVariant_literal,-    _Term_map         @-> _TermVariant_map,-    _Term_optional    @-> _TermVariant_optional,-    _Term_product     @-> _TermVariant_product,-    _Term_record      @-> _TermVariant_record,-    _Term_set         @-> _TermVariant_set,-    _Term_sum         @-> _TermVariant_sum,-    _Term_typeAbstraction @-> _TermVariant_typeAbstraction,-    _Term_typeApplication @-> _TermVariant_typeApplication,-    _Term_typed       @-> _TermVariant_typed,-    _Term_union       @-> _TermVariant_union,-    _Term_variable    @-> _TermVariant_variable,-    _Term_wrap        @-> _TermVariant_wrap]--termVariantsDef :: TElement [TermVariant]-termVariantsDef = basicsDefinition "termVariants" $-  doc "All term (expression) variants, in a canonical order" $-  typed (listT termVariantT) $-  list $ unitVariant _TermVariant <$> [-    _TermVariant_annotated,-    _TermVariant_application,-    _TermVariant_literal,-    _TermVariant_function,-    _TermVariant_list,-    _TermVariant_map,-    _TermVariant_optional,-    _TermVariant_product,-    _TermVariant_record,-    _TermVariant_set,-    _TermVariant_sum,-    _TermVariant_typeAbstraction,-    _TermVariant_typeApplication,-    _TermVariant_typed,-    _TermVariant_union,-    _TermVariant_variable,-    _TermVariant_wrap]--typeVariantDef :: TElement (Type -> TypeVariant)-typeVariantDef = basicsDefinition "typeVariant" $-  doc "Find the type variant (constructor) for a given type" $-  function typeT typeVariantT $-  matchToEnum _Type _TypeVariant Nothing [-    _Type_annotated   @-> _TypeVariant_annotated,-    _Type_application @-> _TypeVariant_application,-    _Type_function    @-> _TypeVariant_function,-    _Type_lambda      @-> _TypeVariant_lambda,-    _Type_list        @-> _TypeVariant_list,-    _Type_literal     @-> _TypeVariant_literal,-    _Type_map         @-> _TypeVariant_map,-    _Type_optional    @-> _TypeVariant_optional,-    _Type_product     @-> _TypeVariant_product,-    _Type_record      @-> _TypeVariant_record,-    _Type_set         @-> _TypeVariant_set,-    _Type_sum         @-> _TypeVariant_sum,-    _Type_union       @-> _TypeVariant_union,-    _Type_variable    @-> _TypeVariant_variable,-    _Type_wrap        @-> _TypeVariant_wrap]--typeVariantsDef :: TElement [TypeVariant]-typeVariantsDef = basicsDefinition "typeVariants" $-  doc "All type variants, in a canonical order" $-  typed (listT typeVariantT) $-  list $ unitVariant _TypeVariant <$> [-    _TypeVariant_annotated,-    _TypeVariant_application,-    _TypeVariant_function,-    _TypeVariant_lambda,-    _TypeVariant_list,-    _TypeVariant_literal,-    _TypeVariant_map,-    _TypeVariant_wrap,-    _TypeVariant_optional,-    _TypeVariant_product,-    _TypeVariant_record,-    _TypeVariant_set,-    _TypeVariant_sum,-    _TypeVariant_union,-    _TypeVariant_variable]---- Formatting.hs--capitalizeDef :: TElement (String -> String)-capitalizeDef = basicsDefinition "capitalize" $-  doc "Capitalize the first letter of a string" $-  function stringT stringT $-  ref mapFirstLetterDef @@ Strings.toUpper--decapitalizeDef :: TElement (String -> String)-decapitalizeDef = basicsDefinition "decapitalize" $-  doc "Decapitalize the first letter of a string" $-  function stringT stringT $-  ref mapFirstLetterDef @@ Strings.toLower---- TODO: simplify this helper-mapFirstLetterDef :: TElement ((String -> String) -> String -> String)-mapFirstLetterDef = basicsDefinition "mapFirstLetter" $-  doc "A helper which maps the first letter of a string to another string" $-  function (funT stringT stringT) (funT stringT stringT) $-  lambda "mapping" $ lambda "s" ((Logic.ifElse-       @@ var "s"-       @@ (Strings.cat2 @@ var "firstLetter" @@ (Strings.fromList @@ (Lists.tail @@ var "list")))-       @@ (Strings.isEmpty @@ var "s"))-    `with` [-      "firstLetter">: var "mapping" @@ (Strings.fromList @@ (Lists.pure @@ (Lists.head @@ var "list"))),-      "list">: typed (listT int32T) $ Strings.toList @@ var "s"])---- Common.hs--fieldMapDef :: TElement ([Field] -> M.Map Name Term)-fieldMapDef = basicsDefinition "fieldMap" $-  function (TypeList fieldT) (mapT fieldNameT termT) $-  (lambda "fields" $ Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "fields"))-    `with` [-      "toPair">: lambda "f" $ pair (Core.fieldName @@ var "f") (Core.fieldTerm @@ var "f")]--fieldTypeMapDef :: TElement ([FieldType] -> M.Map Name Type)-fieldTypeMapDef = basicsDefinition "fieldTypeMap" $-  function (TypeList fieldTypeT) (mapT fieldNameT typeT) $-    (lambda "fields" $ Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "fields"))-  `with` [-    "toPair">: lambda "f" $ pair (Core.fieldTypeName @@ var "f") (Core.fieldTypeType @@ var "f")]--isEncodedTypeDef :: TElement (Term -> Bool)-isEncodedTypeDef = basicsDefinition "isEncodedType" $-  function termT booleanT $-  lambda "t" $ (match _Term (Just false) [-      TCase _Term_application --> lambda "a" $-        ref isEncodedTypeDef @@ (Core.applicationFunction @@ var "a"),-      TCase _Term_union       --> lambda "i" $-        Equality.equalString @@ (string $ unName _Type) @@ (Core.unName @@ (Core.injectionTypeName @@ var "i"))-    ]) @@ (ref stripTermDef @@ var "t")--isTypeDef :: TElement (Type -> Bool)-isTypeDef = basicsDefinition "isType" $-  function typeT booleanT $-  lambda "t" $ (match _Type (Just false) [-      TCase _Type_application --> lambda "a" $-        ref isTypeDef @@ (Core.applicationTypeFunction @@ var "a"),-      TCase _Type_lambda --> lambda "l" $-        ref isTypeDef @@ (Core.lambdaTypeBody @@ var "l"),-      TCase _Type_union --> lambda "rt" $-        Equality.equalString @@ (string $ unName _Type) @@ (Core.unName @@ (Core.rowTypeTypeName @@ var "rt"))---      TCase _Type_variable --> constant true-    ]) @@ (ref stripTypeDef @@ var "t")--isUnitTermDef :: TElement (Term -> Bool)-isUnitTermDef = basicsDefinition "isUnitTerm" $-  function termT booleanT $-  lambda "t" $ Equality.equalTerm @@ (ref fullyStripTermDef @@ var "t") @@ TTerm (coreEncodeTerm Terms.unit)--isUnitTypeDef :: TElement (Term -> Bool)-isUnitTypeDef = basicsDefinition "isUnitType" $-  function typeT booleanT $-  lambda "t" $ Equality.equalType @@ (ref stripTypeDef @@ var "t") @@ TTerm (coreEncodeType unitT)--elementsToGraphDef :: TElement (Graph -> Maybe Graph -> [Element] -> Graph)-elementsToGraphDef = basicsDefinition "elementsToGraph" $-  function graphT (funT (optionalT graphT) (funT (TypeList elementT) graphT)) $-  lambda "parent" $ lambda "schema" $ lambda "elements" $-    Graph.graph-      (Maps.fromList @@ (Lists.map @@ var "toPair" @@ var "elements"))-      (Graph.graphEnvironment @@ var "parent")-      (Graph.graphTypes @@ var "parent")-      (Graph.graphBody @@ var "parent")-      (Graph.graphPrimitives @@ var "parent")-      (var "schema")-  `with` [-    "toPair" >: lambda "el" $ pair (Graph.elementName @@ var "el") (var "el")]--localNameOfEagerDef :: TElement (Name -> String)-localNameOfEagerDef = basicsDefinition "localNameOfEager" $-  function nameT stringT $-  Module.qualifiedNameLocal <.> ref qualifyNameEagerDef--localNameOfLazyDef :: TElement (Name -> String)-localNameOfLazyDef = basicsDefinition "localNameOfLazy" $-  function nameT stringT $-  Module.qualifiedNameLocal <.> ref qualifyNameLazyDef--namespaceOfEagerDef :: TElement (Name -> Maybe Namespace)-namespaceOfEagerDef = basicsDefinition "namespaceOfEager" $-  function nameT (optionalT namespaceT) $-  Module.qualifiedNameNamespace <.> ref qualifyNameEagerDef--namespaceOfLazyDef :: TElement (Name -> Maybe Namespace)-namespaceOfLazyDef = basicsDefinition "namespaceOfLazy" $-  function nameT (optionalT namespaceT) $-  Module.qualifiedNameNamespace <.> ref qualifyNameLazyDef--namespaceToFilePathDef :: TElement (Bool -> FileExtension -> Namespace -> String)-namespaceToFilePathDef = basicsDefinition "namespaceToFilePath" $-  function booleanT (funT fileExtensionT (funT namespaceT stringT)) $-  lambda "caps" $ lambda "ext" $ lambda "ns" $-    (((Strings.intercalate @@ "/" @@ var "parts") ++ "." ++ (Module.unFileExtension @@ var "ext"))-    `with` [-      "parts">: Lists.map-        @@ (Logic.ifElse-          @@ ref capitalizeDef-          @@ ref idDef-          @@ var "caps")-        @@ (Strings.splitOn @@ "/" @@ (Core.unNamespace @@ var "ns"))])--qualifyNameEagerDef :: TElement (Name -> QualifiedName)-qualifyNameEagerDef = basicsDefinition "qualifyNameEager" $-  function nameT qualifiedNameT $-  lambda "name" $ ((Logic.ifElse-      @@ Module.qualifiedName nothing (Core.unName @@ var "name")-      @@ Module.qualifiedName-        (just $ wrap _Namespace (Lists.head @@ var "parts"))-        (Strings.intercalate @@ "." @@ (Lists.tail @@ var "parts"))-      @@ (Equality.equalInt32 @@ int32 1 @@ (Lists.length @@ var "parts")))-    `with` [-      "parts">: Strings.splitOn @@ "." @@ (Core.unName @@ var "name")])--qualifyNameLazyDef :: TElement (Name -> QualifiedName)-qualifyNameLazyDef = basicsDefinition "qualifyNameLazy" $-  function nameT qualifiedNameT $-  lambda "name" $ (Logic.ifElse-      @@ Module.qualifiedName nothing (Core.unName @@ var "name")-      @@ Module.qualifiedName-        (just $ wrap _Namespace (Strings.intercalate @@ "." @@ (Lists.reverse @@ (Lists.tail @@ var "parts"))))-        (Lists.head @@ var "parts")-      @@ (Equality.equalInt32 @@ int32 1 @@ (Lists.length @@ var "parts")))-    `with` [-      "parts">: Lists.reverse @@ (Strings.splitOn @@ "." @@ (Core.unName @@ var "name"))]
− src/main/haskell/Hydra/Sources/Tier2/CoreLanguage.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier2.CoreLanguage where---- Standard Tier-2 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier1.All--import Hydra.Sources.Tier2.Basics---hydraCoreLanguageModule :: Module-hydraCoreLanguageModule = Module ns elements-    [hydraBasicsModule]-    tier0Modules $-    Just "Language constraints for Hydra Core"-  where-    ns = Namespace "hydra/coreLanguage"-    elements = [el hydraCoreLanguageDef]--hydraCoreLanguageDef :: TElement Language-hydraCoreLanguageDef = definitionInModule hydraCoreLanguageModule "hydraCoreLanguage" $-  doc "Language constraints for Java" $-  typed languageT $-  record _Language [-    _Language_name>>: wrap _LanguageName "hydra/core",-    _Language_constraints>>: record _LanguageConstraints [-    _LanguageConstraints_eliminationVariants>>: Sets.fromList @@ ref eliminationVariantsDef,-    _LanguageConstraints_literalVariants>>: Sets.fromList @@ ref literalVariantsDef,-    _LanguageConstraints_floatTypes>>: Sets.fromList @@ ref floatTypesDef,-    _LanguageConstraints_functionVariants>>: Sets.fromList @@ ref functionVariantsDef,-    _LanguageConstraints_integerTypes>>: Sets.fromList @@ ref integerTypesDef,-    _LanguageConstraints_termVariants>>: Sets.fromList @@ ref termVariantsDef,-    _LanguageConstraints_typeVariants>>: Sets.fromList @@ ref typeVariantsDef,-    _LanguageConstraints_types>>: constant true]]
− src/main/haskell/Hydra/Sources/Tier2/Extras.hs 
@@ -1,117 +0,0 @@-module Hydra.Sources.Tier2.Extras (hydraExtrasModule) where---- Standard Tier-2 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier1.All---hydraExtrasDefinition :: String -> TTerm a -> TElement a-hydraExtrasDefinition = definitionInModule hydraExtrasModule--hydraExtrasModule :: Module-hydraExtrasModule = Module (Namespace "hydra/extras") elements-    [hydraGraphModule, hydraMantleModule, hydraComputeModule]-    tier0Modules $-    Just "Basic functions which depend on primitive functions"-  where-    elements = [-      el functionArityDef,-      el lookupPrimitiveDef,-      el primitiveArityDef,-      el qnameDef,-      el termArityDef,-      el typeArityDef,-      el uncurryTypeDef,-      el getAnnotationDef-      ]--functionArityDef :: TElement (Function -> Int)-functionArityDef = hydraExtrasDefinition "functionArity" $-  function (TypeVariable _Function) Types.int32 $-  match _Function Nothing [-    TCase _Function_elimination --> constant (int32 1),-    TCase _Function_lambda --> (Math.add @@ int32 1) <.> (ref termArityDef <.> Core.lambdaBody),-    TCase _Function_primitive --> constant $-      doc "TODO: This function needs to be monadic, so we can look up the primitive" (int32 42)]--lookupPrimitiveDef :: TElement (Graph -> Name -> Maybe (Primitive))-lookupPrimitiveDef = hydraExtrasDefinition "lookupPrimitive" $-  function-    graphT-    (Types.function nameT (optionalT primitiveT)) $-  lambda "g" $ lambda "name" $-    apply (Maps.lookup @@ var "name") (Graph.graphPrimitives @@ var "g")--primitiveArityDef :: TElement (Primitive -> Int)-primitiveArityDef = hydraExtrasDefinition "primitiveArity" $-  doc "Find the arity (expected number of arguments) of a primitive constant or function" $-  function primitiveT Types.int32 $-  (ref typeArityDef <.> Core.typeSchemeType <.> Graph.primitiveType)--qnameDef :: TElement (Namespace -> String -> Name)-qnameDef = hydraExtrasDefinition "qname" $-  doc "Construct a qualified (dot-separated) name" $-  functionN [namespaceT, stringT, nameT] $-  lambda "ns" $ lambda "name" $-    nom _Name $-      apply Strings.cat $-        list [apply (unwrap _Namespace) (var "ns"), string ".", var "name"]--termArityDef :: TElement (Term -> Int)-termArityDef = hydraExtrasDefinition "termArity" $-  function termT Types.int32 $-  match _Term (Just $ int32 0) [-    TCase _Term_application --> (lambda "x" $ Math.sub @@ var "x" @@ int32 1) <.> ref termArityDef <.> Core.applicationFunction,-    TCase _Term_function --> ref functionArityDef]-    -- Note: ignoring variables which might resolve to functions--typeArityDef :: TElement (Type -> Int)-typeArityDef = hydraExtrasDefinition "typeArity" $-  function typeT Types.int32 $-  match _Type (Just $ int32 0) [-    TCase _Type_annotated --> ref typeArityDef <.> Core.annotatedTypeSubject,-    TCase _Type_application --> ref typeArityDef <.> Core.applicationTypeFunction,-    TCase _Type_lambda --> ref typeArityDef <.> Core.lambdaTypeBody,-    TCase _Type_function --> lambda "f" $-      Math.add @@ (int32 1) @@ (ref typeArityDef @@ (Core.functionTypeCodomain @@ var "f"))]--uncurryTypeDef :: TElement (Type -> [Type])-uncurryTypeDef = hydraExtrasDefinition "uncurryType" $-  function typeT (listT typeT) $-  doc "Uncurry a type expression into a list of types, turning a function type a -> b into cons a (uncurryType b)" $-  lambda "t" ((match _Type (Just $ list [var "t"]) [-    _Type_annotated>>: ref uncurryTypeDef <.> Core.annotatedTypeSubject,-    _Type_application>>: ref uncurryTypeDef <.> Core.applicationTypeFunction,-    _Type_lambda>>: ref uncurryTypeDef <.> Core.lambdaTypeBody,-    _Type_function>>: lambda "ft" $ Lists.cons-      @@ (Core.functionTypeDomain @@ var "ft")-      @@ (ref uncurryTypeDef @@ (Core.functionTypeCodomain @@ var "ft"))]) @@ var "t")---- hydra/annotations--getAnnotationDef :: TElement (Name -> M.Map Name Term -> Maybe Term)-getAnnotationDef = hydraExtrasDefinition "getAnnotation" $-  functionN [nameT, kvT, optionalT termT] $-  lambda "key" $ lambda "ann" $-    Maps.lookup @@ var "key" @@ var "ann"
− src/main/haskell/Hydra/Sources/Tier2/Printing.hs 
@@ -1,109 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier2.Printing where---- Standard Tier-2 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier1.All--import Hydra.Sources.Tier2.Basics---hydraPrintingModule :: Module-hydraPrintingModule = Module (Namespace "hydra/printing") elements-    [hydraBasicsModule]-    tier0Modules $-    Just "Utilities for use in transformations"-  where-   elements = [-     el describeFloatTypeDef,-     el describeIntegerTypeDef,-     el describeLiteralTypeDef,-     el describePrecisionDef,-     el describeTypeDef]--printingDefinition :: String -> TTerm a -> TElement a-printingDefinition = definitionInModule hydraPrintingModule---describeFloatTypeDef :: TElement (FloatType -> String)-describeFloatTypeDef = printingDefinition "describeFloatType" $-  doc "Display a floating-point type as a string" $-  function floatTypeT stringT $-  lambda "t" $ (ref describePrecisionDef <.> ref floatTypePrecisionDef @@ var "t") ++ string " floating-point numbers"--describeIntegerTypeDef :: TElement (IntegerType -> String)-describeIntegerTypeDef = printingDefinition "describeIntegerType" $-  doc "Display an integer type as a string" $-  function integerTypeT stringT $-  lambda "t" $ (ref describePrecisionDef <.> ref integerTypePrecisionDef @@ var "t")-    ++ string " integers"--describeLiteralTypeDef :: TElement (LiteralType -> String)-describeLiteralTypeDef = printingDefinition "describeLiteralType" $-  doc "Display a literal type as a string" $-  function literalTypeT stringT $-  match _LiteralType Nothing [-    TCase _LiteralType_binary  --> constant $ string "binary strings",-    TCase _LiteralType_boolean --> constant $ string "boolean values",-    TCase _LiteralType_float   --> ref describeFloatTypeDef,-    TCase _LiteralType_integer --> ref describeIntegerTypeDef,-    TCase _LiteralType_string  --> constant $ string "character strings"]--describePrecisionDef :: TElement (Precision -> String)-describePrecisionDef = printingDefinition "describePrecision" $-  doc "Display numeric precision as a string" $-  function precisionT stringT $-  match _Precision Nothing [-    TCase _Precision_arbitrary --> constant $ string "arbitrary-precision",-    TCase _Precision_bits      --> lambda "bits" $ Literals.showInt32 @@ var "bits" ++ string "-bit"]--describeTypeDef :: TElement (Type -> String)-describeTypeDef = printingDefinition "describeType" $-  doc "Display a type as a string" $-  function typeT stringT $-    match _Type Nothing [-      TCase _Type_annotated   --> lambda "a" $ string "annotated " ++ (ref describeTypeDef @@-        (project _AnnotatedType _AnnotatedType_subject @@ var "a")),-      TCase _Type_application --> constant $ string "instances of an application type",-      TCase _Type_literal     --> ref describeLiteralTypeDef,-      TCase _Type_function    --> lambda "ft" $ string "functions from "-        ++ (ref describeTypeDef @@ (project _FunctionType _FunctionType_domain @@ var "ft"))-        ++ string " to "-        ++ (ref describeTypeDef @@ (project _FunctionType _FunctionType_codomain @@ var "ft")),-      TCase _Type_lambda      --> constant $ string "polymorphic terms",-      TCase _Type_list        --> lambda "t" $ string "lists of " ++ (ref describeTypeDef @@ var "t"),-      TCase _Type_map         --> lambda "mt" $ string "maps from "-        ++ (ref describeTypeDef @@ (project _MapType _MapType_keys @@ var "mt"))-        ++ string " to "-        ++ (ref describeTypeDef @@ (project _MapType _MapType_values  @@ var "mt")),-      TCase _Type_optional    --> lambda "ot" $ string "optional " ++ (ref describeTypeDef @@ var "ot"),-      TCase _Type_product     --> constant $ string "tuples",-      TCase _Type_record      --> constant $ string "records",-      TCase _Type_set         --> lambda "st" $ string "sets of " ++ (ref describeTypeDef @@ var "st"),-      TCase _Type_sum         --> constant $ string "variant tuples",-      TCase _Type_union       --> constant $ string "unions",-      TCase _Type_variable    --> constant $ string "instances of a named type",-      TCase _Type_wrap        --> lambda "n" $ string "wrapper for "-        ++ (ref describeTypeDef @@ (project _WrappedType _WrappedType_object @@ var "n"))]
− src/main/haskell/Hydra/Sources/Tier2/Tier2.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier2.Tier2 where---- Standard Tier-2 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier1.All---tier2Definition :: String -> TTerm a -> TElement a-tier2Definition = definitionInModule hydraTier2Module--hydraTier2Module :: Module-hydraTier2Module = Module (Namespace "hydra/tier2") elements-   [hydraGraphModule, hydraMantleModule, hydraComputeModule, hydraStripModule] tier0Modules $-    Just ("A module for miscellaneous tier-2 functions and constants.")-  where-   elements = [-     el getStateDef,-     el getTermTypeDef,-     el putStateDef,-     el requireElementTypeDef,-     el requireTermTypeDef,-     el unexpectedDef-     ]--getStateDef :: TElement (Flow s s)-getStateDef = tier2Definition "getState" $-  doc "Get the state of the current flow" $-  typed flowSST $-  wrap _Flow (lambda "s0" $ lambda "t0" $ (-    (lambda "v" $ lambda "s" $ lambda "t" $ (-      (matchOpt-        (Flows.flowState nothing (var "s") (var "t"))-        (constant (Flows.flowState (just $ var "s") (var "s") (var "t"))))-       @@ var "v"))-    @@ (Flows.flowStateValue @@ var "fs1") @@ (Flows.flowStateState @@ var "fs1") @@ (Flows.flowStateTrace @@ var "fs1"))-  `with` [-    "fs1">:-      typed (Types.apply (Types.apply (TypeVariable _FlowState) sT) unitT) $-      Flows.unFlow @@ (Flows.pure @@ unit) @@ var "s0" @@ var "t0"])--getTermTypeDef :: TElement (Term -> Flow Graph (Maybe Type))-getTermTypeDef = tier2Definition "getTermType" $-  doc "Get the annotated type of a given term, if any" $-  function termT (optionalT typeT) $-  match _Term (Just nothing) [-    "annotated">: ref getTermTypeDef <.> project _AnnotatedTerm _AnnotatedTerm_subject,-    "typed">: lambda "tt" $ just (project _TypedTerm _TypedTerm_type @@ var "tt")]--putStateDef :: TElement (s -> Flow s ())-putStateDef = tier2Definition "putState" $-  doc "Set the state of a flow" $-  function sT (flowT sT unitT) $-  lambda "cx" $ wrap _Flow $ lambda "s0" $ lambda "t0" (-    (Flows.flowState-      (Flows.flowStateValue @@ var "f1")-      (var "cx")-      (Flows.flowStateTrace @@ var "f1"))-    `with` [-      "f1">: Flows.unFlow @@ (Flows.pure @@ unit) @@ var "s0" @@ var "t0"])--requireElementTypeDef :: TElement (Element -> Flow Graph Type)-requireElementTypeDef = tier2Definition "requireElementType" $-  doc "Get the annotated type of a given element, or fail if it is missing" $-  function elementT (flowT graphT typeT) $-  lambda "el" $ ((var "withType" @@ (ref getTermTypeDef @@ (project _Element _Element_data @@ var "el")))-    `with` [-      "withType">: matchOpt-       (Flows.fail @@ ("missing type annotation for element " ++ (unwrap _Name @@ (project _Element _Element_name @@ var "el"))))-       Flows.pure])--requireTermTypeDef :: TElement (Term -> Flow Graph Type)-requireTermTypeDef = tier2Definition "requireTermType" $-  doc "Get the annotated type of a given term, or fail if it is missing" $-  function termT (flowT graphT typeT) $-  (var "withType" <.> ref getTermTypeDef)-    `with` [-      "withType">: matchOpt-       (Flows.fail @@ "missing type annotation")-       Flows.pure]--unexpectedDef :: TElement (String -> String -> Flow s x)-unexpectedDef = tier2Definition "unexpected" $-  doc "Fail if an actual value does not match an expected value" $-  function stringT (funT stringT (flowT sT xT)) $-  lambda "expected" $ lambda "actual" $ Flows.fail @@ ("expected " ++ var "expected" ++ " but found: " ++ var "actual")
− src/main/haskell/Hydra/Sources/Tier3/All.hs 
@@ -1,15 +0,0 @@-module Hydra.Sources.Tier3.All(-  module Hydra.Sources.Tier3.All,-  module Hydra.Sources.Tier2.All,-  module Hydra.Sources.Tier3.Tier3,-) where--import Hydra.Sources.Tier2.All-import Hydra.Sources.Tier3.Tier3--kernelModules :: [Module]-kernelModules = tier0Modules ++ tier1Modules ++ tier2Modules ++ tier3Modules--tier3Modules :: [Module]-tier3Modules = [-  hydraTier3Module]
− src/main/haskell/Hydra/Sources/Tier3/Tier3.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier3.Tier3 where---- Standard Tier-3 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier2.All---tier3Definition :: String -> TTerm a -> TElement a-tier3Definition = definitionInModule hydraTier3Module---- TODO: this need not be a tier-3 module; it has no term-level dependencies. It could be a tier-1 module.-hydraTier3Module :: Module-hydraTier3Module = Module (Namespace "hydra/tier3") elements [hydraCoreModule] tier0Modules $-    Just ("A module for miscellaneous tier-3 functions and constants.")-  where-   elements = [-     el traceSummaryDef-     ]--traceSummaryDef :: TElement (Trace -> String)-traceSummaryDef = tier3Definition "traceSummary" $-  doc "Summarize a trace as a string" $-  function traceT stringT $-  lambda "t" $ (-    (Strings.intercalate @@ "\n" @@ (Lists.concat2 @@ var "messageLines" @@ var "keyvalLines"))-      `with` [-        "messageLines">: (Lists.nub @@ (Flows.traceMessages @@ var "t")),-        "keyvalLines">: Logic.ifElse-          @@ (list [])-          @@ (Lists.cons @@ "key/value pairs: "-            @@ (Lists.map @@ (var "toLine") @@ (Maps.toList @@ (Flows.traceOther @@ var "t"))))-          @@ (Maps.isEmpty @@ (Flows.traceOther @@ var "t")),-        "toLine">:-          function (pairT stringT termT) stringT $-          lambda "pair" $ "\t" ++ (Core.unName @@ (first @@ var "pair")) ++ ": " ++ (Io.showTerm @@ (second @@ var "pair"))])
− src/main/haskell/Hydra/Sources/Tier4/All.hs 
@@ -1,70 +0,0 @@-module Hydra.Sources.Tier4.All(-  module Hydra.Sources.Tier4.All,-  module Hydra.Sources.Tier3.All,-  -- Note: individual Tier-4 modules are not exported, as they are currently not guaranteed to be free of name collisions-) where--import Hydra.Sources.Tier3.All-import Hydra.Sources.Tier4.Ext.Avro.Schema-import Hydra.Sources.Tier4.Ext.Csharp.Syntax-import Hydra.Sources.Tier4.Ext.Cypher.Features-import Hydra.Sources.Tier4.Ext.Cypher.OpenCypher-import Hydra.Sources.Tier4.Ext.Graphql.Syntax-import Hydra.Sources.Tier4.Ext.Haskell.Ast-import Hydra.Sources.Tier4.Ext.Java.Language-import Hydra.Sources.Tier4.Ext.Java.Syntax-import Hydra.Sources.Tier4.Ext.Json.Decoding-import Hydra.Sources.Tier4.Ext.Pegasus.Pdl-import Hydra.Sources.Tier4.Ext.Protobuf.Any-import Hydra.Sources.Tier4.Ext.Protobuf.Language-import Hydra.Sources.Tier4.Ext.Protobuf.Proto3-import Hydra.Sources.Tier4.Ext.Protobuf.SourceContext-import Hydra.Sources.Tier4.Ext.Rdf.Syntax-import Hydra.Sources.Tier4.Ext.RelationalModel-import Hydra.Sources.Tier4.Ext.Scala.Meta-import Hydra.Sources.Tier4.Ext.Shacl.Model-import Hydra.Sources.Tier4.Ext.Tabular-import Hydra.Sources.Tier4.Ext.Yaml.Model-import Hydra.Sources.Tier4.Test.TestSuite-import Hydra.Sources.Tier4.Ext.Pg.Mapping-import Hydra.Sources.Tier4.Ext.Pg.Model-import Hydra.Sources.Tier4.Ext.Pg.Query-import Hydra.Sources.Tier4.Ext.Pg.Validation---allModules :: [Module]-allModules = mainModules ++ testModules--mainModules :: [Module]-mainModules = kernelModules ++ tier4LangModules--testModules :: [Module]-testModules = [-  testSuiteModule]--tier4LangModules :: [Module]-tier4LangModules = [-  avroSchemaModule,-  csharpSyntaxModule,-  graphqlSyntaxModule,-  haskellAstModule,-  javaLanguageModule,-  javaSyntaxModule,-  jsonDecodingModule,-  openCypherModule,-  openCypherFeaturesModule,-  pegasusPdlModule,-  proto3Module,-  protobufAnyModule,-  protobufLanguageModule,-  protobufSourceContextModule,-  rdfSyntaxModule,-  relationalModelModule,-  scalaMetaModule,-  shaclModelModule,-  tabularModule,-  pgMappingModule,-  pgModelModule,-  pgQueryModule,-  pgValidationModule,-  yamlModelModule]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Avro/Schema.hs 
@@ -1,138 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Avro.Schema where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---avroSchemaModule :: Module-avroSchemaModule = Module ns elements [jsonModelModule] tier0Modules $-    Just ("A model for Avro schemas. Based on the Avro 1.11.1 specification:\n" ++-      "  https://avro.apache.org/docs/1.11.1/specification")-  where-    ns = Namespace "hydra/ext/org/apache/avro/schema"-    def = datatype ns-    avro = typeref ns-    json = typeref $ moduleNamespace jsonModelModule--    elements = [-      def "Array" $-        record [-          "items">: avro "Schema"],--      def "Enum" $-        record [-          "symbols">:-            doc ("a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; " ++-              "duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* " ++-              "(the same requirement as for names)") $-            list string,-          "default">:-            doc ("A default value for this enumeration, used during resolution when the reader encounters " ++-              "a symbol from the writer that isn't defined in the reader's schema. " ++-              "The value provided here must be a JSON string that's a member of the symbols array") $-            optional string],--      def "Field" $-        record [-          "name">:-            doc "a JSON string providing the name of the field"-            string,-          "doc">:-            doc "a JSON string describing this field for users" $-            optional string,-          "type">:-            doc "a schema" $-            avro "Schema",-          "default">:-            doc "default value for this field, only used when reading instances that lack the field for schema evolution purposes" $-            optional $ json "Value",-          "order">:-            doc "specifies how this field impacts sort ordering of this record" $-            optional $ avro "Order",-          "aliases">:-            doc "a JSON array of strings, providing alternate names for this field" $-            optional $ list string,-          "annotations">:-            doc "Any additional key/value pairs attached to the field" $-            Types.map string $ json "Value"],--      def "Fixed" $-        record [-          "size">:-            doc "an integer, specifying the number of bytes per value"-            int32],--      def "Map" $-        record [-          "values">: avro "Schema"],--      def "Named" $-        record [-          "name">:-            doc "a string naming this schema"-            string,-          "namespace">:-            doc "a string that qualifies the name" $-            optional string,-          "aliases">:-            doc "a JSON array of strings, providing alternate names for this schema" $-            optional $ list string,-          "doc">:-            doc "a JSON string providing documentation to the user of this schema" $-            optional string,-          "type">: avro "NamedType",-          "annotations">:-            doc "Any additional key/value pairs attached to the type" $-            Types.map string $ json "Value"],--      def "NamedType" $-        union [-          "enum">: avro "Enum",-          "fixed">: avro "Fixed",-          "record">: avro "Record"],--      def "Order" $-        enum ["ascending", "descending", "ignore"],--      def "Primitive" $-        union [-          "null">:-            doc "no value" unit,-          "boolean">:-            doc "A binary value" unit,-          "int">:-            doc "32-bit signed integer" unit,-          "long">:-            doc "64-bit signed integer" unit,-          "float">:-            doc "single precision (32-bit) IEEE 754 floating-point number" unit,-          "double">:-            doc "double precision (64-bit) IEEE 754 floating-point number" unit,-          "bytes">:-            doc "sequence of 8-bit unsigned bytes" unit,-          "string">:-            doc "unicode character sequence" unit],--      def "Record" $-        record [-          "fields">:-            doc "a JSON array, listing fields" $-            list $ avro "Field"],--      def "Schema" $-        union [-          "array">: avro "Array",-          "map">: avro "Map",-          "named">: avro "Named",-          "primitive">: avro "Primitive",-          "reference">: -- Note: "reference" is not described in the Avro specification; this has been added-            doc "A reference by name to a previously defined type" string,-          "union">: avro "Union"-        ],--      def "Union" $-        list $ avro "Schema"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Csharp/Syntax.hs 
@@ -1,4430 +0,0 @@-module Hydra.Sources.Tier4.Ext.Csharp.Syntax where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Types as Types-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap---csharpSyntaxModule :: Module-csharpSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A C# syntax module based on the ANTLR grammar dated 02/07/2024 and available at:\n"-      ++ "  https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/language-specification/grammar")-  where-    ns = Namespace "hydra/ext/csharp/syntax"-    def = datatype ns-    csharp = typeref ns--    elements = lexicalElements ++ syntacticElements ++ unsafeElements--    lexicalElements = [--- // Source: §6.3.1 General--- DEFAULT  : 'default' ;--- NULL     : 'null' ;--- TRUE     : 'true' ;--- FALSE    : 'false' ;--- ASTERISK : '*' ;--- SLASH    : '/' ;------ // Source: §6.3.1 General--- input---     : input_section?---     ;------ input_section---     : input_section_part+---     ;------ input_section_part---     : input_element* New_Line---     | PP_Directive---     ;------ input_element---     : Whitespace---     | Comment---     | token---     ;------ // Source: §6.3.2 Line terminators--- New_Line---     : New_Line_Character---     | '\u000D\u000A'    // carriage return, line feed---     ;------ // Source: §6.3.3 Comments--- Comment---     : Single_Line_Comment---     | Delimited_Comment---     ;------ fragment Single_Line_Comment---     : '//' Input_Character*---     ;------ fragment Input_Character---     // anything but New_Line_Character---     : ~('\u000D' | '\u000A'   | '\u0085' | '\u2028' | '\u2029')---     ;------ fragment New_Line_Character---     : '\u000D'  // carriage return---     | '\u000A'  // line feed---     | '\u0085'  // next line---     | '\u2028'  // line separator---     | '\u2029'  // paragraph separator---     ;------ fragment Delimited_Comment---     : '/*' Delimited_Comment_Section* ASTERISK+ '/'---     ;------ fragment Delimited_Comment_Section---     : SLASH---     | ASTERISK* Not_Slash_Or_Asterisk---     ;------ fragment Not_Slash_Or_Asterisk---     : ~('/' | '*')    // Any except SLASH or ASTERISK---     ;------ // Source: §6.3.4 White space--- Whitespace---     : [\p{Zs}]  // any character with Unicode class Zs---     | '\u0009'  // horizontal tab---     | '\u000B'  // vertical tab---     | '\u000C'  // form feed---     ;------ // Source: §6.4.1 General--- token---     : identifier---     | keyword---     | Integer_Literal---     | Real_Literal---     | Character_Literal---     | String_Literal---     | operator_or_punctuator---     ;------ // Source: §6.4.2 Unicode character escape sequences--- fragment Unicode_Escape_Sequence---     : '\\u' Hex_Digit Hex_Digit Hex_Digit Hex_Digit---     | '\\U' Hex_Digit Hex_Digit Hex_Digit Hex_Digit---             Hex_Digit Hex_Digit Hex_Digit Hex_Digit---     ;------ // Source: §6.4.3 Identifiers--- identifier---     : Simple_Identifier---     | contextual_keyword---     ;--      def "Identifier" string,---- Simple_Identifier---     : Available_Identifier---     | Escaped_Identifier---     ;------ fragment Available_Identifier---     // excluding keywords or contextual keywords, see note below---     : Basic_Identifier---     ;------ fragment Escaped_Identifier---     // Includes keywords and contextual keywords prefixed by '@'.---     // See note below.---     : '@' Basic_Identifier---     ;------ fragment Basic_Identifier---     : Identifier_Start_Character Identifier_Part_Character*---     ;------ fragment Identifier_Start_Character---     : Letter_Character---     | Underscore_Character---     ;------ fragment Underscore_Character---     : '_'               // underscore---     | '\\u005' [fF]     // Unicode_Escape_Sequence for underscore---     | '\\U0000005' [fF] // Unicode_Escape_Sequence for underscore---     ;------ fragment Identifier_Part_Character---     : Letter_Character---     | Decimal_Digit_Character---     | Connecting_Character---     | Combining_Character---     | Formatting_Character---     ;------ fragment Letter_Character---     // Category Letter, all subcategories; category Number, subcategory letter.---     : [\p{L}\p{Nl}]---     // Only escapes for categories L & Nl allowed. See note below.---     | Unicode_Escape_Sequence---     ;------ fragment Combining_Character---     // Category Mark, subcategories non-spacing and spacing combining.---     : [\p{Mn}\p{Mc}]---     // Only escapes for categories Mn & Mc allowed. See note below.---     | Unicode_Escape_Sequence---     ;------ fragment Decimal_Digit_Character---     // Category Number, subcategory decimal digit.---     : [\p{Nd}]---     // Only escapes for category Nd allowed. See note below.---     | Unicode_Escape_Sequence---     ;------ fragment Connecting_Character---     // Category Punctuation, subcategory connector.---     : [\p{Pc}]---     // Only escapes for category Pc allowed. See note below.---     | Unicode_Escape_Sequence---     ;------ fragment Formatting_Character---     // Category Other, subcategory format.---     : [\p{Cf}]---     // Only escapes for category Cf allowed, see note below.---     | Unicode_Escape_Sequence---     ;------ // Source: §6.4.4 Keywords--- keyword---     : 'abstract' | 'as'       | 'base'       | 'bool'      | 'break'---     | 'byte'     | 'case'     | 'catch'      | 'char'      | 'checked'---     | 'class'    | 'const'    | 'continue'   | 'decimal'   | DEFAULT---     | 'delegate' | 'do'       | 'double'     | 'else'      | 'enum'---     | 'event'    | 'explicit' | 'extern'     | FALSE       | 'finally'---     | 'fixed'    | 'float'    | 'for'        | 'foreach'   | 'goto'---     | 'if'       | 'implicit' | 'in'         | 'int'       | 'interface'---     | 'internal' | 'is'       | 'lock'       | 'long'      | 'namespace'---     | 'new'      | NULL       | 'object'     | 'operator'  | 'out'---     | 'override' | 'params'   | 'private'    | 'protected' | 'public'---     | 'readonly' | 'ref'      | 'return'     | 'sbyte'     | 'sealed'---     | 'short'    | 'sizeof'   | 'stackalloc' | 'static'    | 'string'---     | 'struct'   | 'switch'   | 'this'       | 'throw'     | TRUE---     | 'try'      | 'typeof'   | 'uint'       | 'ulong'     | 'unchecked'---     | 'unsafe'   | 'ushort'   | 'using'      | 'virtual'   | 'void'---     | 'volatile' | 'while'---     ;--      def "Keyword" string,---- // Source: §6.4.4 Keywords--- contextual_keyword---     : 'add'    | 'alias'      | 'ascending' | 'async'     | 'await'---     | 'by'     | 'descending' | 'dynamic'   | 'equals'    | 'from'---     | 'get'    | 'global'     | 'group'     | 'into'      | 'join'---     | 'let'    | 'nameof'     | 'on'        | 'orderby'   | 'partial'---     | 'remove' | 'select'     | 'set'       | 'unmanaged' | 'value'---     | 'var'    | 'when'       | 'where'     | 'yield'---     ;------ // Source: §6.4.5.1 General--- literal---     : boolean_literal---     | Integer_Literal---     | Real_Literal---     | Character_Literal---     | String_Literal---     | null_literal---     ;--      def "Literal" $ union [-        "boolean">: boolean,-        "integer">: csharp "IntegerLiteral",-        "real">: bigfloat,-        "character">: string,-        "string">: string,-        "null">: unit],---- // Source: §6.4.5.2 Boolean literals--- boolean_literal---     : TRUE---     | FALSE---     ;------ // Source: §6.4.5.3 Integer literals--- Integer_Literal---     : Decimal_Integer_Literal---     | Hexadecimal_Integer_Literal---     | Binary_Integer_Literal---     ;--      def "IntegerLiteral" $ union [-        "decimal">: string,-        "hexadecimal">: string,-        "binary">: bigint]---- fragment Decimal_Integer_Literal---     : Decimal_Digit Decorated_Decimal_Digit* Integer_Type_Suffix?---     ;------ fragment Decorated_Decimal_Digit---     : '_'* Decimal_Digit---     ;------ fragment Decimal_Digit---     : '0'..'9'---     ;------ fragment Integer_Type_Suffix---     : 'U' | 'u' | 'L' | 'l' |---       'UL' | 'Ul' | 'uL' | 'ul' | 'LU' | 'Lu' | 'lU' | 'lu'---     ;------ fragment Hexadecimal_Integer_Literal---     : ('0x' | '0X') Decorated_Hex_Digit+ Integer_Type_Suffix?---     ;------ fragment Decorated_Hex_Digit---     : '_'* Hex_Digit---     ;------ fragment Hex_Digit---     : '0'..'9' | 'A'..'F' | 'a'..'f'---     ;------ fragment Binary_Integer_Literal---     : ('0b' | '0B') Decorated_Binary_Digit+ Integer_Type_Suffix?---     ;------ fragment Decorated_Binary_Digit---     : '_'* Binary_Digit---     ;------ fragment Binary_Digit---     : '0' | '1'---     ;------ // Source: §6.4.5.4 Real literals--- Real_Literal---     : Decimal_Digit Decorated_Decimal_Digit* '.'---       Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix?---     | '.' Decimal_Digit Decorated_Decimal_Digit* Exponent_Part? Real_Type_Suffix?---     | Decimal_Digit Decorated_Decimal_Digit* Exponent_Part Real_Type_Suffix?---     | Decimal_Digit Decorated_Decimal_Digit* Real_Type_Suffix---     ;------ fragment Exponent_Part---     : ('e' | 'E') Sign? Decimal_Digit Decorated_Decimal_Digit*---     ;------ fragment Sign---     : '+' | '-'---     ;------ fragment Real_Type_Suffix---     : 'F' | 'f' | 'D' | 'd' | 'M' | 'm'---     ;------ // Source: §6.4.5.5 Character literals--- Character_Literal---     : '\'' Character '\''---     ;------ fragment Character---     : Single_Character---     | Simple_Escape_Sequence---     | Hexadecimal_Escape_Sequence---     | Unicode_Escape_Sequence---     ;------ fragment Single_Character---     // anything but ', \, and New_Line_Character---     : ~['\\\u000D\u000A\u0085\u2028\u2029]---     ;------ fragment Simple_Escape_Sequence---     : '\\\'' | '\\"' | '\\\\' | '\\0' | '\\a' | '\\b' |---       '\\f' | '\\n' | '\\r' | '\\t' | '\\v'---     ;------ fragment Hexadecimal_Escape_Sequence---     : '\\x' Hex_Digit Hex_Digit? Hex_Digit? Hex_Digit?---     ;------ // Source: §6.4.5.6 String literals--- String_Literal---     : Regular_String_Literal---     | Verbatim_String_Literal---     ;------ fragment Regular_String_Literal---     : '"' Regular_String_Literal_Character* '"'---     ;------ fragment Regular_String_Literal_Character---     : Single_Regular_String_Literal_Character---     | Simple_Escape_Sequence---     | Hexadecimal_Escape_Sequence---     | Unicode_Escape_Sequence---     ;------ fragment Single_Regular_String_Literal_Character---     // anything but ", \, and New_Line_Character---     : ~["\\\u000D\u000A\u0085\u2028\u2029]---     ;------ fragment Verbatim_String_Literal---     : '@"' Verbatim_String_Literal_Character* '"'---     ;------ fragment Verbatim_String_Literal_Character---     : Single_Verbatim_String_Literal_Character---     | Quote_Escape_Sequence---     ;------ fragment Single_Verbatim_String_Literal_Character---     : ~["]     // anything but quotation mark (U+0022)---     ;------ fragment Quote_Escape_Sequence---     : '""'---     ;------ // Source: §6.4.5.7 The null literal--- null_literal---     : NULL---     ;------ // Source: §6.4.6 Operators and punctuators--- operator_or_punctuator---     : '{'  | '}'  | '['  | ']'  | '('   | ')'  | '.'  | ','  | ':'  | ';'---     | '+'  | '-'  | ASTERISK    | SLASH | '%'  | '&'  | '|'  | '^'  | '!' | '~'---     | '='  | '<'  | '>'  | '?'  | '??'  | '::' | '++' | '--' | '&&' | '||'---     | '->' | '==' | '!=' | '<=' | '>='  | '+=' | '-=' | '*=' | '/=' | '%='---     | '&=' | '|=' | '^=' | '<<' | '<<=' | '=>'---     ;------ right_shift---     : '>'  '>'---     ;------ right_shift_assignment---     : '>' '>='---     ;------ // Source: §6.5.1 General--- PP_Directive---     : PP_Start PP_Kind PP_New_Line---     ;------ fragment PP_Kind---     : PP_Declaration---     | PP_Conditional---     | PP_Line---     | PP_Diagnostic---     | PP_Region---     | PP_Pragma---     | PP_Nullable---     ;------ // Only recognised at the beginning of a line--- fragment PP_Start---     // See note below.---     : { getCharPositionInLine() == 0 }? PP_Whitespace? '#' PP_Whitespace?---     ;------ fragment PP_Whitespace---     : ( [\p{Zs}]  // any character with Unicode class Zs---       | '\u0009'  // horizontal tab---       | '\u000B'  // vertical tab---       | '\u000C'  // form feed---       )+---     ;------ fragment PP_New_Line---     : PP_Whitespace? Single_Line_Comment? New_Line---     ;------ // Source: §6.5.2 Conditional compilation symbols--- fragment PP_Conditional_Symbol---     // Must not be equal to tokens TRUE or FALSE. See note below.---     : Basic_Identifier---     ;------ // Source: §6.5.3 Pre-processing expressions--- fragment PP_Expression---     : PP_Whitespace? PP_Or_Expression PP_Whitespace?---     ;------ fragment PP_Or_Expression---     : PP_And_Expression (PP_Whitespace? '||' PP_Whitespace? PP_And_Expression)*---     ;------ fragment PP_And_Expression---     : PP_Equality_Expression (PP_Whitespace? '&&' PP_Whitespace?---       PP_Equality_Expression)*---     ;------ fragment PP_Equality_Expression---     : PP_Unary_Expression (PP_Whitespace? ('==' | '!=') PP_Whitespace?---       PP_Unary_Expression)*---     ;------ fragment PP_Unary_Expression---     : PP_Primary_Expression---     | '!' PP_Whitespace? PP_Unary_Expression---     ;------ fragment PP_Primary_Expression---     : TRUE---     | FALSE---     | PP_Conditional_Symbol---     | '(' PP_Whitespace? PP_Expression PP_Whitespace? ')'---     ;------ // Source: §6.5.4 Definition directives--- fragment PP_Declaration---     : 'define' PP_Whitespace PP_Conditional_Symbol---     | 'undef' PP_Whitespace PP_Conditional_Symbol---     ;------ // Source: §6.5.5 Conditional compilation directives--- fragment PP_Conditional---     : PP_If_Section---     | PP_Elif_Section---     | PP_Else_Section---     | PP_Endif---     ;------ fragment PP_If_Section---     : 'if' PP_Whitespace PP_Expression---     ;------ fragment PP_Elif_Section---     : 'elif' PP_Whitespace PP_Expression---     ;------ fragment PP_Else_Section---     : 'else'---     ;------ fragment PP_Endif---     : 'endif'---     ;------ // Source: §6.5.6 Diagnostic directives--- fragment PP_Diagnostic---     : 'error' PP_Message?---     | 'warning' PP_Message?---     ;------ fragment PP_Message---     : PP_Whitespace Input_Character*---     ;------ // Source: §6.5.7 Region directives--- fragment PP_Region---     : PP_Start_Region---     | PP_End_Region---     ;------ fragment PP_Start_Region---     : 'region' PP_Message?---     ;------ fragment PP_End_Region---     : 'endregion' PP_Message?---     ;------ // Source: §6.5.8 Line directives--- fragment PP_Line---     : 'line' PP_Whitespace PP_Line_Indicator---     ;------ fragment PP_Line_Indicator---     : Decimal_Digit+ PP_Whitespace PP_Compilation_Unit_Name---     | Decimal_Digit+---     | DEFAULT---     | 'hidden'---     ;------ fragment PP_Compilation_Unit_Name---     : '"' PP_Compilation_Unit_Name_Character+ '"'---     ;------ fragment PP_Compilation_Unit_Name_Character---     // Any Input_Character except "---     : ~('\u000D' | '\u000A'   | '\u0085' | '\u2028' | '\u2029' | '#')---     ;------ // Source: §6.5.9 Nullable directive--- fragment PP_Nullable---     : 'nullable' PP_Whitespace PP_Nullable_Action (PP_Whitespace PP_Nullable_Target)?---     ;--- fragment PP_Nullable_Action---     : 'disable'---     | 'enable'---     | 'restore'---     ;--- fragment PP_Nullable_Target---     : 'warnings'---     | 'annotations'---     ;------ // Source: §6.5.10 Pragma directives--- fragment PP_Pragma---     : 'pragma' PP_Pragma_Text?---     ;------ fragment PP_Pragma_Text---     : PP_Whitespace Input_Character*---     ;-      ]--    syntacticElements = [--- // Source: §7.8.1 General--- namespace_name---     : namespace_or_type_name---     ;--      def "NamespaceName" $ csharp "NamespaceOrTypeName",---- type_name---     : namespace_or_type_name---     ;--      def "TypeName" $ csharp "NamespaceOrTypeName",---- namespace_or_type_name---     : identifier type_argument_list?---     | namespace_or_type_name '.' identifier type_argument_list?---     | qualified_alias_member---     ;--        def "NamespaceOrTypeName" $ union [-          "identifier">: csharp "IdentifierNamespaceOrTypeName",-          "qualified">: csharp "QualifiedNamespaceOrTypeName",-          "alias">: csharp "QualifiedAliasMember"],--        def "IdentifierNamespaceOrTypeName" $ record [-          "identifier">: csharp "Identifier",-          "arguments">: optional $ csharp "TypeArgumentList"],--       def "QualifiedNamespaceOrTypeName" $ record [-          "namespaceOrType">: csharp "NamespaceOrTypeName",-          "identifier">: csharp "Identifier",-          "arguments">: optional $ csharp "TypeArgumentList"],---- // Source: §8.1 General--- type---     : reference_type---     | value_type---     | type_parameter---     | pointer_type     // unsafe code support---     ;--      def "Type" $ union [-        "reference">: csharp "ReferenceType",-        "value">: csharp "ValueType",-        "param">: csharp "TypeParameter",-        "pointer">: csharp "PointerType"],---- // Source: §8.2.1 General--- reference_type---     : class_type---     | interface_type---     | array_type---     | delegate_type---     | 'dynamic'---     ;--      def "ReferenceType" $ union [-        "class">: csharp "ClassType",-        "interface">: csharp "InterfaceType",-        "array">: csharp "ArrayType",-        "delegate">: csharp "DelegateType",-        "dynamic">: unit],---- class_type---     : type_name---     | 'object'---     | 'string'---     ;--      def "ClassType" $ union [-        "typeName">: csharp "TypeName",-        "object">: unit,-        "string">: unit],---- interface_type---     : type_name---     ;--      def "InterfaceType" $ csharp "TypeName",---- array_type---     : non_array_type rank_specifier+---     ;--      def "ArrayType" $ record [-        "type">: csharp "NonArrayType",-        "rank">: list $ csharp "RankSpecifier"],---- non_array_type---     : value_type---     | class_type---     | interface_type---     | delegate_type---     | 'dynamic'---     | type_parameter---     | pointer_type      // unsafe code support---     ;--      def "NonArrayType" $ union [-        "value">: csharp "ValueType",-        "class">: csharp "ClassType",-        "interface">: csharp "InterfaceType",-        "delegate">: csharp "DelegateType",-        "dynamic">: unit,-        "parameter">: csharp "TypeParameter",-        "pointer">: csharp "PointerType"],---- rank_specifier---     : '[' ','* ']'---     ;--      def "RankSpecifier" int32, -- Note: non-negative---- delegate_type---     : type_name---     ;--      def "DelegateType" $ csharp "TypeName",---- // Source: §8.3.1 General--- value_type---     : non_nullable_value_type---     | nullable_value_type---     ;--      def "ValueType" $ union [-        "nonNullable">: csharp "StructOrEnumType",-        "nullable">: csharp "StructOrEnumType"],---- non_nullable_value_type---     : struct_type---     | enum_type---     ;--      def "StructOrEnumType" $ union [-        "struct">: csharp "StructType",-        "enum">: csharp "EnumType"],---- struct_type---     : type_name---     | simple_type---     | tuple_type---     ;--      def "StructType" $ union [-        "typeName">: csharp "TypeName",-        "simple">: csharp "SimpleType",-        "tuple">: csharp "TupleType"],---- simple_type---     : numeric_type---     | 'bool'---     ;--      def "SimpleType" $ union [-        "numeric">: csharp "NumericType",-        "bool">: unit],---- numeric_type---     : integral_type---     | floating_point_type---     | 'decimal'---     ;--      def "NumericType" $ union [-        "integral">: csharp "IntegralType",-        "floatingPoint">: csharp "FloatingPointType",-        "decimal">: unit],---- integral_type---     : 'sbyte'---     | 'byte'---     | 'short'---     | 'ushort'---     | 'int'---     | 'uint'---     | 'long'---     | 'ulong'---     | 'char'---     ;--      def "IntegralType" $ union [-        "sbyte">: unit,-        "byte">: unit,-        "short">: unit,-        "ushort">: unit,-        "int">: unit,-        "uint">: unit,-        "long">: unit,-        "ulong">: unit,-        "char">: unit],---- floating_point_type---     : 'float'---     | 'double'---     ;--      def "FloatingPointType" $ union [-        "float">: unit,-        "double">: unit],---- tuple_type---     : '(' tuple_type_element (',' tuple_type_element)+ ')'---     ;--      def "TupleType" $ nonemptyList $ csharp "TupleTypeElement",---- tuple_type_element---     : type identifier?---     ;--      def "TupleTypeElement" $ record [-        "type">: csharp "Type",-        "identifier">: optional $ csharp "Identifier"],---- enum_type---     : type_name---     ;--      def "EnumType" $ csharp "TypeName",---- nullable_value_type---     : non_nullable_value_type '?'---     ;------ // Source: §8.4.2 Type arguments--- type_argument_list---     : '<' type_arguments '>'---     ;--      def "TypeArgumentList" $ list $ csharp "Type",---- type_arguments---     : type_argument (',' type_argument)*---     ;------ type_argument---     : type---     ;------ // Source: §8.5 Type parameters--- type_parameter---     : identifier---     ;--      def "TypeParameter" $ csharp "Identifier",---- // Source: §8.8 Unmanaged types--- unmanaged_type---     : value_type---     | pointer_type     // unsafe code support---     ;--      def "UnmanagedType" $ union [-        "value">: csharp "ValueType",-        "pointer">: csharp "PointerType"],---- // Source: §9.5 Variable references--- variable_reference---     : expression---     ;--      def "VariableReference" $ csharp "Expression",---- // Source: §11.2.1 General--- pattern---     : declaration_pattern---     | constant_pattern---     | var_pattern---     ;--      def "Pattern" $ union [-        "declaration">: csharp "DeclarationPattern",-        "constant">: csharp "Expression",-        "var">: csharp "Designation"],---- // Source: §11.2.2 Declaration pattern--- declaration_pattern---     : type simple_designation---     ;--      def "DeclarationPattern" $ record [-        "type">: csharp "Type",-        "designation">: csharp "Designation"],---- simple_designation---     : single_variable_designation---     ;--      def "Designation" $ csharp "Identifier",---- single_variable_designation---     : identifier---     ;------ // Source: §11.2.3 Constant pattern--- constant_pattern---     : constant_expression---     ;------ // Source: §11.2.4 Var pattern--- var_pattern---     : 'var' designation---     ;--- designation---     : simple_designation---     ;------ // Source: §12.6.2.1 General--- argument_list---     : argument (',' argument)*---     ;--      def "ArgumentList" $ nonemptyList $ csharp "Argument",---- argument---     : argument_name? argument_value---     ;--      def "Argument" $ record [-        "name">: optional $ csharp "Identifier",-        "value">: csharp "ArgumentValue"],---- argument_name---     : identifier ':'---     ;------ argument_value---     : expression---     | 'in' variable_reference---     | 'ref' variable_reference---     | 'out' variable_reference---     ;--      def "ArgumentValue" $ union [-        "expression">: csharp "Expression",-        "in">: csharp "VariableReference",-        "ref">: csharp "VariableReference",-        "out">: csharp "VariableReference"],---- // Source: §12.8.1 General--- primary_expression---     : primary_no_array_creation_expression---     | array_creation_expression---     ;--      def "PrimaryExpression" $ union [-        "noArray">: csharp "PrimaryNoArrayCreationExpression",-        "array">: csharp "ArrayCreationExpression"],---- primary_no_array_creation_expression---     : literal---     | interpolated_string_expression---     | simple_name---     | parenthesized_expression---     | tuple_expression---     | member_access---     | null_conditional_member_access---     | invocation_expression---     | element_access---     | null_conditional_element_access---     | this_access---     | base_access---     | post_increment_expression---     | post_decrement_expression---     | object_creation_expression---     | delegate_creation_expression---     | anonymous_object_creation_expression---     | typeof_expression---     | sizeof_expression---     | checked_expression---     | unchecked_expression---     | default_value_expression---     | nameof_expression---     | anonymous_method_expression---     | pointer_member_access     // unsafe code support---     | pointer_element_access    // unsafe code support---     | stackalloc_expression---     ;--      def "PrimaryNoArrayCreationExpression" $ union [-        "literal">: csharp "Literal",-        "interpolatedString">: csharp "InterpolatedStringExpression",-        "simpleName">: csharp "SimpleName",-        "parenthesized">: csharp "Expression",-        "tuple">: csharp "TupleExpression",-        "memberAccess">: csharp "MemberAccess",-        "nullConditionalMemberAccess">: csharp "NullConditionalMemberAccess",-        "invocation">: csharp "InvocationExpression",-        "elementAccess">: csharp "ElementAccess",-        "nullConditionalElementAccess">: csharp "NullConditionalElementAccess",-        "thisAccess">: unit,-        "baseAccess">: csharp "BaseAccess",-        "postIncrement">: csharp "PrimaryExpression",-        "postDecrement">: csharp "PrimaryExpression",-        "objectCreation">: csharp "ObjectCreationExpression",-        "delegateCreation">: csharp "DelegateCreationExpression",-        "anonymousObjectCreation">: optional $ csharp "MemberDeclaratorList",-        "typeof">: csharp "TypeofExpression",-        "sizeof">: csharp "UnmanagedType",-        "checked">: csharp "Expression",-        "unchecked">: csharp "Expression",-        "defaultValue">: csharp "DefaultValueExpression",-        "nameof">: csharp "NamedEntity",-        "anonymousMethod">: csharp "AnonymousMethodExpression",-        "pointerMemberAccess">: csharp "PointerMemberAccess",-        "pointerElementAccess">: csharp "PointerElementAccess",-        "stackalloc">: csharp "StackallocExpression"],---- // Source: §12.8.3 Interpolated string expressions--- interpolated_string_expression---     : interpolated_regular_string_expression---     | interpolated_verbatim_string_expression---     ;--      def "InterpolatedStringExpression" $ union [-        "regular">: csharp "InterpolatedRegularStringExpression",-        "verbatim">: csharp "InterpolatedVerbatimStringExpression"],---- // interpolated regular string expressions------ interpolated_regular_string_expression---     : Interpolated_Regular_String_Start Interpolated_Regular_String_Mid?---       ('{' regular_interpolation '}' Interpolated_Regular_String_Mid?)*---       Interpolated_Regular_String_End---     ;--      def "InterpolatedRegularStringExpression" string,---- regular_interpolation---     : expression (',' interpolation_minimum_width)?---       Regular_Interpolation_Format?---     ;--      def "RegularInterpolation" $ record [-        "expression">: csharp "Expression",-        "width">: optional $ csharp "Expression",-        "format">: optional string],---- interpolation_minimum_width---     : constant_expression---     ;------ Interpolated_Regular_String_Start---     : '$"'---     ;------ // the following three lexical rules are context sensitive, see details below------ Interpolated_Regular_String_Mid---     : Interpolated_Regular_String_Element+---     ;------ Regular_Interpolation_Format---     : ':' Interpolated_Regular_String_Element+---     ;------ Interpolated_Regular_String_End---     : '"'---     ;------ fragment Interpolated_Regular_String_Element---     : Interpolated_Regular_String_Character---     | Simple_Escape_Sequence---     | Hexadecimal_Escape_Sequence---     | Unicode_Escape_Sequence---     | Open_Brace_Escape_Sequence---     | Close_Brace_Escape_Sequence---     ;------ fragment Interpolated_Regular_String_Character---     // Any character except " (U+0022), \\ (U+005C),---     // { (U+007B), } (U+007D), and New_Line_Character.---     : ~["\\{}\u000D\u000A\u0085\u2028\u2029]---     ;------ // interpolated verbatim string expressions------ interpolated_verbatim_string_expression---     : Interpolated_Verbatim_String_Start Interpolated_Verbatim_String_Mid?---       ('{' verbatim_interpolation '}' Interpolated_Verbatim_String_Mid?)*---       Interpolated_Verbatim_String_End---     ;--      def "InterpolatedVerbatimStringExpression" string,---- verbatim_interpolation---     : expression (',' interpolation_minimum_width)?---       Verbatim_Interpolation_Format?---     ;--      def "VerbatimInterpolation" $ record [-        "expression">: csharp "Expression",-        "width">: optional $ csharp "ConstantExpression",-        "format">: optional string],---- Interpolated_Verbatim_String_Start---     : '$@"'---     | '@$"'---     ;------ // the following three lexical rules are context sensitive, see details below------ Interpolated_Verbatim_String_Mid---     : Interpolated_Verbatim_String_Element+---     ;------ Verbatim_Interpolation_Format---     : ':' Interpolated_Verbatim_String_Element+---     ;------ Interpolated_Verbatim_String_End---     : '"'---     ;------ fragment Interpolated_Verbatim_String_Element---     : Interpolated_Verbatim_String_Character---     | Quote_Escape_Sequence---     | Open_Brace_Escape_Sequence---     | Close_Brace_Escape_Sequence---     ;------ fragment Interpolated_Verbatim_String_Character---     : ~["{}]    // Any character except " (U+0022), { (U+007B) and } (U+007D)---     ;------ // lexical fragments used by both regular and verbatim interpolated strings------ fragment Open_Brace_Escape_Sequence---     : '{{'---     ;------ fragment Close_Brace_Escape_Sequence---     : '}}'---     ;------ // Source: §12.8.4 Simple names--- simple_name---     : identifier type_argument_list?---     ;--      def "SimpleName" $ record [-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- // Source: §12.8.5 Parenthesized expressions--- parenthesized_expression---     : '(' expression ')'---     ;------ // Source: §12.8.6 Tuple expressions--- tuple_expression---     : '(' tuple_element (',' tuple_element)+ ')'---     | deconstruction_expression---     ;--      def "TupleExpression" $ union [-        "elements">: nonemptyList $ csharp "TupleElement",-        "deconstruction">: csharp "DeconstructionTuple"],---- tuple_element---     : (identifier ':')? expression---     ;--      def "TupleElement" $ record [-        "name">: optional $ csharp "Identifier",-        "expression">: csharp "Expression"],---- deconstruction_expression---     : 'var' deconstruction_tuple---     ;------ deconstruction_tuple---     : '(' deconstruction_element (',' deconstruction_element)+ ')'---     ;--      def "DeconstructionTuple" $ nonemptyList $ csharp "DeconstructionElement",---- deconstruction_element---     : deconstruction_tuple---     | identifier---     ;--      def "DeconstructionElement" $ union [-        "tuple">: csharp "DeconstructionTuple",-        "identifier">: csharp "Identifier"],---- // Source: §12.8.7.1 General--- member_access---     : primary_expression '.' identifier type_argument_list?---     | predefined_type '.' identifier type_argument_list?---     | qualified_alias_member '.' identifier type_argument_list?---     ;--      def "MemberAccess" $ record [-        "head">: csharp "MemberAccessHead",-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],--      def "MemberAccessHead" $ union [-        "primary">: csharp "PrimaryExpression",-        "predefined">: csharp "PredefinedType",-        "qualifiedAlias">: csharp "QualifiedAliasMember"],---- predefined_type---     : 'bool' | 'byte' | 'char' | 'decimal' | 'double' | 'float' | 'int'---     | 'long' | 'object' | 'sbyte' | 'short' | 'string' | 'uint' | 'ulong'---     | 'ushort'---     ;--      def "PredefinedType" $ enum [-        "bool", "byte", "char", "decimal", "double", "float", "int", "long", "object", "sbyte", "short", "string",-         "uint", "ulong", "ushort"],---- // Source: §12.8.8 Null Conditional Member Access--- null_conditional_member_access---     : primary_expression '?' '.' identifier type_argument_list?---       dependent_access*---     ;--      def "NullConditionalMemberAccess" $ record [-        "expression">: csharp "PrimaryExpression",-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList",-        "dependentAccess">: list $ csharp "DependentAccess"],---- dependent_access---     : '.' identifier type_argument_list?    // member access---     | '[' argument_list ']'                 // element access---     | '(' argument_list? ')'                // invocation---     ;--      def "DependentAccess" $ union [-        "memberAccess">: csharp "DependentAccessForMember",-        "elementAccess">: csharp "ArgumentList",-        "invocation">: optional $ csharp "ArgumentList"],--      def "DependentAccessForMember" $ record [-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- null_conditional_projection_initializer---     : primary_expression '?' '.' identifier type_argument_list?---     ;--      def "NullConditionalProjectionInitializer" $ record [-        "expression">: csharp "PrimaryExpression",-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- // Source: §12.8.9.1 General--- invocation_expression---     : primary_expression '(' argument_list? ')'---     ;--      def "InvocationExpression" $ record [-        "expression">: csharp "PrimaryExpression",-        "arguments">: optional $ csharp "ArgumentList"],---- // Source: §12.8.10 Null Conditional Invocation Expression--- null_conditional_invocation_expression---     : null_conditional_member_access '(' argument_list? ')'---     | null_conditional_element_access '(' argument_list? ')'---     ;--      def "NullConditionalInvocationExpression" $ record [-        "head">: csharp "NullConditionalInvocationExpressionHead",-        "arguments">: optional $ csharp "ArgumentList"],--      def "NullConditionalInvocationExpressionHead" $ union [-        "member">: csharp "NullConditionalMemberAccess",-        "element">: csharp "NullConditionalElementAccess"],---- // Source: §12.8.11.1 General--- element_access---     : primary_no_array_creation_expression '[' argument_list ']'---     ;--      def "ElementAccess" $ record [-        "expression">: csharp "PrimaryNoArrayCreationExpression",-        "arguments">: csharp "ArgumentList"],---- // Source: §12.8.12 Null Conditional Element Access--- null_conditional_element_access---     : primary_no_array_creation_expression '?' '[' argument_list ']'---       dependent_access*---     ;--      def "NullConditionalElementAccess" $ record [-        "expression">: csharp "PrimaryNoArrayCreationExpression",-        "arguments">: csharp "ArgumentList",-        "dependentAccess">: list $ csharp "DependentAccess"],---- // Source: §12.8.13 This access--- this_access---     : 'this'---     ;------ // Source: §12.8.14 Base access--- base_access---     : 'base' '.' identifier type_argument_list?---     | 'base' '[' argument_list ']'---     ;--      def "BaseAccess" $ union [-        "identifier">: csharp "BaseAccessWithIdentifier",-        "arguments">: csharp "ArgumentList"],--      def "BaseAccessWithIdentifier" $ record [-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- // Source: §12.8.15 Postfix increment and decrement operators--- post_increment_expression---     : primary_expression '++'---     ;------ post_decrement_expression---     : primary_expression '--'---     ;------ // Source: §12.8.16.2 Object creation expressions--- object_creation_expression---     : 'new' type '(' argument_list? ')' object_or_collection_initializer?---     | 'new' type object_or_collection_initializer---     ;--      def "ObjectCreationExpression" $ record [-        "type">: csharp "Type",-        "arguments">: optional $ csharp "ArgumentList",-        "initializer">: optional $ csharp "ObjectOrCollectionInitializer"],---- object_or_collection_initializer---     : object_initializer---     | collection_initializer---     ;--      def "ObjectOrCollectionInitializer" $ union [-        "object">: list $ csharp "MemberInitializer",-        "collection">: list $ csharp "ElementInitializer"],---- // Source: §12.8.16.3 Object initializers--- object_initializer---     : '{' member_initializer_list? '}'---     | '{' member_initializer_list ',' '}'---     ;------ member_initializer_list---     : member_initializer (',' member_initializer)*---     ;------ member_initializer---     : initializer_target '=' initializer_value---     ;--      def "MemberInitializer" $ record [-        "target">: csharp "InitializerTarget",-        "value">: csharp "InitializerValue"],---- initializer_target---     : identifier---     | '[' argument_list ']'---     ;--      def "InitializerTarget" $ union [-        "identifier">: csharp "Identifier",-        "arguments">: csharp "ArgumentList"],---- initializer_value---     : expression---     | object_or_collection_initializer---     ;--      def "InitializerValue" $ union [-        "expression">: csharp "Expression",-        "objectOrCollection">: csharp "ObjectOrCollectionInitializer"],---- // Source: §12.8.16.4 Collection initializers--- collection_initializer---     : '{' element_initializer_list '}'---     | '{' element_initializer_list ',' '}'---     ;------ element_initializer_list---     : element_initializer (',' element_initializer)*---     ;------ element_initializer---     : non_assignment_expression---     | '{' expression_list '}'---     ;--      def "ElementInitializer" $ union [-        "single">: csharp "NonAssignmentExpression",-        "list">: csharp "ExpressionList"],---- expression_list---     : expression---     | expression_list ',' expression---     ;--      def "ExpressionList" $ nonemptyList $ csharp "Expression",---- // Source: §12.8.16.5 Array creation expressions--- array_creation_expression---     : 'new' non_array_type '[' expression_list ']' rank_specifier*---       array_initializer?---     | 'new' array_type array_initializer---     | 'new' rank_specifier array_initializer---     ;--      def "ArrayCreationExpression" $ union [-        "nonArrayType">: csharp "NonArrayTypeArrayCreationExpression",-        "arrayType">: csharp "ArrayTypeArrayCreationExpression",-        "rankSpecifier">: csharp "RankSpecifierArrayCreationExpression"],--      def "NonArrayTypeArrayCreationExpression" $ record [-        "type">: csharp "NonArrayType",-        "expressions">: csharp "ExpressionList",-        "rankSpecifiers">: list $ csharp "RankSpecifier",-        "initializer">: optional $ csharp "ArrayInitializer"],--      def "ArrayTypeArrayCreationExpression" $ record [-        "type">: csharp "ArrayType",-        "initializer">: csharp "ArrayInitializer"],--      def "RankSpecifierArrayCreationExpression" $ record [-        "rankSpecifier">: csharp "RankSpecifier",-        "initializer">: csharp "ArrayInitializer"],---- // Source: §12.8.16.6 Delegate creation expressions--- delegate_creation_expression---     : 'new' delegate_type '(' expression ')'---     ;--      def "DelegateCreationExpression" $ record [-        "type">: csharp "DelegateType",-        "expression">: csharp "Expression"],---- // Source: §12.8.16.7 Anonymous object creation expressions--- anonymous_object_creation_expression---     : 'new' anonymous_object_initializer---     ;------ anonymous_object_initializer---     : '{' member_declarator_list? '}'---     | '{' member_declarator_list ',' '}'---     ;------ member_declarator_list---     : member_declarator (',' member_declarator)*---     ;--      def "MemberDeclaratorList" $ nonemptyList $ csharp "MemberDeclarator",---- member_declarator---     : simple_name---     | member_access---     | null_conditional_projection_initializer---     | base_access---     | identifier '=' expression---     ;--      def "MemberDeclarator" $ union [-        "name">: csharp "SimpleName",-        "memberAccess">: csharp "MemberAccess",-        "nullConditionalProjectionInitializer">: csharp "NullConditionalProjectionInitializer",-        "baseAccess">: csharp "BaseAccess",-        "assignment">: csharp "AssignmentMemberDeclarator"],--      def "AssignmentMemberDeclarator" $ record [-        "identifier">: csharp "Identifier",-        "expression">: csharp "Expression"],---- // Source: §12.8.17 The typeof operator--- typeof_expression---     : 'typeof' '(' type ')'---     | 'typeof' '(' unbound_type_name ')'---     | 'typeof' '(' 'void' ')'---     ;--      def "TypeofExpression" $ union [-        "type">: csharp "Type",-        "unboundTypeName">: csharp "UnboundTypeName",-        "void">: unit],---- unbound_type_name---     : identifier generic_dimension_specifier?---     | identifier '::' identifier generic_dimension_specifier?---     | unbound_type_name '.' identifier generic_dimension_specifier?---     ;--      def "UnboundTypeName" $ nonemptyList $ csharp "UnboundTypeNamePart",--      def "UnboundTypeNamePart" $ record [-        "identifier">: csharp "Identifier",-        "aliased">: boolean,-        "dimension">: optional int32], -- Note: non-negative---- generic_dimension_specifier---     : '<' comma* '>'---     ;--- comma---     : ','---     ;--------- // Source: §12.8.18 The sizeof operator--- sizeof_expression---     : 'sizeof' '(' unmanaged_type ')'---     ;------ // Source: §12.8.19 The checked and unchecked operators--- checked_expression---     : 'checked' '(' expression ')'---     ;------ unchecked_expression---     : 'unchecked' '(' expression ')'---     ;------ // Source: §12.8.20 Default value expressions--- default_value_expression---     : explictly_typed_default---     | default_literal---     ;--      def "DefaultValueExpression" $ union [-        "explicitlyTyped">: csharp "Type",-        "defaultLiteral">: unit],---- explictly_typed_default---     : 'default' '(' type ')'---     ;------ default_literal---     : 'default'---     ;------ // Source: §12.8.21 Stack allocation--- stackalloc_expression---     : 'stackalloc' unmanaged_type '[' expression ']'---     | 'stackalloc' unmanaged_type? '[' constant_expression? ']'---       stackalloc_initializer---     ;--      def "StackallocExpression" $ record [-        "type">: optional $ csharp "UnmanagedType",-        "expression">: optional $ csharp "ConstantExpression",-        "initializer">: list $ csharp "Expression"],---- stackalloc_initializer---      : '{' stackalloc_initializer_element_list '}'---      ;------ stackalloc_initializer_element_list---      : stackalloc_element_initializer (',' stackalloc_element_initializer)* ','?---      ;------ stackalloc_element_initializer---     : expression---     ;------ // Source: §12.8.22 The nameof operator--- nameof_expression---     : 'nameof' '(' named_entity ')'---     ;------ named_entity---     : named_entity_target ('.' identifier type_argument_list?)*---     ;--      def "NamedEntity" $ record [-        "target">: csharp "NamedEntityTarget",-        "parts">: list $ csharp "NamedEntityPart"],--      def "NamedEntityPart" $ record [-        "identifier">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- named_entity_target---     : simple_name---     | 'this'---     | 'base'---     | predefined_type---     | qualified_alias_member---     ;--      def "NamedEntityTarget" $ union [-        "name">: csharp "SimpleName",-        "this">: unit,-        "base">: unit,-        "predefinedType">: csharp "PredefinedType",-        "qualifiedAliasMember">: csharp "QualifiedAliasMember"],---- // Source: §12.9.1 General--- unary_expression---     : primary_expression---     | '+' unary_expression---     | '-' unary_expression---     | '!' unary_expression---     | '~' unary_expression---     | pre_increment_expression---     | pre_decrement_expression---     | cast_expression---     | await_expression---     | pointer_indirection_expression    // unsafe code support---     | addressof_expression              // unsafe code support---     ;--      def "UnaryExpression" $ union [-        "primary">: csharp "PrimaryExpression",-        "plus">: csharp "UnaryExpression",-        "minus">: csharp "UnaryExpression",-        "not">: csharp "UnaryExpression",-        "bitwiseComplement">: csharp "UnaryExpression",-        "preIncrement">: csharp "UnaryExpression",-        "preDecrement">: csharp "UnaryExpression",-        "cast">: csharp "CastExpression",-        "await">: csharp "UnaryExpression",-        "pointerIndirection">: csharp "UnaryExpression",-        "addressOf">: csharp "UnaryExpression"],---- // Source: §12.9.6 Prefix increment and decrement operators--- pre_increment_expression---     : '++' unary_expression---     ;------ pre_decrement_expression---     : '--' unary_expression---     ;------ // Source: §12.9.7 Cast expressions--- cast_expression---     : '(' type ')' unary_expression---     ;--      def "CastExpression" $ record [-        "type">: csharp "Type",-        "expression">: csharp "UnaryExpression"],---- // Source: §12.9.8.1 General--- await_expression---     : 'await' unary_expression---     ;------ // Source: §12.10.1 General--- multiplicative_expression---     : unary_expression---     | multiplicative_expression '*' unary_expression---     | multiplicative_expression '/' unary_expression---     | multiplicative_expression '%' unary_expression---     ;--      def "MultiplicativeExpression" $ union [-        "simple">: csharp "UnaryExpression",-        "binary">: csharp "BinaryMultiplicativeExpression"],--      def "BinaryMultiplicativeExpression" $ record [-        "left">: csharp "MultiplicativeExpression",-        "operator">: csharp "MultiplicativeOperator",-        "right">: csharp "UnaryExpression"],--      def "MultiplicativeOperator" $ enum ["times", "divide", "modulo"],---- additive_expression---     : multiplicative_expression---     | additive_expression '+' multiplicative_expression---     | additive_expression '-' multiplicative_expression---     ;--      def "AdditiveExpression" $ union [-        "simple">: csharp "MultiplicativeExpression",-        "binary">: csharp "BinaryAdditiveExpression"],--      def "BinaryAdditiveExpression" $ record [-        "left">: csharp "AdditiveExpression",-        "operator">: csharp "AdditiveOperator",-        "right">: csharp "MultiplicativeExpression"],--      def "AdditiveOperator" $ enum ["plus", "minus"],---- // Source: §12.11 Shift operators--- shift_expression---     : additive_expression---     | shift_expression '<<' additive_expression---     | shift_expression right_shift additive_expression---     ;--      def "ShiftExpression" $ union [-        "simple">: csharp "AdditiveExpression",-        "binary">: csharp "BinaryShiftExpression"],--      def "BinaryShiftExpression" $ record [-        "left">: csharp "ShiftExpression",-        "operator">: csharp "ShiftOperator",-        "right">: csharp "AdditiveExpression"],--      def "ShiftOperator" $ enum ["left", "right"],---- // Source: §12.12.1 General--- relational_expression---     : shift_expression---     | relational_expression '<' shift_expression---     | relational_expression '>' shift_expression---     | relational_expression '<=' shift_expression---     | relational_expression '>=' shift_expression---     | relational_expression 'is' type---     | relational_expression 'is' pattern---     | relational_expression 'as' type---     ;--      def "RelationalExpression" $ union [-        "simple">: csharp "ShiftExpression",-        "binary">: csharp "BinaryRelationalExpression",-        "isType">: csharp "IsTypeExpression",-        "isPattern">: csharp "IsPatternExpression",-        "asType">: csharp "AsTypeExpression"],--      def "BinaryRelationalExpression" $ record [-       "left">: csharp "RelationalExpression",-        "operator">: csharp "RelationalOperator",-        "right">: csharp "ShiftExpression"],--      def "RelationalOperator" $ enum [-        "lessThan", "greaterThan", "lessThanOrEqual", "greaterThanOrEqual"],--      def "IsTypeExpression" $ record [-       "expression">: csharp "RelationalExpression",-        "type">: csharp "Type"],--      def "IsPatternExpression" $ record [-        "expression">: csharp "RelationalExpression",-        "pattern">: csharp "Pattern"],--      def "AsTypeExpression" $ record [-        "expression">: csharp "RelationalExpression",-        "type">: csharp "Type"],---- equality_expression---     : relational_expression---     | equality_expression '==' relational_expression---     | equality_expression '!=' relational_expression---     ;--      def "EqualityExpression" $ union [-        "simple">: csharp "RelationalExpression",-        "binary">: csharp "BinaryEqualityExpression"],--      def "BinaryEqualityExpression" $ record [-        "left">: csharp "EqualityExpression",-        "operator">: csharp "EqualityOperator",-        "right">: csharp "RelationalExpression"],--      def "EqualityOperator" $ enum ["equal", "notEqual"],---- // Source: §12.13.1 General--- and_expression---     : equality_expression---     | and_expression '&' equality_expression---     ;--      def "AndExpression" $ union [-        "simple">: csharp "EqualityExpression",-        "binary">: csharp "BinaryAndExpression"],--      def "BinaryAndExpression" $ record [-        "left">: csharp "AndExpression",-        "right">: csharp "EqualityExpression"],---- exclusive_or_expression---     : and_expression---     | exclusive_or_expression '^' and_expression---     ;--      def "ExclusiveOrExpression" $ union [-        "simple">: csharp "AndExpression",-        "binary">: csharp "BinaryExclusiveOrExpression"],--      def "BinaryExclusiveOrExpression" $ record [-        "left">: csharp "ExclusiveOrExpression",-        "right">: csharp "AndExpression"],---- inclusive_or_expression---     : exclusive_or_expression---     | inclusive_or_expression '|' exclusive_or_expression---     ;--      def "InclusiveOrExpression" $ union [-        "simple">: csharp "ExclusiveOrExpression",-        "binary">: csharp "BinaryInclusiveOrExpression"],--      def "BinaryInclusiveOrExpression" $ record [-        "left">: csharp "InclusiveOrExpression",-        "right">: csharp "ExclusiveOrExpression"],---- // Source: §12.14.1 General--- conditional_and_expression---     : inclusive_or_expression---     | conditional_and_expression '&&' inclusive_or_expression---     ;--      def "ConditionalAndExpression" $ union [-        "simple">: csharp "InclusiveOrExpression",-        "binary">: csharp "BinaryConditionalAndExpression"],--      def "BinaryConditionalAndExpression" $ record [-        "left">: csharp "ConditionalAndExpression",-        "right">: csharp "InclusiveOrExpression"],---- conditional_or_expression---     : conditional_and_expression---     | conditional_or_expression '||' conditional_and_expression---     ;--      def "ConditionalOrExpression" $ union [-        "simple">: csharp "ConditionalAndExpression",-        "binary">: csharp "BinaryConditionalOrExpression"],--      def "BinaryConditionalOrExpression" $ record [-        "left">: csharp "ConditionalOrExpression",-        "right">: csharp "ConditionalAndExpression"],---- // Source: §12.15 The null coalescing operator--- null_coalescing_expression---     : conditional_or_expression---     | conditional_or_expression '??' null_coalescing_expression---     | throw_expression---     ;--      def "NullCoalescingExpression" $ union [-        "simple">: csharp "ConditionalOrExpression",-        "binary">: csharp "BinaryNullCoalescingExpression",-        "throw">: csharp "NullCoalescingExpression"],--      def "BinaryNullCoalescingExpression" $ record [-        "left">: csharp "ConditionalOrExpression",-        "right">: csharp "NullCoalescingExpression"],---- // Source: §12.16 The throw expression operator--- throw_expression---     : 'throw' null_coalescing_expression---     ;------ // Source: §12.17 Declaration expressions--- declaration_expression---     : local_variable_type identifier---     ;--      def "DeclarationExpression" $ record [-        "type">: csharp "LocalVariableType",-        "identifier">: csharp "Identifier"],---- local_variable_type---     : type---     | 'var'---     ;--      def "LocalVariableType" $ union [-        "type">: csharp "Type",-        "var">: unit],---- // Source: §12.18 Conditional operator--- conditional_expression---     : null_coalescing_expression---     | null_coalescing_expression '?' expression ':' expression---     | null_coalescing_expression '?' 'ref' variable_reference ':'---       'ref' variable_reference---     ;--      def "ConditionalExpression" $ union [-        "simple">: csharp "NullCoalescingExpression",-        "simpleConditional">: csharp "SimpleConditionalExpression",-        "refConditional">: csharp "RefConditionalExpression"],--      def "SimpleConditionalExpression" $ record [-        "condition">: csharp "NullCoalescingExpression",-        "true">: csharp "Expression",-        "false">: csharp "Expression"],--      def "RefConditionalExpression" $ record [-        "condition">: csharp "NullCoalescingExpression",-        "true">: csharp "VariableReference",-        "false">: csharp "VariableReference"],---- // Source: §12.19.1 General--- lambda_expression---     : 'async'? anonymous_function_signature '=>' anonymous_function_body---     ;--      def "LambdaExpression" $ record [-        "async">: boolean,-        "signature">: csharp "AnonymousFunctionSignature",-        "body">: csharp "AnonymousFunctionBody"],---- anonymous_method_expression---     : 'async'? 'delegate' explicit_anonymous_function_signature? block---     ;--      def "AnonymousMethodExpression" $ record [-        "async">: boolean,-        "signature">: list $ csharp "ExplicitAnonymousFunctionParameter",-        "body">: csharp "Block"],---- anonymous_function_signature---     : explicit_anonymous_function_signature---     | implicit_anonymous_function_signature---     ;--      def "AnonymousFunctionSignature" $ union [-        "explicit">: list $ csharp "ExplicitAnonymousFunctionParameter",-        "implicit">: list $ csharp "Identifier"],---- explicit_anonymous_function_signature---     : '(' explicit_anonymous_function_parameter_list? ')'---     ;------ explicit_anonymous_function_parameter_list---     : explicit_anonymous_function_parameter---       (',' explicit_anonymous_function_parameter)*---     ;------ explicit_anonymous_function_parameter---     : anonymous_function_parameter_modifier? type identifier---     ;--      def "ExplicitAnonymousFunctionParameter" $ record [-        "modifier">: optional $ csharp "AnonymousFunctionParameterModifier",-        "type">: csharp "Type",-        "identifier">: csharp "Identifier"],---- anonymous_function_parameter_modifier---     : 'ref'---     | 'out'---     | 'in'---     ;--      def "AnonymousFunctionParameterModifier" $ enum [ "ref", "out", "in" ],---- implicit_anonymous_function_signature---     : '(' implicit_anonymous_function_parameter_list? ')'---     | implicit_anonymous_function_parameter---     ;------ implicit_anonymous_function_parameter_list---     : implicit_anonymous_function_parameter---       (',' implicit_anonymous_function_parameter)*---     ;------ implicit_anonymous_function_parameter---     : identifier---     ;------ anonymous_function_body---     : null_conditional_invocation_expression---     | expression---     | 'ref' variable_reference---     | block---     ;--      def "AnonymousFunctionBody" $ union [-        "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression",-        "expression">: csharp "Expression",-        "ref">: csharp "VariableReference",-        "block">: csharp "Block"],---- // Source: §12.20.1 General--- query_expression---     : from_clause query_body---     ;--      def "QueryExpression" $ record [-        "from">: csharp "FromClause",-        "body">: csharp "QueryBody"],---- from_clause---     : 'from' type? identifier 'in' expression---     ;--      def "FromClause" $ record [-        "type">: optional $ csharp "Type",-        "identifier">: csharp "Identifier",-        "in">: csharp "Expression"],---- query_body---     : query_body_clauses? select_or_group_clause query_continuation?---     ;--      def "QueryBody" $ record [-        "clauses">: list $ csharp "QueryBodyClause",-        "selectOrGroup">: csharp "SelectOrGroupClause",-        "continuation">: optional $ csharp "QueryContinuation"],---- query_body_clauses---     : query_body_clause---     | query_body_clauses query_body_clause---     ;------ query_body_clause---     : from_clause---     | let_clause---     | where_clause---     | join_clause---     | join_into_clause---     | orderby_clause---     ;--      def "QueryBodyClause" $ union [-        "from">: csharp "FromClause",-        "let">: csharp "LetClause",-        "where">: csharp "BooleanExpression",-        "join">: csharp "JoinClause",-        "orderby">: nonemptyList $ csharp "Ordering"],---- let_clause---     : 'let' identifier '=' expression---     ;--      def "LetClause" $ record [-        "left">: csharp "Identifier",-        "right">: csharp "Expression"],---- where_clause---     : 'where' boolean_expression---     ;------ join_clause---     : 'join' type? identifier 'in' expression 'on' expression---       'equals' expression---     ;--      def "JoinClause" $ record [-        "type">: optional $ csharp "Type",-        "identifier">: csharp "Identifier",-        "in">: csharp "Expression",-        "on">: csharp "Expression",-        "equals">: csharp "Expression",-        "into">: optional $ csharp "Identifier"],---- join_into_clause---     : 'join' type? identifier 'in' expression 'on' expression---       'equals' expression 'into' identifier---     ;------ orderby_clause---     : 'orderby' orderings---     ;------ orderings---     : ordering (',' ordering)*---     ;------ ordering---     : expression ordering_direction?---     ;--      def "Ordering" $ record [-        "expression">: csharp "Expression",-        "direction">: optional $ csharp "OrderingDirection"],---- ordering_direction---     : 'ascending'---     | 'descending'---     ;--      def "OrderingDirection" $ enum [ "ascending", "descending" ],---- select_or_group_clause---     : select_clause---     | group_clause---     ;--      def "SelectOrGroupClause" $ union [-        "select">: csharp "Expression",-        "group">: csharp "GroupClause"],---- select_clause---     : 'select' expression---     ;------ group_clause---     : 'group' expression 'by' expression---     ;---      def "GroupClause" $ record [-        "grouped">: csharp "Expression",-        "by">: csharp "Expression"],---- query_continuation---     : 'into' identifier query_body---     ;--      def "QueryContinuation" $ record [-        "into">: csharp "Identifier",-        "body">: csharp "QueryBody"],---- // Source: §12.21.1 General--- assignment---     : unary_expression assignment_operator expression---     ;--      def "Assignment" $ record [-        "left">: csharp "UnaryExpression",-        "operator">: csharp "AssignmentOperator",-        "right">: csharp "Expression"],---- assignment_operator---     : '=' 'ref'? | '+=' | '-=' | '*=' | '/=' | '%=' | '&=' | '|=' | '^=' | '<<='---     | right_shift_assignment---     ;--      def "AssignmentOperator" $ union [-        "simple">: boolean,-        "plusEquals">: unit,-        "minusEquals">: unit,-        "timesEquals">: unit,-        "divideEquals">: unit,-        "modEquals">: unit,-        "andEquals">: unit,-        "orEquals">: unit,-        "xorEquals">: unit,-        "leftShiftEquals">: unit,-        "rightShiftEquals">: unit],---- // Source: §12.22 Expression--- expression---     : non_assignment_expression---     | assignment---     ;--      def "Expression" $ union [-        "nonAssignment">: csharp "NonAssignmentExpression",-        "assignment">: csharp "Assignment"],---- non_assignment_expression---     : declaration_expression---     | conditional_expression---     | lambda_expression---     | query_expression---     ;--      def "NonAssignmentExpression" $ union [-        "declaration">: csharp "DeclarationExpression",-        "conditional">: csharp "ConditionalExpression",-        "lambda">: csharp "LambdaExpression",-        "query">: csharp "QueryExpression"],---- // Source: §12.23 Constant expressions--- constant_expression---     : expression---     ;--      def "ConstantExpression" $ csharp "Expression",---- // Source: §12.24 Boolean expressions--- boolean_expression---     : expression---     ;--      def "BooleanExpression" $ csharp "Expression",---- // Source: §13.1 General--- statement---     : labeled_statement---     | declaration_statement---     | embedded_statement---     ;--      def "Statement" $ union [-        "labeled">: csharp "LabeledStatement",-        "declaration">: csharp "DeclarationStatement",-        "embedded">: csharp "EmbeddedStatement"],---- embedded_statement---     : block---     | empty_statement---     | expression_statement---     | selection_statement---     | iteration_statement---     | jump_statement---     | try_statement---     | checked_statement---     | unchecked_statement---     | lock_statement---     | using_statement---     | yield_statement---     | unsafe_statement   // unsafe code support---     | fixed_statement    // unsafe code support---     ;--      def "EmbeddedStatement" $ union [-        "block">: csharp "Block",-        "empty">: unit,-        "expression">: csharp "StatementExpression",-        "selection">: csharp "SelectionStatement",-        "iteration">: csharp "IterationStatement",-        "jump">: csharp "JumpStatement",-        "try">: csharp "TryStatement",-        "checked">: csharp "Block",-        "unchecked">: csharp "Block",-        "lock">: csharp "LockStatement",-        "using">: csharp "UsingStatement",-        "yield">: csharp "YieldStatement",-        "unsafe">: csharp "Block",-        "fixed">: csharp "FixedStatement"],---- // Source: §13.3.1 General--- block---     : '{' statement_list? '}'---     ;--      def "Block" $ list $ csharp "Statement",---- // Source: §13.3.2 Statement lists--- statement_list---     : statement+---     ;------ // Source: §13.4 The empty statement--- empty_statement---     : ';'---     ;------ // Source: §13.5 Labeled statements--- labeled_statement---     : identifier ':' statement---     ;--      def "LabeledStatement" $ record [-        "label">: csharp "Identifier",-        "statement">: csharp "Statement"],---- // Source: §13.6.1 General--- declaration_statement---     : local_variable_declaration ';'---     | local_constant_declaration ';'---     | local_function_declaration---     ;--      def "DeclarationStatement" $ union [-        "variable">: csharp "LocalVariableDeclaration",-        "constant">: csharp "LocalConstantDeclaration",-        "function">: csharp "LocalFunctionDeclaration"],---- // Source: §13.6.2.1 General--- local_variable_declaration---     : implicitly_typed_local_variable_declaration---     | explicitly_typed_local_variable_declaration---     | ref_local_variable_declaration---     ;---      def "LocalVariableDeclaration" $ union [-        "implicitlyTyped">: csharp "ImplicitlyTypedLocalVariableDeclaration",-        "explicitlyTyped">: csharp "ExplicitlyTypedLocalVariableDeclaration",-        "ref">: csharp "RefLocalVariableDeclaration"],---- // Source: §13.6.2.2 Implicitly typed local variable declarations--- implicitly_typed_local_variable_declaration---     : 'var' implicitly_typed_local_variable_declarator---     | ref_kind 'var' ref_local_variable_declarator---     ;--      def "ImplicitlyTypedLocalVariableDeclaration" $ union [-        "var">: csharp "ImplicitlyTypedLocalVariableDeclarator",-        "refVar">: csharp "RefVarImplicitlyTypedLocalVariableDeclaration"],--      def "RefVarImplicitlyTypedLocalVariableDeclaration" $ record [-        "refKind">: csharp "RefKind",-        "declarator">: csharp "RefLocalVariableDeclarator"],---- implicitly_typed_local_variable_declarator---     : identifier '=' expression---     ;--      def "ImplicitlyTypedLocalVariableDeclarator" $ record [-        "identifier">: csharp "Identifier",-        "expression">: csharp "Expression"],---- // Source: §13.6.2.3 Explicitly typed local variable declarations--- explicitly_typed_local_variable_declaration---     : type explicitly_typed_local_variable_declarators---     ;--      def "ExplicitlyTypedLocalVariableDeclaration" $ record [-        "type">: csharp "Type",-        "declarators">: list $ csharp "ExplicitlyTypedLocalVariableDeclarator"],---- explicitly_typed_local_variable_declarators---     : explicitly_typed_local_variable_declarator---       (',' explicitly_typed_local_variable_declarator)*---     ;--      def "ExplicitlyTypedLocalVariableDeclarator" $ record [-        "identifier">: csharp "Identifier",-        "initializer">: optional $ csharp "LocalVariableInitializer"],---- explicitly_typed_local_variable_declarator---     : identifier ('=' local_variable_initializer)?---     ;------ local_variable_initializer---     : expression---     | array_initializer---     ;--      def "LocalVariableInitializer" $ union [-        "expression">: csharp "Expression",-        "initializer">: csharp "ArrayInitializer"],---- // Source: §13.6.2.4 Ref local variable declarations--- ref_local_variable_declaration---     : ref_kind type ref_local_variable_declarators---     ;--      def "RefLocalVariableDeclaration" $ record [-        "refKind">: csharp "RefKind",-        "type">: csharp "Type",-        "declarators">: nonemptyList $ csharp "RefLocalVariableDeclarator"],---- ref_local_variable_declarators---     : ref_local_variable_declarator (',' ref_local_variable_declarator)*---     ;------ ref_local_variable_declarator---     : identifier '=' 'ref' variable_reference---     ;--      def "RefLocalVariableDeclarator" $ record [-        "left">: csharp "Identifier",-        "right">: csharp "VariableReference"],---- // Source: §13.6.3 Local constant declarations--- local_constant_declaration---     : 'const' type constant_declarators---     ;--      def "LocalConstantDeclaration" $ record [-        "type">: csharp "Type",-        "declarators">: nonemptyList $ csharp "ConstantDeclarator"],---- constant_declarators---     : constant_declarator (',' constant_declarator)*---     ;------ constant_declarator---     : identifier '=' constant_expression---     ;--      def "ConstantDeclarator" $ record [-        "identifier">: csharp "Identifier",-        "expression">: csharp "ConstantExpression"],---- // Source: §13.6.4 Local function declarations--- local_function_declaration---     : local_function_modifier* return_type local_function_header---       local_function_body---     | ref_local_function_modifier* ref_kind ref_return_type---       local_function_header ref_local_function_body---     ;--      def "LocalFunctionDeclaration" $ union [-        "standard">: csharp "StandardLocalFunctionDeclaration",-        "ref">: csharp "RefLocalFunctionDeclaration"],--      def "StandardLocalFunctionDeclaration" $ record [-        "modifiers">: list $ csharp "LocalFunctionModifier",-        "returnType">: csharp "ReturnType",-        "header">: csharp "LocalFunctionHeader",-        "body">: csharp "LocalFunctionBody"],--      def "RefLocalFunctionDeclaration" $ record [-        "modifiers">: list $ csharp "RefLocalFunctionModifier",-        "refKind">: csharp "RefKind",-        "returnType">: csharp "Type",-        "header">: csharp "LocalFunctionHeader",-        "body">: csharp "RefLocalFunctionBody"],---- local_function_header---     : identifier '(' formal_parameter_list? ')'---     | identifier type_parameter_list '(' formal_parameter_list? ')'---       type_parameter_constraints_clause*---     ;--      def "LocalFunctionHeader" $ record [-        "identifier">: csharp "Identifier",-        "typeParameters">: optional $ csharp "TypeParameterList",-        "parameters">: csharp "FormalParameterList",-        "constraints">: list $ csharp "TypeParameterConstraintsClause"],---- local_function_modifier---     : ref_local_function_modifier---     | 'async'---     ;--      def "LocalFunctionModifier" $ union [-        "ref">: csharp "RefLocalFunctionModifier",-        "async">: unit],---- ref_local_function_modifier---     : 'static'---     | unsafe_modifier   // unsafe code support---     ;--      def "RefLocalFunctionModifier" $ enum ["static", "unsafe"],---- local_function_body---     : block---     | '=>' null_conditional_invocation_expression ';'---     | '=>' expression ';'---     ;--      def "LocalFunctionBody" $ union [-        "block">: csharp "Block",-        "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression",-        "expression">: csharp "Expression"],---- ref_local_function_body---     : block---     | '=>' 'ref' variable_reference ';'---     ;--      def "RefLocalFunctionBody" $ union [-        "block">: csharp "Block",-        "ref">: csharp "VariableReference"],---- // Source: §13.7 Expression statements--- expression_statement---     : statement_expression ';'---     ;------ statement_expression---     : null_conditional_invocation_expression---     | invocation_expression---     | object_creation_expression---     | assignment---     | post_increment_expression---     | post_decrement_expression---     | pre_increment_expression---     | pre_decrement_expression---     | await_expression---     ;--      def "StatementExpression" $ union [-        "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression",-        "invocation">: csharp "InvocationExpression",-        "objectCreation">: csharp "ObjectCreationExpression",-        "assignment">: csharp "Assignment",-        "postIncrement">: csharp "PrimaryExpression",-        "postDecrement">: csharp "PrimaryExpression",-        "preIncrement">: csharp "UnaryExpression",-        "preDecrement">: csharp "UnaryExpression",-        "await">: csharp "UnaryExpression"],---- // Source: §13.8.1 General--- selection_statement---     : if_statement---     | switch_statement---     ;--      def "SelectionStatement" $ union [-        "if">: csharp "IfStatement",-        "switch">: csharp "SwitchStatement"],---- // Source: §13.8.2 The if statement--- if_statement---     : 'if' '(' boolean_expression ')' embedded_statement---     | 'if' '(' boolean_expression ')' embedded_statement---       'else' embedded_statement---     ;--      def "IfStatement" $ record [-        "condition">: csharp "BooleanExpression",-        "ifBranch">: csharp "EmbeddedStatement",-        "elseBranch">: csharp "EmbeddedStatement"],---- // Source: §13.8.3 The switch statement--- switch_statement---     : 'switch' '(' expression ')' switch_block---     ;--      def "SwitchStatement" $ record [-        "expression">: csharp "Expression",-        "branches">: list $ csharp "SwitchSection"],---- switch_block---     : '{' switch_section* '}'---     ;------ switch_section---     : switch_label+ statement_list---     ;--      def "SwitchSection" $ record [-        "labels">: nonemptyList $ csharp "SwitchLabel",-        "statements">: list $ csharp "Statement"],---- switch_label---     : 'case' pattern case_guard?  ':'---     | 'default' ':'---     ;--      def "SwitchLabel" $ union [-        "branch">: csharp "SwitchBranch",-        "default">: unit],--      def "SwitchBranch" $ record [-        "pattern">: csharp "Pattern",-        "guard">: optional $ csharp "Expression"],---- case_guard---     : 'when' expression---     ;------ // Source: §13.9.1 General--- iteration_statement---     : while_statement---     | do_statement---     | for_statement---     | foreach_statement---     ;--      def "IterationStatement" $ union [-        "while">: csharp "WhileStatement",-        "do">: csharp "DoStatement",-        "for">: csharp "ForStatement",-        "foreach">: csharp "ForeachStatement"],---- // Source: §13.9.2 The while statement--- while_statement---     : 'while' '(' boolean_expression ')' embedded_statement---     ;--      def "WhileStatement" $ record [-        "condition">: csharp "BooleanExpression",-        "body">: csharp "EmbeddedStatement"],---- // Source: §13.9.3 The do statement--- do_statement---     : 'do' embedded_statement 'while' '(' boolean_expression ')' ';'---     ;--      def "DoStatement" $ record [-        "body">: csharp "EmbeddedStatement",-        "while">: csharp "BooleanExpression"],---- // Source: §13.9.4 The for statement--- for_statement---     : 'for' '(' for_initializer? ';' for_condition? ';' for_iterator? ')'---       embedded_statement---     ;--        def "ForStatement" $ record [-          "initializer">: optional $ csharp "ForInitializer",-          "condition">: optional $ csharp "BooleanExpression",-          "iterator">: optional $ csharp "StatementExpressionList",-          "body">: csharp "EmbeddedStatement"],---- for_initializer---     : local_variable_declaration---     | statement_expression_list---     ;--      def "ForInitializer" $ union [-        "variable">: csharp "LocalVariableDeclaration",-        "statements">: csharp "StatementExpressionList"],---- for_condition---     : boolean_expression---     ;------ for_iterator---     : statement_expression_list---     ;------ statement_expression_list---     : statement_expression (',' statement_expression)*---     ;--      def "StatementExpressionList" $ nonemptyList $ csharp "StatementExpression",---- // Source: §13.9.5 The foreach statement--- foreach_statement---     : 'foreach' '(' ref_kind? local_variable_type identifier 'in'---       expression ')' embedded_statement---     ;--      def "ForeachStatement" $ record [-        "kind">: optional $ csharp "RefKind",-        "type">: csharp "LocalVariableType",-        "identifier">: csharp "Identifier",-        "expression">: csharp "Expression",-        "body">: csharp "EmbeddedStatement"],---- // Source: §13.10.1 General--- jump_statement---     : break_statement---     | continue_statement---     | goto_statement---     | return_statement---     | throw_statement---     ;--      def "JumpStatement" $ union [-        "break">: unit,-        "continue">: unit,-        "goto">: csharp "GotoStatement",-        "return">: csharp "ReturnStatement",-        "throw">: optional $ csharp "Expression"],---- // Source: §13.10.2 The break statement--- break_statement---     : 'break' ';'---     ;------ // Source: §13.10.3 The continue statement--- continue_statement---     : 'continue' ';'---     ;------ // Source: §13.10.4 The goto statement--- goto_statement---     : 'goto' identifier ';'---     | 'goto' 'case' constant_expression ';'---     | 'goto' 'default' ';'---     ;--      def "GotoStatement" $ union [-        "identifier">: csharp "Identifier",-        "case">: csharp "ConstantExpression",-        "default">: unit],---- // Source: §13.10.5 The return statement--- return_statement---     : 'return' ';'---     | 'return' expression ';'---     | 'return' 'ref' variable_reference ';'---     ;--      def "ReturnStatement" $ union [-        "simple">: unit,-        "value">: csharp "Expression",-        "ref">: csharp "VariableReference"],---- // Source: §13.10.6 The throw statement--- throw_statement---     : 'throw' expression? ';'---     ;------ // Source: §13.11 The try statement--- try_statement---     : 'try' block catch_clauses---     | 'try' block catch_clauses? finally_clause---     ;--      def "TryStatement" $ record [-        "body">: csharp "Block",-        "catches">: csharp "CatchClauses",-        "finally">: optional $ csharp "Block"],---- catch_clauses---     : specific_catch_clause+---     | specific_catch_clause* general_catch_clause---     ;--      def "CatchClauses" $ union [-        "specific">: list $ csharp "SpecificCatchClause",-        "general">: csharp "Block"],---- specific_catch_clause---     : 'catch' exception_specifier exception_filter? block---     | 'catch' exception_filter block---     ;--      def "SpecificCatchClause" $ record [-        "specifier">: optional $ csharp "ExceptionSpecifier",-        "filter">: optional $ csharp "BooleanExpression",-        "body">: csharp "Block"],---- exception_specifier---     : '(' type identifier? ')'---     ;--      def "ExceptionSpecifier" $ record [-        "type">: csharp "Type",-        "identifier">: optional $ csharp "Identifier"],---- exception_filter---     : 'when' '(' boolean_expression ')'---     ;------ general_catch_clause---     : 'catch' block---     ;------ finally_clause---     : 'finally' block---     ;------ // Source: §13.12 The checked and unchecked statements--- checked_statement---     : 'checked' block---     ;------ unchecked_statement---     : 'unchecked' block---     ;------ // Source: §13.13 The lock statement--- lock_statement---     : 'lock' '(' expression ')' embedded_statement---     ;--      def "LockStatement" $ record [-        "expression">: csharp "Expression",-        "body">: csharp "EmbeddedStatement"],---- // Source: §13.14 The using statement--- using_statement---     : 'using' '(' resource_acquisition ')' embedded_statement---     ;--      def "UsingStatement" $ record [-        "acquisition">: csharp "ResourceAcquisition",-        "body">: csharp "EmbeddedStatement"],---- resource_acquisition---     : local_variable_declaration---     | expression---     ;--      def "ResourceAcquisition" $ union [-        "local">: csharp "LocalVariableDeclaration",-        "expression">: csharp "Expression"],---- // Source: §13.15 The yield statement--- yield_statement---     : 'yield' 'return' expression ';'---     | 'yield' 'break' ';'---     ;--      def "YieldStatement" $ union [-        "return">: csharp "Expression",-        "break">: unit],---- // Source: §14.2 Compilation units--- compilation_unit---     : extern_alias_directive* using_directive* global_attributes?---       namespace_member_declaration*---     ;--      def "CompilationUnit" $ record [-        "externs">: list $ csharp "Identifier",-        "usings">: list $ csharp "UsingDirective",-        "attributes">: list $ csharp "GlobalAttributeSection",-        "members">: list $ csharp "NamespaceMemberDeclaration"],---- // Source: §14.3 Namespace declarations--- namespace_declaration---     : 'namespace' qualified_identifier namespace_body ';'?---     ;--      def "NamespaceDeclaration" $ record [-        "name">: nonemptyList $ csharp "Identifier",-        "body">: csharp "NamespaceBody"],---- qualified_identifier---     : identifier ('.' identifier)*---     ;------ namespace_body---     : '{' extern_alias_directive* using_directive*---       namespace_member_declaration* '}'---     ;--      def "NamespaceBody" $ record [-        "externs">: list $ csharp "Identifier",-        "usings">: list $ csharp "UsingDirective",-        "members">: list $ csharp "NamespaceMemberDeclaration"],---- // Source: §14.4 Extern alias directives--- extern_alias_directive---     : 'extern' 'alias' identifier ';'---     ;------ // Source: §14.5.1 General--- using_directive---     : using_alias_directive---     | using_namespace_directive---     | using_static_directive---     ;--      def "UsingDirective" $ union [-        "alias">: csharp "UsingAliasDirective",-        "namespace">: csharp "NamespaceName",-        "static">: csharp "TypeName"],---- // Source: §14.5.2 Using alias directives--- using_alias_directive---     : 'using' identifier '=' namespace_or_type_name ';'---     ;--      def "UsingAliasDirective" $ record [-        "alias">: csharp "Identifier",-        "name">: csharp "NamespaceOrTypeName"],---- // Source: §14.5.3 Using namespace directives--- using_namespace_directive---     : 'using' namespace_name ';'---     ;------ // Source: §14.5.4 Using static directives--- using_static_directive---     : 'using' 'static' type_name ';'---     ;------ // Source: §14.6 Namespace member declarations--- namespace_member_declaration---     : namespace_declaration---     | type_declaration---     ;--      def "NamespaceMemberDeclaration" $ union [-        "namespace">: csharp "NamespaceDeclaration",-        "type">: csharp "TypeDeclaration"],---- // Source: §14.7 Type declarations--- type_declaration---     : class_declaration---     | struct_declaration---     | interface_declaration---     | enum_declaration---     | delegate_declaration---     ;--      def "TypeDeclaration" $ union [-        "class">: csharp "ClassDeclaration",-        "struct">: csharp "StructDeclaration",-        "interface">: csharp "InterfaceDeclaration",-        "enum">: csharp "EnumDeclaration",-        "delegate">: csharp "DelegateDeclaration"],---- // Source: §14.8.1 General--- qualified_alias_member---     : identifier '::' identifier type_argument_list?---     ;--      def "QualifiedAliasMember" $ record [-        "alias">: csharp "Identifier",-        "member">: csharp "Identifier",-        "arguments">: optional $ csharp "TypeArgumentList"],---- // Source: §15.2.1 General--- class_declaration---     : attributes? class_modifier* 'partial'? 'class' identifier---         type_parameter_list? class_base? type_parameter_constraints_clause*---         class_body ';'?---     ;--      def "ClassDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "ClassModifier",-        "partial">: unit,-        "name">: csharp "Identifier",-        "parameters">: optional $ csharp "TypeParameterList",-        "base">: optional $ csharp "ClassBase",-        "constraints">: list $ csharp "TypeParameterConstraintsClause",-        "body">: csharp "ClassBody"],---- // Source: §15.2.2.1 General--- class_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'abstract'---     | 'sealed'---     | 'static'---     | unsafe_modifier   // unsafe code support---     ;--      def "ClassModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "abstract",-        "sealed",-        "static",-        "unsafe"],---- // Source: §15.2.3 Type parameters--- type_parameter_list---     : '<' type_parameters '>'---     ;------ type_parameters---     : attributes? type_parameter---     | type_parameters ',' attributes? type_parameter---     ;--      def "TypeParameterList" $ nonemptyList $ csharp "TypeParameterPart",--      def "TypeParameterPart" $ record [-        "attributes">: optional $ csharp "Attributes",-        "name">: csharp "TypeParameter"],---- // Source: §15.2.4.1 General--- class_base---     : ':' class_type---     | ':' interface_type_list---     | ':' class_type ',' interface_type_list---     ;--      def "ClassBase" $ union [-        "class">: optional $ csharp "ClassType",-        "interfaces">: list $ csharp "InterfaceType"],---- interface_type_list---     : interface_type (',' interface_type)*---     ;------ // Source: §15.2.5 Type parameter constraints--- type_parameter_constraints_clauses---     : type_parameter_constraints_clause---     | type_parameter_constraints_clauses type_parameter_constraints_clause---     ;------ type_parameter_constraints_clause---     : 'where' type_parameter ':' type_parameter_constraints---     ;--      def "TypeParameterConstraintsClause" $ record [-        "parameter">: csharp "TypeParameter",-        "constraints">: list $ csharp "TypeParameterConstraints"],---- type_parameter_constraints---     : primary_constraint---     | secondary_constraints---     | constructor_constraint---     | primary_constraint ',' secondary_constraints---     | primary_constraint ',' constructor_constraint---     | secondary_constraints ',' constructor_constraint---     | primary_constraint ',' secondary_constraints ',' constructor_constraint---     ;--      def "TypeParameterConstraints" $ record [-        "primary">: optional $ csharp "PrimaryConstraint",-        "secondary">: optional $ csharp "SecondaryConstraints",-        "constructor">: boolean],---- primary_constraint---     : class_type---     | 'class'---     | 'struct'---     | 'unmanaged'---     ;--      def "PrimaryConstraint" $ union [-        "classType">: csharp "ClassType",-        "class">: unit,-        "struct">: unit,-        "unmanaged">: unit],---- secondary_constraints---     : interface_type---     | type_parameter---     | secondary_constraints ',' interface_type---     | secondary_constraints ',' type_parameter---     ;--      def "SecondaryConstraints" $ nonemptyList $ csharp "SecondaryConstraint",--      def "SecondaryConstraint" $ union [-        "interface">: csharp "InterfaceType",-        "parameter">: csharp "TypeParameter"],---- constructor_constraint---     : 'new' '(' ')'---     ;------ // Source: §15.2.6 Class body--- class_body---     : '{' class_member_declaration* '}'---     ;--      def "ClassBody" $ list $ csharp "ClassMemberDeclaration",---- // Source: §15.3.1 General--- class_member_declaration---     : constant_declaration---     | field_declaration---     | method_declaration---     | property_declaration---     | event_declaration---     | indexer_declaration---     | operator_declaration---     | constructor_declaration---     | finalizer_declaration---     | static_constructor_declaration---     | type_declaration---     ;--      def "ClassMemberDeclaration" $ union [-        "constant">: csharp "ConstantDeclaration",-        "field">: csharp "FieldDeclaration",-        "method">: csharp "MethodDeclaration",-        "property">: csharp "PropertyDeclaration",-        "event">: csharp "EventDeclaration",-        "indexer">: csharp "IndexerDeclaration",-        "operator">: csharp "OperatorDeclaration",-        "constructor">: csharp "ConstructorDeclaration",-        "finalizer">: csharp "FinalizerDeclaration",-        "staticConstructor">: csharp "StaticConstructorDeclaration",-        "type">: csharp "TypeDeclaration"],---- // Source: §15.4 Constants--- constant_declaration---     : attributes? constant_modifier* 'const' type constant_declarators ';'---     ;--      def "ConstantDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "ConstantModifier",-        "type">: csharp "Type",-        "declarators">: nonemptyList $ csharp "ConstantDeclarator"],---- constant_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     ;--      def "ConstantModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private"],---- // Source: §15.5.1 General--- field_declaration---     : attributes? field_modifier* type variable_declarators ';'---     ;--      def "FieldDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "FieldModifier",-        "type">: csharp "Type",-        "declarators">: nonemptyList $ csharp "VariableDeclarator"],---- field_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'static'---     | 'readonly'---     | 'volatile'---     | unsafe_modifier   // unsafe code support---     ;--      def "FieldModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "static",-        "readonly",-        "volatile",-        "unsafe"],---- variable_declarators---     : variable_declarator (',' variable_declarator)*---     ;--      def "VariableDeclarators" $ nonemptyList $ csharp "VariableDeclarator",---- variable_declarator---     : identifier ('=' variable_initializer)?---     ;--      def "VariableDeclarator" $ record [-        "identifier">: csharp "Identifier",-        "initializer">: optional $ csharp "VariableInitializer"],---- // Source: §15.6.1 General--- method_declaration---     : attributes? method_modifiers return_type method_header method_body---     | attributes? ref_method_modifiers ref_kind ref_return_type method_header---       ref_method_body---     ;--      def "MethodDeclaration" $ union [-        "standard">: csharp "StandardMethodDeclaration",-        "refReturn">: csharp "RefReturnMethodDeclaration"],--      def "StandardMethodDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "MethodModifier",-        "returnType">: csharp "ReturnType",-        "header">: csharp "MethodHeader",-        "body">: csharp "MethodBody"],--      def "RefReturnMethodDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "RefMethodModifier",-        "kind">: csharp "RefKind",-        "returnType">: csharp "ReturnType",-        "header">: csharp "MethodHeader",-        "body">: csharp "RefMethodBody"],---- method_modifiers---     : method_modifier* 'partial'?---     ;--      def "MethodModifiers" $ record [-        "modifiers">: list $ csharp "MethodModifier",-        "partial">: boolean],---- ref_kind---     : 'ref'---     | 'ref' 'readonly'---     ;--      def "RefKind" $ enum [-        "ref",-        "refReadonly"],---- ref_method_modifiers---     : ref_method_modifier*---     ;------ method_header---     : member_name '(' formal_parameter_list? ')'---     | member_name type_parameter_list '(' formal_parameter_list? ')'---       type_parameter_constraints_clause*---     ;--      def "MethodHeader" $ record [-        "name">: csharp "MemberName",-        "typeParameters">: optional $ csharp "TypeParameterList",-        "parameters">: optional $ csharp "FormalParameterList",-        "constraints">: list $ csharp "TypeParameterConstraintsClause"],---- method_modifier---     : ref_method_modifier---     | 'async'---     ;--      def "MethodModifier" $ union [-        "ref">: csharp "RefMethodModifier",-        "async">: unit],---- ref_method_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'static'---     | 'virtual'---     | 'sealed'---     | 'override'---     | 'abstract'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "RefMethodModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "static",-        "virtual",-        "sealed",-        "override",-        "abstract",-        "extern",-        "unsafe"],---- return_type---     : ref_return_type---     | 'void'---     ;--      def "ReturnType" $ union [-        "ref">: csharp "Type",-        "void">: unit],---- ref_return_type---     : type---     ;------ member_name---     : identifier---     | interface_type '.' identifier---     ;--      def "MemberName" $ record [-        "interfaceType">: optional $ csharp "TypeName",-        "identifier">: csharp "Identifier"],---- method_body---     : block---     | '=>' null_conditional_invocation_expression ';'---     | '=>' expression ';'---     | ';'---     ;--      def "MethodBody" $ union [-        "block">: csharp "Block",-        "nullConditionalInvocation">: csharp "NullConditionalInvocationExpression",-        "expression">: csharp "Expression",-        "empty">: unit],---- ref_method_body---     : block---     | '=>' 'ref' variable_reference ';'---     | ';'---     ;--      def "RefMethodBody" $ union [-        "block">: csharp "Block",-        "ref">: csharp "VariableReference",-        "empty">: unit],---- // Source: §15.6.2.1 General--- formal_parameter_list---     : fixed_parameters---     | fixed_parameters ',' parameter_array---     | parameter_array---     ;--      def "FormalParameterList" $ record [-        "fixed">: list $ csharp "FixedParameter",-        "array">: optional $ csharp "ParameterArray"],---- fixed_parameters---     : fixed_parameter (',' fixed_parameter)*---     ;------ fixed_parameter---     : attributes? parameter_modifier? type identifier default_argument?---     ;--      def "FixedParameter" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifier">: optional $ csharp "ParameterModifier",-        "type">: csharp "Type",-        "identifier">: csharp "Identifier",-        "defaultArgument">: optional $ csharp "Expression"],---- default_argument---     : '=' expression---     ;------ parameter_modifier---     : parameter_mode_modifier---     | 'this'---     ;--      def "ParameterModifier" $ union [-        "mode">: csharp "ParameterModeModifier",-        "this">: unit],---- parameter_mode_modifier---     : 'ref'---     | 'out'---     | 'in'---     ;--      def "ParameterModeModifier" $ enum [-        "ref",-        "out",-        "in"],---- parameter_array---     : attributes? 'params' array_type identifier---     ;--      def "ParameterArray" $ record [-        "attributes">: optional $ csharp "Attributes",-        "type">: csharp "ArrayType",-        "identifier">: csharp "Identifier"],---- // Source: §15.7.1 General--- property_declaration---     : attributes? property_modifier* type member_name property_body---     | attributes? property_modifier* ref_kind type member_name ref_property_body---     ;--      def "PropertyDeclaration" $ union [-        "standard">: csharp "StandardPropertyDeclaration",-        "refReturn">: csharp "RefReturnPropertyDeclaration"],--      def "StandardPropertyDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "PropertyModifier",-        "type">: csharp "Type",-        "name">: csharp "MemberName",-        "body">: csharp "PropertyBody"],--      def "RefReturnPropertyDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "PropertyModifier",-        "refKind">: csharp "RefKind",-        "type">: csharp "Type",-        "name">: csharp "MemberName",-        "body">: csharp "RefPropertyBody"],---- property_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'static'---     | 'virtual'---     | 'sealed'---     | 'override'---     | 'abstract'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "PropertyModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "static",-        "virtual",-        "sealed",-        "override",-        "abstract",-        "extern",-        "unsafe"],---- property_body---     : '{' accessor_declarations '}' property_initializer?---     | '=>' expression ';'---     ;--      def "PropertyBody" $ union [-        "block">: csharp "BlockPropertyBody",-        "expression">: csharp "Expression"],--      def "BlockPropertyBody" $ record [-        "accessors">: csharp "AccessorDeclarations",-        "initializer">: optional $ csharp "VariableInitializer"],---- property_initializer---     : '=' variable_initializer ';'---     ;------ ref_property_body---     : '{' ref_get_accessor_declaration '}'---     | '=>' 'ref' variable_reference ';'---     ;--      def "RefPropertyBody" $ union [-        "block">: csharp "RefGetAccessorDeclaration",-        "ref">: csharp "VariableReference"],---- // Source: §15.7.3 Accessors--- accessor_declarations---     : get_accessor_declaration set_accessor_declaration?---     | set_accessor_declaration get_accessor_declaration?---     ;--      def "AccessorDeclarations" $ union [-        "get">: optional $ csharp "AccessorDeclaration",-        "set">: optional $ csharp "AccessorDeclaration"],--      def "AccessorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifier">: optional $ csharp "AccessorModifier",-        "body">: csharp "AccessorBody"],---- get_accessor_declaration---     : attributes? accessor_modifier? 'get' accessor_body---     ;------ set_accessor_declaration---     : attributes? accessor_modifier? 'set' accessor_body---     ;------ accessor_modifier---     : 'protected'---     | 'internal'---     | 'private'---     | 'protected' 'internal'---     | 'internal' 'protected'---     | 'protected' 'private'---     | 'private' 'protected'---     ;--      def "AccessorModifier" $ enum [-        "protected",-        "internal",-        "private",-        "protectedInternal",-        "internalProtected",-        "protectedPrivate",-        "privateProtected"],---- accessor_body---     : block---     | '=>' expression ';'---     | ';'---     ;--      def "AccessorBody" $ union [-        "block">: csharp "Block",-        "expression">: csharp "Expression",-        "empty">: unit],---- ref_get_accessor_declaration---     : attributes? accessor_modifier? 'get' ref_accessor_body---     ;--      def "RefGetAccessorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifier">: optional $ csharp "AccessorModifier",-        "body">: csharp "RefAccessorBody"],---- ref_accessor_body---     : block---     | '=>' 'ref' variable_reference ';'---     | ';'---     ;--      def "RefAccessorBody" $ union [-        "block">: csharp "Block",-        "ref">: csharp "VariableReference",-        "empty">: unit],---- // Source: §15.8.1 General--- event_declaration---     : attributes? event_modifier* 'event' type variable_declarators ';'---     | attributes? event_modifier* 'event' type member_name---         '{' event_accessor_declarations '}'---     ;--      def "EventDeclaration" $ union [-        "standard">: csharp "StandardEventDeclaration",-        "accessors">: csharp "AccessorsEventDeclaration"],--      def "StandardEventDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "EventModifier",-        "type">: csharp "Type",-        "declarators">: csharp "VariableDeclarators"],--      def "AccessorsEventDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "EventModifier",-        "type">: csharp "Type",-        "name">: csharp "MemberName",-        "accessors">: csharp "EventAccessorDeclarations"],---- event_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'static'---     | 'virtual'---     | 'sealed'---     | 'override'---     | 'abstract'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "EventModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "static",-        "virtual",-        "sealed",-        "override",-        "abstract",-        "extern",-        "unsafe"],---- event_accessor_declarations---     : add_accessor_declaration remove_accessor_declaration---     | remove_accessor_declaration add_accessor_declaration---     ;--      def "EventAccessorDeclarations" $ union [-        "add">: csharp "AddRemoveAccessorDeclaration",-        "remove">: csharp "AddRemoveAccessorDeclaration"],--      def "AddRemoveAccessorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "body">: csharp "Block"],---- add_accessor_declaration---     : attributes? 'add' block---     ;------ remove_accessor_declaration---     : attributes? 'remove' block---     ;------ // Source: §15.9.1 General--- indexer_declaration---     : attributes? indexer_modifier* indexer_declarator indexer_body---     | attributes? indexer_modifier* ref_kind indexer_declarator ref_indexer_body---     ;--      def "IndexerDeclaration" $ union [-        "standard">: csharp "StandardIndexerDeclaration",-        "ref">: csharp "RefIndexerDeclaration"],--      def "StandardIndexerDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "IndexerModifier",-        "declarator">: csharp "IndexerDeclarator",-        "body">: csharp "IndexerBody"],--      def "RefIndexerDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "IndexerModifier",-        "refKind">: csharp "RefKind",-        "declarator">: csharp "IndexerDeclarator",-        "body">: csharp "RefIndexerBody"],---- indexer_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'virtual'---     | 'sealed'---     | 'override'---     | 'abstract'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "IndexerModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "virtual",-        "sealed",-        "override",-        "abstract",-        "extern",-        "unsafe"],---- indexer_declarator---     : type 'this' '[' formal_parameter_list ']'---     | type interface_type '.' 'this' '[' formal_parameter_list ']'---     ;--      def "IndexerDeclarator" $ record [-        "type">: csharp "Type",-        "interface">: optional $ csharp "InterfaceType",-        "parameters">: csharp "FormalParameterList"],---- indexer_body---     : '{' accessor_declarations '}'---     | '=>' expression ';'---     ;--      def "IndexerBody" $ union [-        "block">: csharp "AccessorDeclarations",-        "expression">: csharp "Expression"],---- ref_indexer_body---     : '{' ref_get_accessor_declaration '}'---     | '=>' 'ref' variable_reference ';'---     ;--      def "RefIndexerBody" $ union [-        "block">: csharp "RefGetAccessorDeclaration",-        "ref">: csharp "VariableReference"],---- // Source: §15.10.1 General--- operator_declaration---     : attributes? operator_modifier+ operator_declarator operator_body---     ;--      def "OperatorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "OperatorModifier",-        "declarator">: csharp "OperatorDeclarator",-        "body">: csharp "OperatorBody"],---- operator_modifier---     : 'public'---     | 'static'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "OperatorModifier" $ enum [-        "public",-        "static",-        "extern",-        "unsafe"],---- operator_declarator---     : unary_operator_declarator---     | binary_operator_declarator---     | conversion_operator_declarator---     ;--      def "OperatorDeclarator" $ union [-        "unary">: csharp "UnaryOperatorDeclarator",-        "binary">: csharp "BinaryOperatorDeclarator",-        "conversion">: csharp "ConversionOperatorDeclarator"],---- unary_operator_declarator---     : type 'operator' overloadable_unary_operator '(' fixed_parameter ')'---     ;--      def "UnaryOperatorDeclarator" $ record [-        "type">: csharp "Type",-        "operator">: csharp "OverloadableUnaryOperator",-        "parameter">: csharp "FixedParameter"],---- overloadable_unary_operator---     : '+' | '-' | '!' | '~' | '++' | '--' | 'true' | 'false'---     ;--      def "OverloadableUnaryOperator" $ enum [-        "plus",-        "minus",-        "not",-        "complement",-        "increment",-        "decrement",-        "true",-        "false"],---- binary_operator_declarator---     : type 'operator' overloadable_binary_operator---         '(' fixed_parameter ',' fixed_parameter ')'---     ;--      def "BinaryOperatorDeclarator" $ record [-        "type">: csharp "Type",-        "operator">: csharp "OverloadableBinaryOperator",-        "left">: csharp "FixedParameter",-        "right">: csharp "FixedParameter"],---- overloadable_binary_operator---     : '+'  | '-'  | '*'  | '/'  | '%'  | '&' | '|' | '^'  | '<<'---     | right_shift | '==' | '!=' | '>' | '<' | '>=' | '<='---     ;--      def "OverloadableBinaryOperator" $ enum [-        "add",-        "subtract",-        "multiply",-        "divide",-        "modulus",-        "and",-        "or",-        "xor",-        "leftShift",-        "rightShift",-        "equal",-        "notEqual",-        "greaterThan",-        "lessThan",-        "greaterThanOrEqual",-        "lessThanOrEqual"],---- conversion_operator_declarator---     : 'implicit' 'operator' type '(' fixed_parameter ')'---     | 'explicit' 'operator' type '(' fixed_parameter ')'---     ;--      def "ConversionOperatorDeclarator" $ record [-        "kind">: csharp "ConversionKind",-        "type">: csharp "Type",-        "parameter">: csharp "FixedParameter"],--      def "ConversionKind" $ enum [-        "implicit",-        "explicit"],---- operator_body---     : block---     | '=>' expression ';'---     | ';'---     ;--      def "OperatorBody" $ union [-        "block">: csharp "Block",-        "expression">: csharp "Expression",-        "empty">: unit],---- // Source: §15.11.1 General--- constructor_declaration---     : attributes? constructor_modifier* constructor_declarator constructor_body---     ;--      def "ConstructorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "ConstructorModifier",-        "declarator">: csharp "ConstructorDeclarator",-        "body">: csharp "ConstructorBody"],---- constructor_modifier---     : 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'extern'---     | unsafe_modifier   // unsafe code support---     ;--      def "ConstructorModifier" $ enum [-        "public",-        "protected",-        "internal",-        "private",-        "extern",-        "unsafe"],---- constructor_declarator---     : identifier '(' formal_parameter_list? ')' constructor_initializer?---     ;--      def "ConstructorDeclarator" $ record [-        "name">: csharp "Identifier",-        "parameters">: optional $ csharp "FormalParameterList",-        "initializer">: optional $ csharp "ConstructorInitializer"],---- constructor_initializer---     : ':' 'base' '(' argument_list? ')'---     | ':' 'this' '(' argument_list? ')'---     ;--      def "ConstructorInitializer" $ union [-        "base">: optional $ csharp "ArgumentList",-        "this">: optional $ csharp "ArgumentList"],---- constructor_body---     : block---     | '=>' expression ';'---     | ';'---     ;--      def "ConstructorBody" $ union [-        "block">: csharp "Block",-        "expression">: csharp "Expression",-        "empty">: unit],---- // Source: §15.12 Static constructors--- static_constructor_declaration---     : attributes? static_constructor_modifiers identifier '(' ')'---         static_constructor_body---     ;--      def "StaticConstructorDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: csharp "StaticConstructorModifiers",-        "name">: csharp "Identifier",-        "body">: csharp "StaticConstructorBody"],---- static_constructor_modifiers---     : 'static'---     | 'static' 'extern' unsafe_modifier?---     | 'static' unsafe_modifier 'extern'?---     | 'extern' 'static' unsafe_modifier?---     | 'extern' unsafe_modifier 'static'---     | unsafe_modifier 'static' 'extern'?---     | unsafe_modifier 'extern' 'static'---     ;--      def "StaticConstructorModifiers" $ record [-        "extern">: boolean,-        "unsafe">: boolean],---- static_constructor_body---     : block---     | '=>' expression ';'---     | ';'---     ;--      def "StaticConstructorBody" $ union [-        "block">: csharp "Block",-        "expression">: csharp "Expression",-        "empty">: unit],---- // Source: §15.13 Finalizers--- finalizer_declaration---     : attributes? '~' identifier '(' ')' finalizer_body---     | attributes? 'extern' unsafe_modifier? '~' identifier '(' ')'---       finalizer_body---     | attributes? unsafe_modifier 'extern'? '~' identifier '(' ')'---       finalizer_body---     ;--      def "FinalizerDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "extern">: boolean,-        "unsafe">: boolean,-        "name">: csharp "Identifier",-        "body">: csharp "FinalizerBody"],---- finalizer_body---     : block---     | '=>' expression ';'---     | ';'---     ;--      def "FinalizerBody" $ union [-        "block">: csharp "Block",-        "expression">: csharp "Expression",-        "empty">: unit],---- // Source: §16.2.1 General--- struct_declaration---     : attributes? struct_modifier* 'ref'? 'partial'? 'struct'---       identifier type_parameter_list? struct_interfaces?---       type_parameter_constraints_clause* struct_body ';'?---     ;--      def "StructDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "StructModifier",-        "ref">: boolean,-        "partial">: boolean,-        "name">: csharp "Identifier",-        "parameters">: optional $ csharp "TypeParameterList",-        "interfaces">: list $ csharp "InterfaceType",-        "constraints">: list $ csharp "TypeParameterConstraintsClause",-        "body">: list $ csharp "StructMemberDeclaration"],---- // Source: §16.2.2 Struct modifiers--- struct_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | 'readonly'---     | unsafe_modifier   // unsafe code support---     ;--      def "StructModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "readonly",-        "unsafe"],---- // Source: §16.2.5 Struct interfaces--- struct_interfaces---     : ':' interface_type_list---     ;------ // Source: §16.2.6 Struct body--- struct_body---     : '{' struct_member_declaration* '}'---     ;------ // Source: §16.3 Struct members--- struct_member_declaration---     : constant_declaration---     | field_declaration---     | method_declaration---     | property_declaration---     | event_declaration---     | indexer_declaration---     | operator_declaration---     | constructor_declaration---     | static_constructor_declaration---     | type_declaration---     | fixed_size_buffer_declaration   // unsafe code support---     ;--      def "StructMemberDeclaration" $ union [-        "constant">: csharp "ConstantDeclaration",-        "field">: csharp "FieldDeclaration",-        "method">: csharp "MethodDeclaration",-        "property">: csharp "PropertyDeclaration",-        "event">: csharp "EventDeclaration",-        "indexer">: csharp "IndexerDeclaration",-        "operator">: csharp "OperatorDeclaration",-        "constructor">: csharp "ConstructorDeclaration",-        "staticConstructor">: csharp "StaticConstructorDeclaration",-        "type">: csharp "TypeDeclaration",-        "fixedSizeBuffer">: csharp "FixedSizeBufferDeclaration"],---- // Source: §17.7 Array initializers--- array_initializer---     : '{' variable_initializer_list? '}'---     | '{' variable_initializer_list ',' '}'---     ;--      def "ArrayInitializer" $ list $ csharp "VariableInitializer",---- variable_initializer_list---     : variable_initializer (',' variable_initializer)*---     ;------ variable_initializer---     : expression---     | array_initializer---     ;--      def "VariableInitializer" $ union [-        "expression">: csharp "Expression",-        "array">: csharp "ArrayInitializer"],---- // Source: §18.2.1 General--- interface_declaration---     : attributes? interface_modifier* 'partial'? 'interface'---       identifier variant_type_parameter_list? interface_base?---       type_parameter_constraints_clause* interface_body ';'?---     ;--      def "InterfaceDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "InterfaceModifier",-        "partial">: boolean,-        "name">: csharp "Identifier",-        "parameters">: optional $ csharp "VariantTypeParameters",-        "base">: list $ csharp "InterfaceType",-        "constraints">: list $ csharp "TypeParameterConstraintsClause",-        "body">: list $ csharp "InterfaceMemberDeclaration"],---- // Source: §18.2.2 Interface modifiers--- interface_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | unsafe_modifier   // unsafe code support---     ;--      def "InterfaceModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "unsafe"],---- // Source: §18.2.3.1 General--- variant_type_parameter_list---     : '<' variant_type_parameters '>'---     ;------ // Source: §18.2.3.1 General--- variant_type_parameters---     : attributes? variance_annotation? type_parameter---     | variant_type_parameters ',' attributes? variance_annotation?---       type_parameter---     ;--      def "VariantTypeParameters" $ list $ csharp "VariantTypeParameter",--      def "VariantTypeParameter" $ record [-        "attributes">: optional $ csharp "Attributes",-        "variance">: optional $ csharp "VarianceAnnotation",-        "parameter">: csharp "TypeParameter"],---- // Source: §18.2.3.1 General--- variance_annotation---     : 'in'---     | 'out'---     ;--      def "VarianceAnnotation" $ enum [-        "in",-        "out"],---- // Source: §18.2.4 Base interfaces--- interface_base---     : ':' interface_type_list---     ;------ // Source: §18.3 Interface body--- interface_body---     : '{' interface_member_declaration* '}'---     ;------ // Source: §18.4.1 General--- interface_member_declaration---     : interface_method_declaration---     | interface_property_declaration---     | interface_event_declaration---     | interface_indexer_declaration---     ;--      def "InterfaceMemberDeclaration" $ union [-        "method">: csharp "InterfaceMethodDeclaration",-        "property">: csharp "InterfacePropertyDeclaration",-        "event">: csharp "InterfaceEventDeclaration",-        "indexer">: csharp "InterfaceIndexerDeclaration"],---- // Source: §18.4.2 Interface methods--- interface_method_declaration---     : attributes? 'new'? return_type interface_method_header---     | attributes? 'new'? ref_kind ref_return_type interface_method_header---     ;--      def "InterfaceMethodDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "new">: boolean,-        "returnType">: csharp "ReturnType",-        "refKind">: optional $ csharp "RefKind",-        "header">: csharp "InterfaceMethodHeader"],---- interface_method_header---     : identifier '(' formal_parameter_list? ')' ';'---     | identifier type_parameter_list '(' formal_parameter_list? ')'---       type_parameter_constraints_clause* ';'---     ;--      def "InterfaceMethodHeader" $ record [-        "name">: csharp "Identifier",-        "parameters">: optional $ csharp "FormalParameterList",-        "typeParameters">: optional $ csharp "TypeParameterList",-        "constraints">: list $ csharp "TypeParameterConstraintsClause"],---- // Source: §18.4.3 Interface properties--- interface_property_declaration---     : attributes? 'new'? type identifier '{' interface_accessors '}'---     | attributes? 'new'? ref_kind type identifier '{' ref_interface_accessor '}'---     ;--      def "InterfacePropertyDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "new">: boolean,-        "refKind">: optional $ csharp "RefKind",-        "type">: csharp "Type",-        "name">: csharp "Identifier",-        "accessors">: csharp "InterfaceAccessors"],---- interface_accessors---     : attributes? 'get' ';'---     | attributes? 'set' ';'---     | attributes? 'get' ';' attributes? 'set' ';'---     | attributes? 'set' ';' attributes? 'get' ';'---     ;--      def "InterfaceAccessors" $ record [-        "attributes">: optional $ csharp "Attributes",-        "get">: optional $ csharp "Attributes",-        "set">: optional $ csharp "Attributes"],---- ref_interface_accessor---     : attributes? 'get' ';'---     ;------ // Source: §18.4.4 Interface events--- interface_event_declaration---     : attributes? 'new'? 'event' type identifier ';'---     ;--      def "InterfaceEventDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "new">: boolean,-        "type">: csharp "Type",-        "name">: csharp "Identifier"],---- // Source: §18.4.5 Interface indexers--- interface_indexer_declaration---     : attributes? 'new'? type 'this' '[' formal_parameter_list ']'---       '{' interface_accessors '}'---     | attributes? 'new'? ref_kind type 'this' '[' formal_parameter_list ']'---       '{' ref_interface_accessor '}'---     ;--      def "InterfaceIndexerDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "new">: boolean,-        "refKind">: optional $ csharp "RefKind",-        "type">: csharp "Type",-        "parameters">: csharp "FormalParameterList",-        "accessors">: csharp "InterfaceAccessors"],---- // Source: §19.2 Enum declarations--- enum_declaration---     : attributes? enum_modifier* 'enum' identifier enum_base? enum_body ';'?---     ;--      def "EnumDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "EnumModifier",-        "name">: csharp "Identifier",-        "base">: optional $ csharp "EnumBase",-        "body">: optional $ csharp "EnumBody"],---- enum_base---     : ':' integral_type---     | ':' integral_type_name---     ;--      def "EnumBase" $ union [-        "type">: csharp "IntegralType",-        "name">: csharp "TypeName"],---- integral_type_name---     : type_name // Shall resolve to an integral type other than char---     ;------ enum_body---     : '{' enum_member_declarations? '}'---     | '{' enum_member_declarations ',' '}'---     ;--      def "EnumBody" $ list $ csharp "EnumMemberDeclaration",---- // Source: §19.3 Enum modifiers--- enum_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     ;--      def "EnumModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private"],---- // Source: §19.4 Enum members--- enum_member_declarations---     : enum_member_declaration (',' enum_member_declaration)*---     ;------ // Source: §19.4 Enum members--- enum_member_declaration---     : attributes? identifier ('=' constant_expression)?---     ;--      def "EnumMemberDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "name">: csharp "Identifier",-        "value">: optional $ csharp "ConstantExpression"],---- // Source: §20.2 Delegate declarations--- delegate_declaration---     : attributes? delegate_modifier* 'delegate' return_type delegate_header---     | attributes? delegate_modifier* 'delegate' ref_kind ref_return_type---       delegate_header---     ;--      def "DelegateDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: list $ csharp "DelegateModifier",-        "returnType">: csharp "ReturnType",-        "refKind">: optional $ csharp "RefKind",-        "refReturnType">: optional $ csharp "Type",-        "header">: csharp "DelegateHeader"],---- delegate_header---     : identifier '(' formal_parameter_list? ')' ';'---     | identifier variant_type_parameter_list '(' formal_parameter_list? ')'---       type_parameter_constraints_clause* ';'---     ;--      def "DelegateHeader" $ record [-        "name">: csharp "Identifier",-        "typeParameters">: optional $ csharp "VariantTypeParameters",-        "parameters">: optional $ csharp "FormalParameterList",-        "constraints">: list $ csharp "TypeParameterConstraintsClause"],---- delegate_modifier---     : 'new'---     | 'public'---     | 'protected'---     | 'internal'---     | 'private'---     | unsafe_modifier   // unsafe code support---     ;--      def "DelegateModifier" $ enum [-        "new",-        "public",-        "protected",-        "internal",-        "private",-        "unsafe"],---- // Source: §22.3 Attribute specification--- global_attributes---     : global_attribute_section+---     ;------ global_attribute_section---     : '[' global_attribute_target_specifier attribute_list ']'---     | '[' global_attribute_target_specifier attribute_list ',' ']'---     ;--      def "GlobalAttributeSection" $ record [-        "target">: csharp "Identifier",-        "attributes">: csharp "AttributeList"],---- global_attribute_target_specifier---     : global_attribute_target ':'---     ;------ global_attribute_target---     : identifier---     ;------ attributes---     : attribute_section+---     ;--      def "Attributes" $ nonemptyList $ csharp "AttributeSection",---- attribute_section---     : '[' attribute_target_specifier? attribute_list ']'---     | '[' attribute_target_specifier? attribute_list ',' ']'---     ;--      def "AttributeSection" $ record [-        "target">: optional $ csharp "AttributeTarget",-        "attributes">: csharp "AttributeList"],---- attribute_target_specifier---     : attribute_target ':'---     ;------ attribute_target---     : identifier---     | keyword---     ;--      def "AttributeTarget" $ union [-        "identifier">: csharp "Identifier",-        "keyword">: csharp "Keyword"],---- attribute_list---     : attribute (',' attribute)*---     ;--      def "AttributeList" $ nonemptyList $ csharp "Attribute",---- attribute---     : attribute_name attribute_arguments?---     ;--      def "Attribute" $ record [-        "name">: csharp "AttributeName",-        "arguments">: optional $ csharp "AttributeArguments"],---- attribute_name---     : type_name---     ;--      def "AttributeName" $ csharp "TypeName",---- attribute_arguments---     : '(' ')'---     | '(' positional_argument_list (',' named_argument_list)? ')'---     | '(' named_argument_list ')'---     ;--      def "AttributeArguments" $ record [-        "positonal">: optional $ csharp "PositionalArgumentList",-        "named">: optional $ csharp "NamedArgumentList"],---- positional_argument_list---     : positional_argument (',' positional_argument)*---     ;--      def "PositionalArgumentList" $ nonemptyList $ csharp "PositionalArgument",---- positional_argument---     : argument_name? attribute_argument_expression---     ;--      def "PositionalArgument" $ record [-        "name">: optional $ csharp "Identifier",-        "value">: csharp "AttributeArgumentExpression"],---- named_argument_list---     : named_argument (','  named_argument)*---     ;--      def "NamedArgumentList" $ nonemptyList $ csharp "NamedArgument",---- named_argument---     : identifier '=' attribute_argument_expression---     ;--      def "NamedArgument" $ record [-        "name">: csharp "Identifier",-        "value">: csharp "AttributeArgumentExpression"],---- attribute_argument_expression---     : non_assignment_expression---     ;--      def "AttributeArgumentExpression" $ csharp "NonAssignmentExpression"]--    unsafeElements = [---- // Source: §23.2 Unsafe contexts--- unsafe_modifier---     : 'unsafe'---     ;------ unsafe_statement---     : 'unsafe' block---     ;------ // Source: §23.3 Pointer types--- pointer_type---     : value_type ('*')+---     | 'void' ('*')+---     ;--      def "PointerType" $ union [-        "valueType">: optional $ csharp "ValueType",-        "pointerDepth">: int32], -- Note: positive integer---- // Source: §23.6.2 Pointer indirection--- pointer_indirection_expression---     : '*' unary_expression---     ;------ // Source: §23.6.3 Pointer member access--- pointer_member_access---     : primary_expression '->' identifier type_argument_list?---     ;--      def "PointerMemberAccess" $ record [-        "pointer">: csharp "PrimaryExpression",-        "member">: csharp "Identifier",-        "typeArguments">: optional $ csharp "TypeArgumentList"],---- // Source: §23.6.4 Pointer element access--- pointer_element_access---     : primary_no_array_creation_expression '[' expression ']'---     ;--      def "PointerElementAccess" $ record [-        "pointer">: csharp "PrimaryNoArrayCreationExpression",-        "index">: csharp "Expression"],---- // Source: §23.6.5 The address-of operator--- addressof_expression---     : '&' unary_expression---     ;------ // Source: §23.7 The fixed statement--- fixed_statement---     : 'fixed' '(' pointer_type fixed_pointer_declarators ')' embedded_statement---     ;--      def "FixedStatement" $ record [-        "pointerType">: csharp "PointerType",-        "declarators">: nonemptyList $ csharp "FixedPointerDeclarator",-        "statement">: csharp "EmbeddedStatement"],---- fixed_pointer_declarators---     : fixed_pointer_declarator (','  fixed_pointer_declarator)*---     ;------ fixed_pointer_declarator---     : identifier '=' fixed_pointer_initializer---     ;------ fixed_pointer_initializer---     : '&' variable_reference---     | expression---     ;--      def "FixedPointerDeclarator" $ union [-        "reference">: csharp "VariableReference",-        "expression">: csharp "Expression"],---- // Source: §23.8.2 Fixed-size buffer declarations--- fixed_size_buffer_declaration---     : attributes? fixed_size_buffer_modifier* 'fixed' buffer_element_type---       fixed_size_buffer_declarators ';'---     ;--      def "FixedSizeBufferDeclaration" $ record [-        "attributes">: optional $ csharp "Attributes",-        "modifiers">: nonemptyList $ csharp "FixedSizeBufferModifier",-        "elementType">: csharp "Type",-        "declarators">: nonemptyList $ csharp "FixedSizeBufferDeclarator"],---- fixed_size_buffer_modifier---     : 'new'---     | 'public'---     | 'internal'---     | 'private'---     | 'unsafe'---     ;--      def "FixedSizeBufferModifier" $ enum [-        "new",-        "public",-        "internal",-        "private",-        "unsafe"],---- buffer_element_type---     : type---     ;------ fixed_size_buffer_declarators---     : fixed_size_buffer_declarator (',' fixed_size_buffer_declarator)*---     ;------ fixed_size_buffer_declarator---     : identifier '[' constant_expression ']'---     ;--      def "FixedSizeBufferDeclarator" $ record [-        "name">: csharp "Identifier",-        "size">: csharp "ConstantExpression"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Features.hs 
@@ -1,238 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Cypher.Features where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types-import Hydra.Sources.Tier4.Ext.Cypher.Functions--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---data FeatureSet = FeatureSet {-  featureSetName :: String,-  featureSetDescription :: String,-  featureSetChildren :: [FeatureSet]}--openCypherFeaturesModule :: Module-openCypherFeaturesModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A model for characterizing OpenCypher queries and implementations in terms of included features."-      ++ "Based on the OpenCypher grammar and the list of standard Cypher functions at "-      ++ "https://neo4j.com/docs/cypher-manual/current/functions."-      ++ " Current as of August 2024.")-  where-    ns = Namespace "hydra/ext/cypher/features"-    cypherFeatures = typeref ns--    elements = featureSetToType <$> flatten openCypherFeatures-      where-        flatten fs = if L.null children then [] else (fs:(L.concat (flatten <$> children)))-          where-            children = featureSetChildren fs-    featureSetToType (FeatureSet name desc children) = datatype ns (featureSetName name) $-        doc (featureSetDesc desc) $ record (toField <$> children)-      where-        toField (FeatureSet name1 desc1 children1) = (decapitalize name1)>: if L.null children1-          then doc (featureSetDesc desc1) boolean-          else doc (featureSetDesc desc1) $ cypherFeatures $ featureSetName name1-          where-            fieldDesc = "Whether to expect " ++ desc1-    featureSetName name = capitalize name ++ "Features"-    featureSetDesc desc = capitalize desc--openCypherFeatures :: FeatureSet-openCypherFeatures =  FeatureSet "Cypher"-  ("A set of features which characterize an OpenCypher query or implementation. "-     ++ "Any features which are omitted from the set are assumed to be unsupported or nonrequired.") [--    FeatureSet "Arithmetic" "arithmetic operations" [-      feature "plus" "the + operator",-      feature "minus" "the - operator",-      feature "multiply" "the * operator",-      feature "divide" "the / operator",-      feature "modulus" "the % operator",-      feature "powerOf" "the ^ operator"],--    FeatureSet "Atom" "various kinds of atomic expressions" [-      feature "caseExpression" "CASE expressions",-      feature "count" "the COUNT (*) expression",-      feature "existentialSubquery" "existential subqueries",-      feature "functionInvocation" "function invocation",-      feature "parameter" "parameter expressions",-      feature "patternComprehension" "pattern comprehensions",-      feature "patternPredicate" "relationship patterns as subexpressions",-      fixed $ feature "variable" "variable expressions"],--    FeatureSet "Comparison" "comparison operators and functions" [-      feature "equal" "the = comparison operator",-      feature "greaterThan" "the > comparison operator",-      feature "greaterThanOrEqual" "the >= comparison operator",-      feature "lessThan" "the < comparison operator",-      feature "lessThanOrEqual" "the <= comparison operator",-      feature "notEqual" "the <> comparison operator"],--    FeatureSet "Delete" "delete operations" [-      feature "delete" "the basic DELETE clause",-      feature "detachDelete" "the DETACH DELETE clause"],--    FeatureSet "Function" "standard Cypher functions" (libraryToFeatureSet <$> cypherLibraries),--    FeatureSet "List" "list functionality" [-      feature "listComprehension" "basic list comprehensions",-      feature "listRange" "list range comprehensions (e.g. [1..10])"],--    FeatureSet "Literal" "various types of literal values" [-      fixed $ feature "boolean" "boolean literals",-      feature "double" "double-precision floating-point literals",-      feature "integer" "integer literals",-      feature "list" "list literals",-      feature "map" "map literals",-      feature "null" "the NULL literal",-      fixed $ feature "string" "string literals"],--    FeatureSet "Logical" "logical operations" [-      feature "and" "the AND operator",-      feature "not" "the NOT operator",-      feature "or" "the OR operator",-      feature "xor" "the XOR operator"],--    FeatureSet "Match" "match queries" [-      feature "match" "the basic (non-optional) MATCH clause",-      feature "optionalMatch" "OPTIONAL MATCH"],--    FeatureSet "Merge" "merge operations" [-      feature "merge" "the basic MERGE clause",-      feature "mergeOnCreate" "MERGE with the ON CREATE action",-      feature "mergeOnMatch" "MERGE with the ON MATCH action"],--    FeatureSet "NodePattern" "node patterns" [-      feature "multipleLabels" "specifying multiple labels in a node pattern",-      feature "parameter" "specifying a parameter as part of a node pattern",-      feature "propertyMap" "specifying a key/value map of properties in a node pattern",-      fixed $ feature "variableNode" "binding a variable to a node in a node pattern",-      feature "wildcardLabel" "omitting labels from a node pattern"],--    FeatureSet "Null" "IS NULL / IS NOT NULL checks" [-      feature "isNull" "the IS NULL operator",-      feature "isNotNull" "the IS NOT NULL operator"],--    FeatureSet "Path" "path functions only found in OpenCypher" [-      function "shortestPath"],--    FeatureSet "ProcedureCall" "procedure calls" [-      feature "inQueryCall" "CALL within a query",-      feature "standaloneCall" "standalone / top-level CALL",-      -- Note: additional features are possible around YIELD-      feature "yield" "the YIELD clause in CALL"],--    FeatureSet "Projection" "projections" [-      feature "limit" "the LIMIT clause",-      feature "orderBy" "the ORDER BY clause",-      feature "projectDistinct" "the DISTINCT keyword",-      feature "projectAll" "the * projection",-      feature "projectAs" "the AS keyword",-      feature "skip" "the SKIP clause",-      feature "sortOrder" "the ASC/ASCENDING and DESC/DESCENDING keywords"],--    FeatureSet "Quantifier" "quantifier expressions" [-      feature "all" "the ALL quantifier",-      feature "any" "the ANY quantifier",-      feature "none" "the NONE quantifier",-      feature "single" "the SINGLE quantifier"],--    FeatureSet "RangeLiteral" "range literals within relationship patterns" [-      feature "bounds" "range literals with both lower and upper bounds",-      feature "exactRange" "range literals providing an exact number of repetitions",-      feature "lowerBound" "range literals with a lower bound (only)",-      feature "starRange" "the * range literal",-      feature "upperBound" "range literals with an upper bound (only)"],--    FeatureSet "Reading" "specific syntax related to reading data from the graph." [-      feature "union" "the UNION operator",-      feature "unionAll" "the UNION ALL operator",-      feature "unwind" "the UNWIND clause"],--    FeatureSet "RelationshipDirection" "relationship directions / arrow patterns" [-      feature "both" "the two-headed arrow (<-[]->) relationship direction",-      feature "left" "the left arrow (<-[]-) relationship direction",-      feature "neither" "the headless arrow (-[]-) relationship direction",-      feature "right" "the right arrow (-[]->) relationship direction"],--    FeatureSet "RelationshipPattern" "relationship patterns" [-      feature "multipleTypes" "specifying a disjunction of multiple types in a relationship pattern",-      fixed $ feature "variableRelationship" "binding a variable to a relationship in a relationship pattern",-      feature "wildcardType" "omitting types from a relationship pattern"],--    FeatureSet "Remove" "REMOVE operations" [-      feature "byLabel" "REMOVE Variable:NodeLabels",-      feature "byProperty" "REMOVE PropertyExpression"],--    FeatureSet "Set" "set definitions" [-      feature "propertyEquals" "defining a set using PropertyExpression = Expression",-      feature "variableEquals" "defining a set using Variable = Expression",-      feature "variablePlusEquals" "defining a set using Variable += Expression",-      feature "variableWithNodeLabels" "defining a set using Variable:NodeLabels"],--    FeatureSet "String" "string functions/keywords only found in OpenCypher" [-      functionWithKeyword "contains" "CONTAINS",-      functionWithKeyword "endsWith" "ENDS WITH",-      functionWithKeyword "in" "IN",-      functionWithKeyword "startsWith" "STARTS WITH"],--    FeatureSet "Updating" "specific syntax related to updating data in the graph" [-      feature "create" "the CREATE clause",-      feature "set" "the SET clause",-      feature "with" "multi-part queries using WITH"]]-  where-    feature name desc = FeatureSet name desc []-    fixed (FeatureSet name desc children)-      = FeatureSet name (desc ++ " (note: included by most if not all implementations).") children-    function name = FeatureSet name (funDesc name Nothing Nothing) []-    funDesc name mkeyword mdesc = "the " ++ name ++ "() function" ++ keyword ++ desc-      where-        keyword = Y.maybe "" (\k -> " / " ++ k) mkeyword-        desc = Y.maybe "" (\d -> ". " ++ d) mdesc-    functionWithKeyword name keyword = FeatureSet name (funDesc name (Just keyword) Nothing) []-    libraryToFeatureSet (CypherLibrary name desc funs) = FeatureSet (capitalize name ++ "Function") desc (toFeature <$> funs)-      where-        toFeature (CypherFunction name keyword forms) = FeatureSet name (funDesc name keyword $ Just desc) []-          where-            -- Note: signatures are currently not used-            desc = L.intercalate "; " (cypherFunctionFormDescription <$> forms)---- | An alternative model of (Open)Cypher features, flattened into an enumeration.--- Usage:---   writeProtobuf "/tmp/proto" [openCypherFeaturesEnumModule]-openCypherFeaturesEnumModule :: Module-openCypherFeaturesEnumModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A model with an enumeration of (Open)Cypher features.")-  where-    ns = Namespace "hydra/org/opencypher/features"-    def = datatype ns-    elements = [-      def "CypherFeature" $-        doc "An enumeration of (Open)Cypher features."-        openCypherFeaturesEnum]--openCypherFeaturesEnum :: Type-openCypherFeaturesEnum = union $ gatherFields True "" openCypherFeatures-  where-    gatherFields root prefix (FeatureSet name desc children) = if L.null children-        then [FieldType (Name selfName) $ doc (capitalize desc) unit]-        else L.concat (gatherFields False selfName <$> children)-      where-        --selfName = capitalize name-        selfName = if root-          then ""-          else prefix ++ stripFunctionSuffix (capitalize name)-    stripFunctionSuffix name = if "Function" `L.isSuffixOf` name && L.length name > flen-        then removeLastN flen name-        else name-      where-        removeLastN n xs = L.take (L.length xs - n) xs-        flen = L.length ("Function" :: String)
− src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/Functions.hs 
@@ -1,587 +0,0 @@-module Hydra.Sources.Tier4.Ext.Cypher.Functions where--data CypherFunction = CypherFunction {-  cypherFunctionName :: String,-  cypherFunctionKeyword :: Maybe String,-  cypherFunctionForms :: [CypherFunctionForm]} deriving (Eq, Ord, Show)--data CypherFunctionForm = CypherFunctionForm {-  cypherFunctionFormSignature :: String,-  cypherFunctionFormDescription :: String} deriving (Eq, Ord, Show)--data CypherLibrary = CypherLibrary {-  cypherLibraryName :: String,-  cypherLibraryDescription :: String,-  cypherLibraryFunctions :: [CypherFunction]} deriving (Eq, Ord, Show)--cypherLibraries :: [CypherLibrary]-cypherLibraries = [-  CypherLibrary "Aggregate" "aggregate functions" [-    CypherFunction "avg" (Just "AVG") [-      CypherFunctionForm-        "avg(input :: DURATION) :: DURATION"-        "Returns the average of a set of DURATION values.",-      CypherFunctionForm-        "avg(input :: FLOAT) :: FLOAT"-        "Returns the average of a set of FLOAT values.",-      CypherFunctionForm-        "avg(input :: INTEGER) :: INTEGER"-        "Returns the average of a set of INTEGER values."],-    CypherFunction "collect" (Just "COLLECT") [CypherFunctionForm-      "collect(input :: ANY) :: LIST<ANY>"-      "Returns a list containing the values returned by an expression."],-    CypherFunction "count" (Just "COUNT") [CypherFunctionForm-      "count(input :: ANY) :: INTEGER"-      "Returns the number of values or rows."],-    CypherFunction "max" (Just "MAX") [CypherFunctionForm-      "max(input :: ANY) :: ANY"-      "Returns the maximum value in a set of values."],-    CypherFunction "min" (Just "MIN") [CypherFunctionForm-      "min(input :: ANY) :: ANY"-      "Returns the minimum value in a set of values."],-    CypherFunction "percentileCont" Nothing [CypherFunctionForm-      "percentileCont(input :: FLOAT, percentile :: FLOAT) :: FLOAT"-      "Returns the percentile of a value over a group using linear interpolation."],-    CypherFunction "percentileDisc" Nothing [-      CypherFunctionForm-        "percentileDisc(input :: FLOAT, percentile :: FLOAT) :: FLOAT"-        "Returns the nearest FLOAT value to the given percentile over a group using a rounding method.",-      CypherFunctionForm-        "percentileDisc(input :: INTEGER, percentile :: FLOAT) :: INTEGER"-        "Returns the nearest INTEGER value to the given percentile over a group using a rounding method."],-    CypherFunction "stdev" Nothing [CypherFunctionForm-      "stdev(input :: FLOAT) :: FLOAT"-      "Returns the standard deviation for the given value over a group for a sample of a population."],-    CypherFunction "stdevp" Nothing [CypherFunctionForm-      "stdevp(input :: FLOAT) :: FLOAT"-      "Returns the standard deviation for the given value over a group for an entire population."],-    CypherFunction "sum" (Just "SUM") [-      CypherFunctionForm-        "sum(input :: DURATION) :: DURATION"-        "Returns the sum of a set of DURATION values.",-      CypherFunctionForm-        "sum(input :: FLOAT) :: FLOAT"-        "Returns the sum of a set of FLOAT values.",-      CypherFunctionForm-        "sum(input :: INTEGER) :: INTEGER"-        "Returns the sum of a set of INTEGER values."]],--  CypherLibrary "Database" "database functions" [-    CypherFunction "db.nameFromElementId" Nothing [CypherFunctionForm-      "db.nameFromElementId(name :: STRING) :: STRING"-      "Resolves the database name from the given element id. Introduced in 5.12."]],--  CypherLibrary "GenAI" "genAI functions" [-    CypherFunction "genai.vector.encode" Nothing [CypherFunctionForm-      "genai.vector.encode(resource :: STRING, provider :: STRING, configuration :: MAP = {}) :: LIST<FLOAT>"-      "Encode a given resource as a vector using the named provider. Introduced in 5.17."]],--  CypherLibrary "Graph" "graph functions" [-    CypherFunction "graph.byElementId" Nothing [CypherFunctionForm-      "USE graph.byElementId(elementId :: STRING)"-      "Resolves the constituent graph to which a given element id belongs. Introduced in 5.13."],-    CypherFunction "graph.byName" Nothing [CypherFunctionForm-      "USE graph.byName(name :: STRING)"-      "Resolves a constituent graph by name."],-    CypherFunction "graph.names" Nothing [CypherFunctionForm-      "graph.names() :: LIST<STRING>"-      "Returns a list containing the names of all graphs in the current composite database."],-    CypherFunction "graph.propertiesByName" Nothing [CypherFunctionForm-      "graph.propertiesByName(name :: STRING) :: MAP"-      "Returns a map containing the properties associated with the given graph."]],--  CypherLibrary "List" "list functions" [-    CypherFunction "keys" Nothing [-      CypherFunctionForm-        "keys(input :: MAP) :: LIST<STRING>"-        "Returns a LIST<STRING> containing the STRING representations for all the property names of a MAP.",-      CypherFunctionForm-        "keys(input :: NODE) :: LIST<STRING>"-        "Returns a LIST<STRING> containing the STRING representations for all the property names of a NODE.",-      CypherFunctionForm-        "keys(input :: RELATIONSHIP) :: LIST<STRING>"-        "Returns a LIST<STRING> containing the STRING representations for all the property names of a RELATIONSHIP."],-    CypherFunction "labels" Nothing [CypherFunctionForm-      "labels(input :: NODE) :: LIST<STRING>"-      "Returns a LIST<STRING> containing the STRING representations for all the labels of a NODE."],-    CypherFunction "nodes" Nothing [CypherFunctionForm-      "nodes(input :: PATH) :: LIST<NODE>"-      "Returns a LIST<NODE> containing all the NODE values in a PATH."],-    CypherFunction "range" Nothing [-      CypherFunctionForm-        "range(start :: INTEGER, end :: INTEGER) :: LIST<INTEGER>"-        "Returns a LIST<INTEGER> comprising all INTEGER values within a specified range.",-      CypherFunctionForm-        "range(start :: INTEGER, end :: INTEGER, step :: INTEGER) :: LIST<INTEGER>"-        "Returns a LIST<INTEGER> comprising all INTEGER values within a specified range created with step length."],-    CypherFunction "reduce" Nothing [CypherFunctionForm-      "reduce(accumulator :: VARIABLE = initial :: ANY, variable :: VARIABLE IN list :: LIST<ANY> | expression :: ANY) :: ANY"-      "Runs an expression against individual elements of a LIST<ANY>, storing the result of the expression in an accumulator."],-    CypherFunction "relationships" Nothing [CypherFunctionForm-      "relationships(input :: PATH) :: LIST<RELATIONSHIP>"-      "Returns a LIST<RELATIONSHIP> containing all the RELATIONSHIP values in a PATH."],-    CypherFunction "reverse" Nothing [CypherFunctionForm-      "reverse(input :: LIST<ANY>) :: LIST<ANY>"-      "Returns a LIST<ANY> in which the order of all elements in the given LIST<ANY> have been reversed."],-    CypherFunction "tail" Nothing [CypherFunctionForm-      "tail(input :: LIST<ANY>) :: LIST<ANY>"-      "Returns all but the first element in a LIST<ANY>."],-    CypherFunction "toBooleanList" Nothing [CypherFunctionForm-      "toBooleanList(input :: LIST<ANY>) :: LIST<BOOLEAN>"-      "Converts a LIST<ANY> of values to a LIST<BOOLEAN> values. If any values are not convertible to BOOLEAN they will be null in the LIST<BOOLEAN> returned."],-    CypherFunction "toFloatList" Nothing [CypherFunctionForm-      "toFloatList(input :: LIST<ANY>) :: LIST<FLOAT>"-      "Converts a LIST<ANY> to a LIST<FLOAT> values. If any values are not convertible to FLOAT they will be null in the LIST<FLOAT> returned."],-    CypherFunction "toIntegerList" Nothing [CypherFunctionForm-      "toIntegerList(input :: LIST<ANY>) :: LIST<INTEGER>"-      "Converts a LIST<ANY> to a LIST<INTEGER> values. If any values are not convertible to INTEGER they will be null in the LIST<INTEGER> returned."],-    CypherFunction "toStringList" Nothing [CypherFunctionForm-      "toStringList(input :: LIST<ANY>) :: LIST<STRING>"-      "Converts a LIST<ANY> to a LIST<STRING> values. If any values are not convertible to STRING they will be null in the LIST<STRING> returned."]],--  CypherLibrary "LoadCSV" "load CSV functions" [-    CypherFunction "file" Nothing [CypherFunctionForm-      "file() :: STRING"-      "Returns the absolute path of the file that LOAD CSV is using."],-    CypherFunction "linenumber" Nothing [CypherFunctionForm-      "linenumber() :: INTEGER"-      "Returns the line number that LOAD CSV is currently using."]],--  CypherLibrary "Logarithmic" "logarithmic functions" [-    CypherFunction "e" Nothing [CypherFunctionForm-      "e() :: FLOAT"-      "Returns the base of the natural logarithm, e."],-    CypherFunction "exp" Nothing [CypherFunctionForm-      "exp(input :: FLOAT) :: FLOAT"-      "Returns e^n, where e is the base of the natural logarithm, and n is the value of the argument expression."],-    CypherFunction "log" Nothing [CypherFunctionForm-      "log(input :: FLOAT) :: FLOAT"-      "Returns the natural logarithm of a FLOAT."],-    CypherFunction "log10" Nothing [CypherFunctionForm-      "log10(input :: FLOAT) :: FLOAT"-      "Returns the common logarithm (base 10) of a FLOAT."],-    CypherFunction "sqrt" Nothing [CypherFunctionForm-      "sqrt(input :: FLOAT) :: FLOAT"-      "Returns the square root of a FLOAT."]],--  CypherLibrary "Numeric" "numeric functions" [-    CypherFunction "abs" Nothing [-      CypherFunctionForm-        "abs(input :: FLOAT) :: FLOAT"-        "Returns the absolute value of a FLOAT.",-      CypherFunctionForm-        "abs(input :: INTEGER) :: INTEGER"-        "Returns the absolute value of an INTEGER."],-    CypherFunction "ceil" Nothing [CypherFunctionForm-      "ceil(input :: FLOAT) :: FLOAT"-      "Returns the smallest FLOAT that is greater than or equal to a number and equal to an INTEGER."],-    CypherFunction "floor" Nothing [CypherFunctionForm-      "floor(input :: FLOAT) :: FLOAT"-      "Returns the largest FLOAT that is less than or equal to a number and equal to an INTEGER."],-    CypherFunction "isNaN" Nothing [-      CypherFunctionForm-        "isNaN(input :: FLOAT) :: BOOLEAN"-        "Returns true if the floating point number is NaN.",-      CypherFunctionForm-        "isNaN(input :: INTEGER) :: BOOLEAN"-        "Returns true if the integer number is NaN."],-    CypherFunction "rand" Nothing [CypherFunctionForm-      "rand() :: FLOAT"-      "Returns a random FLOAT in the range from 0 (inclusive) to 1 (exclusive)."],-    CypherFunction "round" Nothing [-      CypherFunctionForm-        "round(input :: FLOAT) :: FLOAT"-        "Returns the value of a number rounded to the nearest INTEGER.",-      CypherFunctionForm-        "round(value :: FLOAT, precision :: INTEGER | FLOAT) :: FLOAT"-        "Returns the value of a number rounded to the specified precision using rounding mode HALF_UP.",-      CypherFunctionForm-        "round(value :: FLOAT, precision :: INTEGER | FLOAT, mode :: STRING) :: FLOAT"-        "Returns the value of a number rounded to the specified precision with the specified rounding mode."],-    CypherFunction "sign" Nothing [-      CypherFunctionForm-        "sign(input :: FLOAT) :: INTEGER"-        "Returns the signum of a FLOAT: 0 if the number is 0, -1 for any negative number, and 1 for any positive number.",-      CypherFunctionForm-        "sign(input :: INTEGER) :: INTEGER"-        "Returns the signum of an INTEGER: 0 if the number is 0, -1 for any negative number, and 1 for any positive number."]],--  CypherLibrary "Predicate" "predicate functions" [-    CypherFunction "all" Nothing [CypherFunctionForm-      "all(variable :: VARIABLE IN list :: LIST<ANY> WHERE predicate :: ANY) :: BOOLEAN"-      "Returns true if the predicate holds for all elements in the given LIST<ANY>."],-    CypherFunction "any" Nothing [CypherFunctionForm-      "any(variable :: VARIABLE IN list :: LIST<ANY> WHERE predicate :: ANY) :: BOOLEAN"-      "Returns true if the predicate holds for at least one element in the given LIST<ANY>."],-    CypherFunction "exists" Nothing [CypherFunctionForm-      "exists(input :: ANY) :: BOOLEAN"-      "Returns true if a match for the pattern exists in the graph."],-    CypherFunction "isEmpty" Nothing [-      CypherFunctionForm-        "isEmpty(input :: LIST<ANY>) :: BOOLEAN"-        "Checks whether a LIST<ANY> is empty.",-      CypherFunctionForm-        "isEmpty(input :: MAP) :: BOOLEAN"-        "Checks whether a MAP is empty.",-      CypherFunctionForm-        "isEmpty(input :: STRING) :: BOOLEAN"-        "Checks whether a STRING is empty."],-    CypherFunction "none" Nothing [CypherFunctionForm-      "none(variable :: VARIABLE IN list :: LIST<ANY> WHERE predicate :: ANY) :: BOOLEAN"-      "Returns true if the predicate holds for no element in the given LIST<ANY>."],-    CypherFunction "single" Nothing [CypherFunctionForm-      "single(variable :: VARIABLE IN list :: LIST<ANY> WHERE predicate :: ANY) :: BOOLEAN"-      "Returns true if the predicate holds for exactly one of the elements in the given LIST<ANY>."]],--  CypherLibrary "Scalar" "scalar functions" [-    CypherFunction "char_length" Nothing [CypherFunctionForm-      "char_length(input :: STRING) :: INTEGER"-      "Returns the number of Unicode characters in a STRING."],-    CypherFunction "character_length" Nothing [CypherFunctionForm-      "character_length(input :: STRING) :: INTEGER"-      "Returns the number of Unicode characters in a STRING."],-    CypherFunction "coalesce" Nothing [CypherFunctionForm-      "coalesce(input :: ANY) :: ANY"-      "Returns the first non-null value in a list of expressions."],-    CypherFunction "elementId" Nothing [-      CypherFunctionForm-        "elementId(input :: NODE) :: STRING"-        "Returns a node identifier, unique within a specific transaction and DBMS.",-      CypherFunctionForm-        "elementId(input :: RELATIONSHIP) :: STRING"-        "Returns a relationship identifier, unique within a specific transaction and DBMS."],-    CypherFunction "endNode" Nothing [CypherFunctionForm-      "elementId(input :: RELATIONSHIP) :: STRING"-      "Returns a relationship identifier, unique within a specific transaction and DBMS."],-    CypherFunction "head" Nothing [CypherFunctionForm-      "head(list :: LIST<ANY>) :: ANY"-      "Returns the first element in a LIST<ANY>."],-    CypherFunction "id" Nothing [-      CypherFunctionForm-        "id(input :: NODE) :: INTEGER"-        "[Deprecated] Returns the id of a NODE. Replaced by elementId().",-      CypherFunctionForm-        "id(input :: RELATIONSHIP) :: INTEGER"-        "[Deprecated] Returns the id of a RELATIONSHIP. Replaced by elementId()."],-    CypherFunction "last" Nothing [CypherFunctionForm-      "last(list :: LIST<ANY>) :: ANY"-      "Returns the last element in a LIST<ANY>."],-    CypherFunction "length" Nothing [CypherFunctionForm-      "length(input :: PATH) :: INTEGER"-      "Returns the length of a PATH."],-    CypherFunction "nullIf" Nothing [CypherFunctionForm-      "nullIf(v1 :: ANY, v2 :: ANY) :: ANY"-      "Returns null if the two given parameters are equivalent, otherwise returns the value of the first parameter."],-    CypherFunction "properties" Nothing [-      CypherFunctionForm-        "properties(input :: MAP) :: MAP"-        "Returns a MAP containing all the properties of a MAP.",-      CypherFunctionForm-        "properties(input :: NODE) :: MAP"-        "Returns a MAP containing all the properties of a NODE.",-      CypherFunctionForm-        "properties(input :: RELATIONSHIP) :: MAP"-        "Returns a MAP containing all the properties of a RELATIONSHIP."],-    CypherFunction "randomUUID" Nothing [CypherFunctionForm-      "randomUUID() :: STRING"-      "Generates a random UUID."],-    CypherFunction "size" Nothing [-      CypherFunctionForm-        "size(input :: LIST<ANY>) :: INTEGER"-        "Returns the number of items in a LIST<ANY>.",-      CypherFunctionForm-        "size(input :: STRING) :: INTEGER"-        "Returns the number of Unicode characters in a STRING."],-    CypherFunction "startNode" Nothing [CypherFunctionForm-      "startNode(input :: RELATIONSHIP) :: NODE"-      "Returns the start NODE of a RELATIONSHIP."],-    CypherFunction "toBoolean" Nothing [-      CypherFunctionForm-        "toBoolean(input :: STRING) :: BOOLEAN"-        "Converts a STRING value to a BOOLEAN value.",-      CypherFunctionForm-        "toBoolean(input :: BOOLEAN) :: BOOLEAN"-        "Converts a BOOLEAN value to a BOOLEAN value.",-      CypherFunctionForm-        "toBoolean(input :: INTEGER) :: BOOLEAN"-        "Converts an INTEGER value to a BOOLEAN value."],-    CypherFunction "toBooleanOrNull" Nothing [CypherFunctionForm-      "toBooleanOrNull(input :: ANY) :: BOOLEAN"-      "Converts a value to a BOOLEAN value, or null if the value cannot be converted."],-    CypherFunction "toFloat" Nothing [-      CypherFunctionForm-        "toFloat(input :: INTEGER | FLOAT) :: FLOAT"-        "Converts an INTEGER value to a FLOAT value.",-      CypherFunctionForm-        "toFloat(input :: STRING) :: FLOAT"-        "Converts a STRING value to a FLOAT value."],-    CypherFunction "toFloatOrNull" Nothing [CypherFunctionForm-      "toFloatOrNull(input :: ANY) :: FLOAT"-      "Converts a value to a FLOAT value, or null if the value cannot be converted."],-    CypherFunction "toInteger" Nothing [-      CypherFunctionForm-        "toInteger(input :: INTEGER | FLOAT) :: INTEGER"-        "Converts a FLOAT value to an INTEGER value.",-      CypherFunctionForm-        "toInteger(input :: BOOLEAN) :: INTEGER"-        "Converts a BOOLEAN value to an INTEGER value.",-      CypherFunctionForm-        "toInteger(input :: STRING) :: INTEGER"-        "Converts a STRING value to an INTEGER value."],-    CypherFunction "toIntegerOrNull" Nothing [CypherFunctionForm-      "toIntegerOrNull(input :: ANY) :: INTEGER"-      "Converts a value to an INTEGER value, or null if the value cannot be converted."],-    CypherFunction "type" Nothing [CypherFunctionForm-      "type(input :: RELATIONSHIP) :: STRING"-      "Returns a STRING representation of the RELATIONSHIP type."],-    CypherFunction "valueType" Nothing [CypherFunctionForm-      "valueType(input :: ANY) :: STRING"-      "Returns a STRING representation of the most precise value type that the given expression evaluates to."]],--  CypherLibrary "Spatial" "spatial functions" [-    CypherFunction "point.distance" Nothing [CypherFunctionForm-      "point.distance(from :: POINT, to :: POINT) :: FLOAT"-      "Returns a FLOAT representing the geodesic distance between any two points in the same CRS."],-    CypherFunction "point" Nothing [-      CypherFunctionForm-        "point(input :: MAP) :: POINT"-        "Returns a 2D point object, given two coordinate values in the Cartesian coordinate system.",-      CypherFunctionForm-        "point(input :: MAP) :: POINT"-        "Returns a 3D point object, given three coordinate values in the Cartesian coordinate system.",-      CypherFunctionForm-        "point(input :: MAP) :: POINT"-        "Returns a 2D point object, given two coordinate values in the WGS 84 geographic coordinate system.",-      CypherFunctionForm-        "point(input :: MAP) :: POINT"-        "Returns a 3D point object, given three coordinate values in the WGS 84 geographic coordinate system."],-    CypherFunction "point.withinBBox" Nothing [CypherFunctionForm-      "point.withinBBox(point :: POINT, lowerLeft :: POINT, upperRight :: POINT) :: BOOLEAN"-      "Returns true if the provided point is within the bounding box defined by the two provided points, lowerLeft and upperRight."]],--  CypherLibrary "String" "string functions" [-    CypherFunction "btrim" Nothing [-      CypherFunctionForm-        "btrim(original :: STRING) :: STRING"-        "Returns the given STRING with leading and trailing whitespace removed.",-      CypherFunctionForm-        "btrim(input :: STRING, trimCharacterString :: STRING) :: STRING"-        "Returns the given STRING with leading and trailing trimCharacterString characters removed. Introduced in 5.20."],-    CypherFunction "left" Nothing [CypherFunctionForm-      "left(original :: STRING, length :: INTEGER) :: STRING"-      "Returns a STRING containing the specified number (INTEGER) of leftmost characters in the given STRING."],-    CypherFunction "lower" Nothing [CypherFunctionForm-      "lower(input :: STRING) :: STRING"-      "Returns the given STRING in lowercase. This function is an alias to the toLower() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21."],-    CypherFunction "ltrim" Nothing [-      CypherFunctionForm-        "ltrim(input :: STRING) :: STRING"-        "Returns the given STRING with leading whitespace removed.",-      CypherFunctionForm-        "ltrim(input :: STRING, trimCharacterString :: STRING) :: STRING"-        "Returns the given STRING with leading trimCharacterString characters removed. Introduced in 5.20."],-    CypherFunction "normalize" Nothing [-      CypherFunctionForm-        "normalize(input :: STRING) :: STRING"-        "Returns the given STRING normalized according to the normalization CypherFunctionForm NFC. Introduced in 5.17.",-      CypherFunctionForm-        "normalize(input :: STRING, normalForm = NFC :: [NFC, NFD, NFKC, NFKD]) :: STRING"-        "Returns the given STRING normalized according to the specified normalization CypherFunctionForm. Introduced in 5.17."],-    CypherFunction "replace" Nothing [CypherFunctionForm-      "replace(original :: STRING, search :: STRING, replace :: STRING) :: STRING"-      "Returns a STRING in which all occurrences of a specified search STRING in the given STRING have been replaced by another (specified) replacement STRING."],-    CypherFunction "reverse" Nothing [CypherFunctionForm-      "reverse(input :: STRING) :: STRING"-      "Returns a STRING in which the order of all characters in the given STRING have been reversed."],-    CypherFunction "right" Nothing [CypherFunctionForm-      "right(original :: STRING, length :: INTEGER) :: STRING"-      "Returns a STRING containing the specified number of rightmost characters in the given STRING."],-    CypherFunction "rtrim" Nothing [-      CypherFunctionForm-        "rtrim(input :: STRING) :: STRING"-        "Returns the given STRING with trailing whitespace removed.",-      CypherFunctionForm-        "rtrim(input :: STRING, trimCharacterString :: STRING) :: STRING"-        "Returns the given STRING with trailing trimCharacterString characters removed. Introduced in 5.20."],-    CypherFunction "split" Nothing [-      CypherFunctionForm-        "split(original :: STRING, splitDelimiter :: STRING) :: LIST<STRING>"-        "Returns a LIST<STRING> resulting from the splitting of the given STRING around matches of the given delimiter.",-      CypherFunctionForm-        "split(original :: STRING, splitDelimiters :: LIST<STRING>) :: LIST<STRING>"-        "Returns a LIST<STRING> resulting from the splitting of the given STRING around matches of any of the given delimiters."],-    CypherFunction "substring" Nothing [-      CypherFunctionForm-        "substring(original :: STRING, start :: INTEGER) :: STRING"-        "Returns a substring of the given STRING, beginning with a 0-based index start.",-      CypherFunctionForm-        "substring(original :: STRING, start :: INTEGER, length :: INTEGER) :: STRING"-        "Returns a substring of a given length from the given STRING, beginning with a 0-based index start."],-    CypherFunction "toLower" Nothing [CypherFunctionForm-      "toLower(input :: STRING) :: STRING"-      "Returns the given STRING in lowercase."],-    CypherFunction "toString" Nothing [CypherFunctionForm-      "toString(input :: ANY) :: STRING"-      "Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING."],-    CypherFunction "toStringOrNull" Nothing [CypherFunctionForm-      "toStringOrNull(input :: ANY) :: STRING"-      "Converts an INTEGER, FLOAT, BOOLEAN, POINT or temporal type (i.e. DATE, ZONED TIME, LOCAL TIME, ZONED DATETIME, LOCAL DATETIME or DURATION) value to a STRING, or null if the value cannot be converted."],-    CypherFunction "toUpper" Nothing [CypherFunctionForm-      "toUpper(input :: STRING) :: STRING"-      "Returns the given STRING in uppercase."],-    CypherFunction "trim" Nothing [-      CypherFunctionForm-        "trim(input :: STRING) :: STRING"-        "Returns the given STRING with leading and trailing whitespace removed.",-      CypherFunctionForm-        "trim([LEADING | TRAILING | BOTH] [trimCharacterString :: STRING] FROM input :: STRING) :: STRING"-        "Returns the given STRING with the leading and/or trailing trimCharacterString character removed. Introduced in 5.20."],-    CypherFunction "upper" Nothing [CypherFunctionForm-      "upper(input :: STRING) :: STRING"-      "Returns the given STRING in uppercase. This function is an alias to the toUpper() function, and it was introduced as part of Cypher's GQL conformance. Introduced in 5.21."]],--  CypherLibrary "TemporalDuration" "temporal duration functions" [-    CypherFunction "duration" Nothing [CypherFunctionForm-      "duration(input :: ANY) :: DURATION"-      "Constructs a DURATION value."],-    CypherFunction "duration.between" Nothing [CypherFunctionForm-      "duration.between(from :: ANY, to :: ANY) :: DURATION"-      "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in logical units."],-    CypherFunction "duration.inDays" Nothing [CypherFunctionForm-      "duration.inDays(from :: ANY, to :: ANY) :: DURATION"-      "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in days."],-    CypherFunction "duration.inMonths" Nothing [CypherFunctionForm-      "duration.inMonths(from :: ANY, to :: ANY) :: DURATION"-      "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in months."],-    CypherFunction "duration.inSeconds" Nothing [CypherFunctionForm-      "duration.inSeconds(from :: ANY, to :: ANY) :: DURATION"-      "Computes the DURATION between the from instant (inclusive) and the to instant (exclusive) in seconds."]],--  CypherLibrary "TemporalInstant" "temporal instant functions" [-    CypherFunction "date" Nothing [CypherFunctionForm-      "date(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE"-      "Creates a DATE instant."],-    CypherFunction "date.realtime" Nothing [CypherFunctionForm-      "date.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE"-      "Returns the current DATE instant using the realtime clock."],-    CypherFunction "date.statement" Nothing [CypherFunctionForm-      "date.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE"-      "Returns the current DATE instant using the statement clock."],-    CypherFunction "date.transaction" Nothing [CypherFunctionForm-      "date.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: DATE"-      "Returns the current DATE instant using the transaction clock."],-    CypherFunction "date.truncate" Nothing [CypherFunctionForm-      "date.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: DATE"-      "Truncates the given temporal value to a DATE instant using the specified unit."],-    CypherFunction "datetime" Nothing [CypherFunctionForm-      "datetime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME"-      "Creates a ZONED DATETIME instant."],-    CypherFunction "datetime.fromepoch" Nothing [CypherFunctionForm-      "datetime.fromepoch(seconds :: INTEGER | FLOAT, nanoseconds :: INTEGER | FLOAT) :: ZONED DATETIME"-      "Creates a ZONED DATETIME given the seconds and nanoseconds since the start of the epoch."],-    CypherFunction "datetime.fromepochmillis" Nothing [CypherFunctionForm-      "datetime.fromepochmillis(milliseconds :: INTEGER | FLOAT) :: ZONED DATETIME"-      "Creates a ZONED DATETIME given the milliseconds since the start of the epoch."],-    CypherFunction "datetime.realtime" Nothing [CypherFunctionForm-      "datetime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME"-      "Returns the current ZONED DATETIME instant using the realtime clock."],-    CypherFunction "datetime.statement" Nothing [CypherFunctionForm-      "datetime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME"-      "Returns the current ZONED DATETIME instant using the statement clock."],-    CypherFunction "datetime.transaction" Nothing [CypherFunctionForm-      "datetime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED DATETIME"-      "Returns the current ZONED DATETIME instant using the transaction clock."],-    CypherFunction "datetime.truncate" Nothing [CypherFunctionForm-      "datetime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: ZONED DATETIME"-      "Truncates the given temporal value to a ZONED DATETIME instant using the specified unit."],-    CypherFunction "localdatetime" Nothing [CypherFunctionForm-      "localdatetime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME"-      "Creates a LOCAL DATETIME instant."],-    CypherFunction "localdatetime.realtime" Nothing [CypherFunctionForm-      "localdatetime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME"-      "Returns the current LOCAL DATETIME instant using the realtime clock."],-    CypherFunction "localdatetime.statement" Nothing [CypherFunctionForm-      "localdatetime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME"-      "Returns the current LOCAL DATETIME instant using the statement clock."],-    CypherFunction "localdatetime.transaction" Nothing [CypherFunctionForm-      "localdatetime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL DATETIME"-      "Returns the current LOCAL DATETIME instant using the transaction clock."],-    CypherFunction "localdatetime.truncate" Nothing [CypherFunctionForm-      "localdatetime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: LOCAL DATETIME"-      "Truncates the given temporal value to a LOCAL DATETIME instant using the specified unit."],-    CypherFunction "localtime" Nothing [CypherFunctionForm-      "localtime(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME"-      "Creates a LOCAL TIME instant."],-    CypherFunction "localtime.realtime" Nothing [CypherFunctionForm-      "localtime.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME"-      "Returns the current LOCAL TIME instant using the realtime clock."],-    CypherFunction "localtime.statement" Nothing [CypherFunctionForm-      "localtime.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME"-      "Returns the current LOCAL TIME instant using the statement clock."],-    CypherFunction "localtime.transaction" Nothing [CypherFunctionForm-      "localtime.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: LOCAL TIME"-      "Returns the current LOCAL TIME instant using the transaction clock."],-    CypherFunction "localtime.truncate" Nothing [CypherFunctionForm-      "localtime.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: LOCAL TIME"-      "Truncates the given temporal value to a LOCAL TIME instant using the specified unit."],-    CypherFunction "time" Nothing [CypherFunctionForm-      "time(input = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME"-      "Creates a ZONED TIME instant."],-    CypherFunction "time.realtime" Nothing [CypherFunctionForm-      "time.realtime(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME"-      "Returns the current ZONED TIME instant using the realtime clock."],-    CypherFunction "time.statement" Nothing [CypherFunctionForm-      "time.statement(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME"-      "Returns the current ZONED TIME instant using the statement clock."],-    CypherFunction "time.transaction" Nothing [CypherFunctionForm-      "time.transaction(timezone = DEFAULT_TEMPORAL_ARGUMENT :: ANY) :: ZONED TIME"-      "Returns the current ZONED TIME instant using the transaction clock."],-    CypherFunction "time.truncate" Nothing [CypherFunctionForm-      "time.truncate(unit :: STRING, input = DEFAULT_TEMPORAL_ARGUMENT :: ANY, fields = null :: MAP) :: ZONED TIME"-      "Truncates the given temporal value to a ZONED TIME instant using the specified unit."]],--  CypherLibrary "Trigonometric" "trigonometric functions" [-    CypherFunction "acos" Nothing [CypherFunctionForm-      "acos(input :: FLOAT) :: FLOAT"-      "Returns the arccosine of a FLOAT in radians."],-    CypherFunction "asin" Nothing [CypherFunctionForm-      "asin(input :: FLOAT) :: FLOAT"-      "Returns the arcsine of a FLOAT in radians."],-    CypherFunction "atan" Nothing [CypherFunctionForm-      "atan(input :: FLOAT) :: FLOAT"-      "Returns the arctangent of a FLOAT in radians."],-    CypherFunction "atan2" Nothing [CypherFunctionForm-      "atan2(y :: FLOAT, x :: FLOAT) :: FLOAT"-      "Returns the arctangent2 of a set of coordinates in radians."],-    CypherFunction "cos" Nothing [CypherFunctionForm-      "cos(input :: FLOAT) :: FLOAT"-      "Returns the cosine of a FLOAT."],-    CypherFunction "cot" Nothing [CypherFunctionForm-      "cot(input :: FLOAT) :: FLOAT"-      "Returns the cotangent of a FLOAT."],-    CypherFunction "degrees" Nothing [CypherFunctionForm-      "degrees(input :: FLOAT) :: FLOAT"-      "Converts radians to degrees."],-    CypherFunction "haversin" Nothing [CypherFunctionForm-      "haversin(input :: FLOAT) :: FLOAT"-      "Returns half the versine of a number."],-    CypherFunction "pi" Nothing [CypherFunctionForm-      "pi() :: FLOAT"-      "Returns the mathematical constant pi."],-    CypherFunction "radians" Nothing [CypherFunctionForm-      "radians(input :: FLOAT) :: FLOAT"-      "Converts degrees to radians."],-    CypherFunction "sin" Nothing [CypherFunctionForm-      "sin(input :: FLOAT) :: FLOAT"-      "Returns the sine of a FLOAT."],-    CypherFunction "tan" Nothing [CypherFunctionForm-      "tan(input :: FLOAT) :: FLOAT"-      "Returns the tangent of a FLOAT."]],--  CypherLibrary "Vector" "vector functions" [-    CypherFunction "vector.similarity.cosine" Nothing [CypherFunctionForm-      "vector.similarity.cosine(a :: LIST<INTEGER | FLOAT>, b :: LIST<INTEGER | FLOAT>) :: FLOAT"-      "Returns a FLOAT representing the similarity between the argument vectors based on their cosine."],-    CypherFunction "vector.similarity.euclidean" Nothing [CypherFunctionForm-      "vector.similarity.euclidean(a :: LIST<INTEGER | FLOAT>, b :: LIST<INTEGER | FLOAT>) :: FLOAT"-      "Returns a FLOAT representing the similarity between the argument vectors based on their Euclidean distance."]]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Cypher/OpenCypher.hs 
@@ -1,1049 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Cypher.OpenCypher where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---openCypherModule :: Module-openCypherModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A Cypher model based on the OpenCypher specification (version 23), copyright Neo Technology, available at:\n" ++-      "  https://opencypher.org/resources/")-  where-    ns = Namespace "hydra/ext/cypher/openCypher"-    def = datatype ns-    cypher = typeref ns--    elements = [---- Cypher = [SP], Statement, [[SP], ';'], [SP], EOI ;--- --- Statement = Query ;--- --- Query = RegularQuery---       | StandaloneCall---       ;--      def "Query" $-        union [-          "regular">: cypher "RegularQuery",-          "standalone">: cypher "StandaloneCall"],---- RegularQuery = SingleQuery, { [SP], Union } ;--      def "RegularQuery" $-        record [-          "head">: cypher "SingleQuery",-          "rest">: list $ cypher "Union"],---- Union = ((U,N,I,O,N), SP, (A,L,L), [SP], SingleQuery)---       | ((U,N,I,O,N), [SP], SingleQuery)---       ;--      def "Union" $-        record [-          "all">: boolean,-          "query">: cypher "SingleQuery"],---- SingleQuery = SinglePartQuery---             | MultiPartQuery---             ;-      def "SingleQuery" $-        union [-          "singlePart">: cypher "SinglePartQuery",-          "multiPart">: cypher "MultiPartQuery"],---- SinglePartQuery = ({ ReadingClause, [SP] }, Return)---                 | ({ ReadingClause, [SP] }, UpdatingClause, { [SP], UpdatingClause }, [[SP], Return])---                 ;--      def "SinglePartQuery" $-        record [-          "reading">: list $ cypher "ReadingClause",-          "updating">: list $ cypher "UpdatingClause",-          "return">: optional $ cypher "Return"],-          --- MultiPartQuery = { { ReadingClause, [SP] }, { UpdatingClause, [SP] }, With, [SP] }-, SinglePartQuery ;-          -      def "WithClause" $-        record [-          "reading">: list $ cypher "ReadingClause",-          "updating">: list $ cypher "UpdatingClause",-          "with">: cypher "With"],--      def "MultiPartQuery" $-        record [-          "with">: list $ cypher "WithClause",-          "body">: cypher "SinglePartQuery"],---- UpdatingClause = Create---                | Merge---                | Delete---                | Set---                | Remove---                ;--      def "UpdatingClause" $-        union [-          "create">: cypher "Create",-          "merge">: cypher "Merge",-          "delete">: cypher "Delete",-          "set">: cypher "Set",-          "remove">: cypher "Remove"],---- ReadingClause = Match---               | Unwind---               | InQueryCall---               ;--      def "ReadingClause" $-        union [-          "match">: cypher "Match",-          "unwind">: cypher "Unwind",-          "inQueryCall">: cypher "InQueryCall"],-          --- Match = [(O,P,T,I,O,N,A,L), SP], (M,A,T,C,H), [SP], Pattern, [[SP], Where] ;--      def "Match" $-        record [-          "optional">: boolean,-          "pattern">: cypher "Pattern",-          "where">: optional $ cypher "Where"],---- Unwind = (U,N,W,I,N,D), [SP], Expression, SP, (A,S), SP, Variable ;--      def "Unwind" $-        record [-          "expression">: cypher "Expression",-          "variable">: cypher "Variable"],---- Merge = (M,E,R,G,E), [SP], PatternPart, { SP, MergeAction } ;--      def "Merge" $-        record [-          "patternPart">: cypher "PatternPart",-          "actions">: list $ cypher "MergeAction"],-          --- MergeAction = ((O,N), SP, (M,A,T,C,H), SP, Set)---             | ((O,N), SP, (C,R,E,A,T,E), SP, Set)---             ;--      def "MatchOrCreate" $-        enum ["match", "create"],-        -      def "MergeAction" $-        record [-          "action">: cypher "MatchOrCreate",-          "set">: cypher "Set"],-          --- Create = (C,R,E,A,T,E), [SP], Pattern ;--      def "Create" $ cypher "Pattern",---- Set = (S,E,T), [SP], SetItem, { [SP], ',', [SP], SetItem } ;--      def "Set" $-        nonemptyList $ cypher "SetItem",---- SetItem = (PropertyExpression, [SP], '=', [SP], Expression)---         | (Variable, [SP], '=', [SP], Expression)---         | (Variable, [SP], '+=', [SP], Expression)---         | (Variable, [SP], NodeLabels)---         ;--      def "SetItem" $-        union [-          "property">: cypher "PropertyEquals",-          "variableEqual">: cypher "VariableEquals",-          "variablePlusEqual">: cypher "VariablePlusEquals",-          "variableLabels">: cypher "VariableAndNodeLabels"],--      def "PropertyEquals" $-        record [-          "lhs">: cypher "PropertyExpression",-          "rhs">: cypher "Expression"],--      def "VariableEquals" $-        record [-          "lhs">: cypher "Variable",-          "rhs">: cypher "Expression"],--      def "VariablePlusEquals" $-        record [-          "lhs">: cypher "Variable",-          "rhs">: cypher "Expression"],--      def "VariableAndNodeLabels" $-        record [-          "variable">: cypher "Variable",-          "labels">: cypher "NodeLabels"],---- Delete = [(D,E,T,A,C,H), SP], (D,E,L,E,T,E), [SP], Expression, { [SP], ',', [SP], Expression } ;--      def "Delete" $-        record [-          "detach">: boolean,-          "expressions">: nonemptyList $ cypher "Expression"],---- Remove = (R,E,M,O,V,E), SP, RemoveItem, { [SP], ',', [SP], RemoveItem } ;--      def "Remove" $-        nonemptyList $ cypher "RemoveItem",---- RemoveItem = (Variable, NodeLabels)---            | PropertyExpression---            ;--      def "RemoveItem" $-        union [-          "variableLabels">: cypher "VariableAndNodeLabels",-          "property">: cypher "PropertyExpression"],---- InQueryCall = (C,A,L,L), SP, ExplicitProcedureInvocation, [[SP], (Y,I,E,L,D), SP, YieldItems] ;--      def "InQueryCall" $-        record [-          "call">: cypher "ExplicitProcedureInvocation",-          "yieldItems">: optional $ cypher "YieldItems"],---- StandaloneCall = (C,A,L,L), SP, (ExplicitProcedureInvocation | ImplicitProcedureInvocation), [[SP], (Y,I,E,L,D), SP, ('*' | YieldItems)] ;--      def "ProcedureInvocation" $-        union [-          "explicit">: cypher "ExplicitProcedureInvocation",-          "implicit">: cypher "ImplicitProcedureInvocation"],--      def "StarOrYieldItems" $-        union [-          "star">: unit,-          "items">: cypher "YieldItems"],--      def "StandaloneCall" $-        record [-          "call">: cypher "ProcedureInvocation",-          "yieldItems">: optional $ cypher "StarOrYieldItems"],---- YieldItems = YieldItem, { [SP], ',', [SP], YieldItem }, [[SP], Where] ;--      def "YieldItems" $-        record [-          "items">: nonemptyList $ cypher "YieldItem",-          "where">: optional $ cypher "Where"],---- YieldItem = [ProcedureResultField, SP, (A,S), SP], Variable ;--      def "YieldItem" $-        record [-          "field">: optional $ cypher "ProcedureResultField",-          "variable">: cypher "Variable"],---- With = (W,I,T,H), ProjectionBody, [[SP], Where] ;--      def "With" $-        record [-          "projection">: cypher "ProjectionBody",-          "where">: optional $ cypher "Where"],---- Return = (R,E,T,U,R,N), ProjectionBody ;--      def "Return" $-        cypher "ProjectionBody",---- ProjectionBody = [[SP], (D,I,S,T,I,N,C,T)], SP, ProjectionItems, [SP, Order], [SP, Skip], [SP, Limit] ;--      def "ProjectionBody" $-        record [-          "distinct">: boolean,-          "projectionItems">: cypher "ProjectionItems",-          "order">: optional $ cypher "Order",-          "skip">: optional $ cypher "Skip",-          "limit">: optional $ cypher "Limit"],---- ProjectionItems = ('*', { [SP], ',', [SP], ProjectionItem })---                 | (ProjectionItem, { [SP], ',', [SP], ProjectionItem })---                 ;--      def "ProjectionItems" $-        record [-          "star">: boolean,-          "explicit">: list $ cypher "ProjectionItem"],---- ProjectionItem = (Expression, SP, (A,S), SP, Variable)---                | Expression---                ;--        def "ProjectionItem" $-          record [-            "expression">: cypher "Expression",-            "variable">: optional $ cypher "Variable"],---- Order = (O,R,D,E,R), SP, (B,Y), SP, SortItem, { ',', [SP], SortItem } ;--      def "Order" $-        nonemptyList $ cypher "SortItem",---- Skip = (S,K,I,P), SP, Expression ;--      def "Skip" $-        cypher "Expression",---- Limit = (L,I,M,I,T), SP, Expression ;--      def "Limit" $-        cypher "Expression",---- SortItem = Expression, [[SP], ((A,S,C,E,N,D,I,N,G) | (A,S,C) | (D,E,S,C,E,N,D,I,N,G) | (D,E,S,C))] ;--      def "SortOrder" $-        enum ["ascending", "descending"],--      def "SortItem" $-        record [-          "expression">: cypher "Expression",-          "order">: optional $ cypher "SortOrder"],---- Where = (W,H,E,R,E), SP, Expression ;--      def "Where" $-        cypher "Expression",---- Pattern = PatternPart, { [SP], ',', [SP], PatternPart } ;--      def "Pattern" $-        nonemptyList $ cypher "PatternPart",---- PatternPart = (Variable, [SP], '=', [SP], AnonymousPatternPart)---             | AnonymousPatternPart---             ;--      def "PatternPart" $-        record [-          "variable">: optional $ cypher "Variable",-          "pattern">: cypher "AnonymousPatternPart"],---- AnonymousPatternPart = PatternElement ;--        def "AnonymousPatternPart" $-          cypher "PatternElement",---- PatternElement = (NodePattern, { [SP], PatternElementChain })---                | ('(', PatternElement, ')')---                ;--      def "NodePatternChain" $-        record [-          "nodePattern">: cypher "NodePattern",-          "chain">: list $ cypher "PatternElementChain"],--      def "PatternElement" $-        union [-          "chained">: cypher "NodePatternChain",-          "parenthesized">: cypher "PatternElement"],---- RelationshipsPattern = NodePattern, { [SP], PatternElementChain }- ;--      def "RelationshipsPattern" $-        record [-          "nodePattern">: cypher "NodePattern",-          "chain">: nonemptyList $ cypher "PatternElementChain"],---- NodePattern = '(', [SP], [Variable, [SP]], [NodeLabels, [SP]], [Properties, [SP]], ')' ;-      def "NodePattern" $-        record [-          "variable">: optional $ cypher "Variable",-          "labels">: optional $ cypher "NodeLabels",-          "properties">: optional $ cypher "Properties"],---- PatternElementChain = RelationshipPattern, [SP], NodePattern ;--        def "PatternElementChain" $-          record [-            "relationship">: cypher "RelationshipPattern",-            "node">: cypher "NodePattern"],---- RelationshipPattern = (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead)---                     | (LeftArrowHead, [SP], Dash, [SP], [RelationshipDetail], [SP], Dash)---                     | (Dash, [SP], [RelationshipDetail], [SP], Dash, [SP], RightArrowHead)---                     | (Dash, [SP], [RelationshipDetail], [SP], Dash)---                     ;--        def "RelationshipPattern" $-          record [-            "leftArrow">: boolean,-            "detail">: optional $ cypher "RelationshipDetail",-            "rightArrow">: boolean],---- RelationshipDetail = '[', [SP], [Variable, [SP]], [RelationshipTypes, [SP]], [RangeLiteral], [Properties, [SP]], ']' ;--      def "RelationshipDetail" $-        record [-          "variable">: optional $ cypher "Variable",-          "types">: optional $ cypher "RelationshipTypes",-          "range">: optional $ cypher "RangeLiteral",-          "properties">: optional $ cypher "Properties"],---- Properties = MapLiteral---            | Parameter---            ;--      def "Properties" $-        union [-          "map">: cypher "MapLiteral",-          "parameter">: cypher "Parameter"],---- RelationshipTypes = ':', [SP], RelTypeName, { [SP], '|', [':'], [SP], RelTypeName } ;--      -- TODO: check whether the slight difference in colon syntax is significant-      def "RelationshipTypes" $ nonemptyList $ cypher "RelTypeName",---- NodeLabels = NodeLabel, { [SP], NodeLabel } ;--      def "NodeLabels" $ nonemptyList $ cypher "NodeLabel",---- NodeLabel = ':', [SP], LabelName ;--      def "NodeLabel" string,---- RangeLiteral = '*', [SP], [IntegerLiteral, [SP]], ['..', [SP], [IntegerLiteral, [SP]]] ;--      def "RangeLiteral" $-        record [-          "start">: optional bigint,-          "end">: optional bigint],---- LabelName = SchemaName ;--- --- RelTypeName = SchemaName ;--      def "RelTypeName" string,---- PropertyExpression = Atom, { [SP], PropertyLookup }- ;--      def "PropertyExpression" $-        record [-          "atom">: cypher "Atom",-          "lookups">: nonemptyList $ cypher "PropertyLookup"],---- Expression = OrExpression ;--      def "Expression" $ cypher "OrExpression",---- OrExpression = XorExpression, { SP, (O,R), SP, XorExpression } ;--      def "OrExpression" $ nonemptyList $ cypher "XorExpression",---- XorExpression = AndExpression, { SP, (X,O,R), SP, AndExpression } ;--      def "XorExpression" $ nonemptyList $ cypher "AndExpression",---- AndExpression = NotExpression, { SP, (A,N,D), SP, NotExpression } ;--      def "AndExpression" $ nonemptyList $ cypher "NotExpression",---- NotExpression = { (N,O,T), [SP] }, ComparisonExpression ;--      def "NotExpression" $-        record [-          "not">: boolean,-          "expression">: cypher "ComparisonExpression"],---- ComparisonExpression = StringListNullPredicateExpression, { [SP], PartialComparisonExpression } ;--      def "ComparisonExpression" $-        record [-          "left">: cypher "StringListNullPredicateExpression",-          "right">: list $ cypher "PartialComparisonExpression"],---- PartialComparisonExpression = ('=', [SP], StringListNullPredicateExpression)---                             | ('<>', [SP], StringListNullPredicateExpression)---                             | ('<', [SP], StringListNullPredicateExpression)---                             | ('>', [SP], StringListNullPredicateExpression)---                             | ('<=', [SP], StringListNullPredicateExpression)---                             | ('>=', [SP], StringListNullPredicateExpression)---                             ;--      def "ComparisonOperator" $-        enum [-          "eq",-          "neq",-          "lt",-          "gt",-          "lte",-          "gte"],--      def "PartialComparisonExpression" $-        record [-          "operator">: cypher "ComparisonOperator",-          "right">: cypher "StringListNullPredicateExpression"],---- StringListNullPredicateExpression = AddOrSubtractExpression, { StringPredicateExpression | ListPredicateExpression | NullPredicateExpression } ;--      def "StringListNullPredicateExpression" $-        record [-          "left">: cypher "AddOrSubtractExpression",-          "right">: list $ cypher "StringListNullPredicateRightHandSide"],--      def "StringListNullPredicateRightHandSide" $-        union [-          "string">: cypher "StringPredicateExpression",-          "list">: cypher "ListPredicateExpression",-          "null">: cypher "NullPredicateExpression"],---- StringPredicateExpression = ((SP, (S,T,A,R,T,S), SP, (W,I,T,H)) | (SP, (E,N,D,S), SP, (W,I,T,H)) | (SP, (C,O,N,T,A,I,N,S))), [SP], AddOrSubtractExpression ;--      def "StringPredicateExpression" $-        record [-          "operator">: cypher "StringPredicateOperator",-          "expression">: cypher "AddOrSubtractExpression"],--      def "StringPredicateOperator" $-        enum [-          "startsWith",-          "endsWith",-          "contains"],---- ListPredicateExpression = SP, (I,N), [SP], AddOrSubtractExpression ;--      def "ListPredicateExpression" $-        cypher "AddOrSubtractExpression",---- NullPredicateExpression = (SP, (I,S), SP, (N,U,L,L))---                         | (SP, (I,S), SP, (N,O,T), SP, (N,U,L,L))---                         ;--      def "NullPredicateExpression" $-        boolean, -- true: NULL, false: NOT NULL---- AddOrSubtractExpression = MultiplyDivideModuloExpression, { ([SP], '+', [SP], MultiplyDivideModuloExpression) | ([SP], '-', [SP], MultiplyDivideModuloExpression) } ;--      def "AddOrSubtractExpression" $-        record [-          "left">: cypher "MultiplyDivideModuloExpression",-          "right">: list $ cypher "AddOrSubtractRightHandSide"],--      def "AddOrSubtractRightHandSide" $-        record [-          "operator">: cypher "AddOrSubtractOperator",-          "expression">: cypher "MultiplyDivideModuloExpression"],--      def "AddOrSubtractOperator" $-        enum [-          "add",-          "subtract"],---- MultiplyDivideModuloExpression = PowerOfExpression, { ([SP], '*', [SP], PowerOfExpression) | ([SP], '/', [SP], PowerOfExpression) | ([SP], '%', [SP], PowerOfExpression) } ;--      def "MultiplyDivideModuloExpression" $-        record [-          "left">: cypher "PowerOfExpression",-          "right">: list $ cypher "MultiplyDivideModuloRightHandSide"],--      def "MultiplyDivideModuloRightHandSide" $-        record [-          "operator">: cypher "MultiplyDivideModuloOperator",-          "expression">: cypher "PowerOfExpression"],--      def "MultiplyDivideModuloOperator" $-        enum [-          "multiply",-          "divide",-          "modulo"],---- PowerOfExpression = UnaryAddOrSubtractExpression, { [SP], '^', [SP], UnaryAddOrSubtractExpression } ;--      def "PowerOfExpression" $ nonemptyList $ cypher "UnaryAddOrSubtractExpression",---- UnaryAddOrSubtractExpression = NonArithmeticOperatorExpression---                              | (('+' | '-'), [SP], NonArithmeticOperatorExpression)---                              ;--      def "UnaryAddOrSubtractExpression" $-        record [-          "operator">: optional $ cypher "AddOrSubtractOperator",-          "expression">: cypher "NonArithmeticOperatorExpression"],---- NonArithmeticOperatorExpression = Atom, { ([SP], ListOperatorExpression) | ([SP], PropertyLookup) }, [[SP], NodeLabels] ;--      def "ListOperatorExpressionOrPropertyLookup" $-        union [-          "list">: cypher "ListOperatorExpression",-          "property">: cypher "PropertyLookup"],--      def "NonArithmeticOperatorExpression" $-        record [-          "atom">: cypher "Atom",-          "listsAndLookups">: list $ cypher "ListOperatorExpressionOrPropertyLookup",-          "labels">: optional $ cypher "NodeLabels"],---- ListOperatorExpression = ('[', Expression, ']')---                        | ('[', [Expression], '..', [Expression], ']')---                        ;--      def "RangeExpression" $-         record [-            "start">: optional $ cypher "Expression",-            "end">: optional $ cypher "Expression"],--      def "ListOperatorExpression" $-        union [-          "single">: cypher "Expression",-          "range">: cypher "RangeExpression"],---- PropertyLookup = '.', [SP], (PropertyKeyName) ;--      def "PropertyLookup" $-        cypher "PropertyKeyName",---- Atom = Literal---      | Parameter---      | CaseExpression---      | ((C,O,U,N,T), [SP], '(', [SP], '*', [SP], ')')---      | ListComprehension---      | PatternComprehension---      | Quantifier---      | PatternPredicate---      | ParenthesizedExpression---      | FunctionInvocation---      | ExistentialSubquery---      | Variable---      ;--      def "Atom" $-        union [-          "literal">: cypher "Literal",-          "parameter">: cypher "Parameter",-          "case">: cypher "CaseExpression",-          "countStar">: unit,-          "listComprehension">: cypher "ListComprehension",-          "patternComprehension">: cypher "PatternComprehension",-          "quantifier">: cypher "Quantifier",-          "patternPredicate">: cypher "PatternPredicate",-          "parenthesized">: cypher "ParenthesizedExpression",-          "functionInvocation">: cypher "FunctionInvocation",-          "existentialSubquery">: cypher "ExistentialSubquery",-          "variable">: cypher "Variable"],---- CaseExpression = (((C,A,S,E), { [SP], CaseAlternative }-) | ((C,A,S,E), [SP], Expression, { [SP], CaseAlternative }-)), [[SP], (E,L,S,E), [SP], Expression], [SP], (E,N,D) ;--      def "CaseExpression" $-        record [-          "expression">: optional $ cypher "Expression",-          "alternatives">: nonemptyList $ cypher "CaseAlternative",-          "else">: optional $ cypher "Expression"],---- CaseAlternative = (W,H,E,N), [SP], Expression, [SP], (T,H,E,N), [SP], Expression ;--      def "CaseAlternative" $-        record [-          "condition">: cypher "Expression",-          "result">: cypher "Expression"],---- ListComprehension = '[', [SP], FilterExpression, [[SP], '|', [SP], Expression], [SP], ']' ;--      def "ListComprehension" $-        record [-          "left">: cypher "FilterExpression",-          "right">: optional $ cypher "Expression"],---- PatternComprehension = '[', [SP], [Variable, [SP], '=', [SP]], RelationshipsPattern, [SP], [Where, [SP]], '|', [SP], Expression, [SP], ']' ;--      def "PatternComprehension" $-        record [-          "variable">: optional $ cypher "Variable",-          "pattern">: cypher "RelationshipsPattern",-          "where">: optional $ cypher "Where",-          "right">: cypher "Expression"],---- Quantifier = ((A,L,L), [SP], '(', [SP], FilterExpression, [SP], ')')---            | ((A,N,Y), [SP], '(', [SP], FilterExpression, [SP], ')')---            | ((N,O,N,E), [SP], '(', [SP], FilterExpression, [SP], ')')---            | ((S,I,N,G,L,E), [SP], '(', [SP], FilterExpression, [SP], ')')---            ;--      def "Quantifier" $-        record [-          "operator">: cypher "QuantifierOperator",-          "expression">: cypher "FilterExpression"],--      def "QuantifierOperator" $-        enum [-          "all",-          "any",-          "none",-          "single"],---- FilterExpression = IdInColl, [[SP], Where] ;--      def "FilterExpression" $-        record [-          "idInColl">: cypher "IdInColl",-          "where">: optional $ cypher "Where"],---- PatternPredicate = RelationshipsPattern ;--      def "PatternPredicate" $ cypher "RelationshipsPattern",---- ParenthesizedExpression = '(', [SP], Expression, [SP], ')' ;--      def "ParenthesizedExpression" $ cypher "Expression",---- IdInColl = Variable, SP, (I,N), SP, Expression ;--      def "IdInColl" $-        record [-          "variable">: cypher "Variable",-          "expression">: cypher "Expression"],---- FunctionInvocation = FunctionName, [SP], '(', [SP], [(D,I,S,T,I,N,C,T), [SP]], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ;--      def "FunctionInvocation" $-        record [-          "name">: cypher "QualifiedName",-          "distinct">: boolean,-          "arguments">: list $ cypher "Expression"],---- FunctionName = Namespace, SymbolicName ;--      def "QualifiedName" $-        record [-          "namespace">: string,-          "local">: string],---- ExistentialSubquery = (E,X,I,S,T,S), [SP], '{', [SP], (RegularQuery | (Pattern, [[SP], Where])), [SP], '}' ;--      def "PatternWhere" $-        record [-          "pattern">: cypher "Pattern",-          "where">: optional $ cypher "Where"],--      def "ExistentialSubquery" $-        union [-          "regular">: cypher "RegularQuery",-          "pattern">: cypher "PatternWhere"],---- ExplicitProcedureInvocation = ProcedureName, [SP], '(', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ')' ;--      def "ExplicitProcedureInvocation" $-        record [-          "name">: cypher "QualifiedName",-          "arguments">: list $ cypher "Expression"],-          --- ImplicitProcedureInvocation = ProcedureName ;--      def "ImplicitProcedureInvocation" $ cypher "QualifiedName",---- ProcedureResultField = SymbolicName ;--      def "ProcedureResultField" string,---- ProcedureName = Namespace, SymbolicName ;---        --- Namespace = { SymbolicName, '.' } ;--- --- Variable = SymbolicName ;--      def "Variable" string,---- Literal = BooleanLiteral---         | (N,U,L,L)---         | NumberLiteral---         | StringLiteral---         | ListLiteral---         | MapLiteral---         ;--      def "Literal" $-        union [-          "boolean">: boolean,-          "null">: unit,-          "number">: cypher "NumberLiteral",-          "string">: cypher "StringLiteral",-          "list">: cypher "ListLiteral",-          "map">: cypher "MapLiteral"],-          --- BooleanLiteral = (T,R,U,E)---                | (F,A,L,S,E)---                ;--- --- NumberLiteral = DoubleLiteral---               | IntegerLiteral---               ;--      def "NumberLiteral" $-        union [-          "double">: float64,-          "integer">: bigint],---- IntegerLiteral = HexInteger---                | OctalInteger---                | DecimalInteger---                ;--- --- HexInteger = '0x', { HexDigit }- ;--- --- DecimalInteger = ZeroDigit---                | (NonZeroDigit, { Digit })---                ;--- --- OctalInteger = '0o', { OctDigit }- ;--- --- HexLetter = (A)---           | (B)---           | (C)---           | (D)---           | (E)---           | (F)---           ;--- --- HexDigit = Digit---          | HexLetter---          ;--- --- Digit = ZeroDigit---       | NonZeroDigit---       ;--- --- NonZeroDigit = NonZeroOctDigit---              | '8'---              | '9'---              ;--- --- NonZeroOctDigit = '1'---                 | '2'---                 | '3'---                 | '4'---                 | '5'---                 | '6'---                 | '7'---                 ;--- --- OctDigit = ZeroDigit---          | NonZeroOctDigit---          ;--- --- ZeroDigit = '0' ;--- --- DoubleLiteral = ExponentDecimalReal---               | RegularDecimalReal---               ;--- --- ExponentDecimalReal = ({ Digit }- | ({ Digit }-, '.', { Digit }-) | ('.', { Digit }-)), (E), ['-'], { Digit }- ;--- --- RegularDecimalReal = { Digit }, '.', { Digit }- ;--- --- StringLiteral = ('"', { ANY - ('"' | '\') | EscapedChar }, '"')---               | ("'", { ANY - ("'" | '\') | EscapedChar }, "'")---               ;--      def "StringLiteral" string,---- EscapedChar = '\', ('\' | "'" | '"' | (B) | (F) | (N) | (R) | (T) | ((U), 4 * HexDigit) | ((U), 8 * HexDigit)) ;--- --- ListLiteral = '[', [SP], [Expression, [SP], { ',', [SP], Expression, [SP] }], ']' ;--      def "ListLiteral" $-        list $ cypher "Expression",---- MapLiteral = '{', [SP], [PropertyKeyName, [SP], ':', [SP], Expression, [SP], { ',', [SP], PropertyKeyName, [SP], ':', [SP], Expression, [SP] }], '}' ;--      def "MapLiteral" $-        list $ cypher "KeyValuePair",--      def "KeyValuePair" $-        record [-          "key">: cypher "PropertyKeyName",-          "value">: cypher "Expression"],-          --- PropertyKeyName = SchemaName ;--      def "PropertyKeyName" string,---- Parameter = '$', (SymbolicName | DecimalInteger) ;--      def "Parameter" $-        union [-          "symbolic">: string,-          "integer">: bigint]]---- SchemaName = SymbolicName---            | ReservedWord---            ;--- --- ReservedWord = (A,L,L)---              | (A,S,C)---              | (A,S,C,E,N,D,I,N,G)---              | (B,Y)---              | (C,R,E,A,T,E)---              | (D,E,L,E,T,E)---              | (D,E,S,C)---              | (D,E,S,C,E,N,D,I,N,G)---              | (D,E,T,A,C,H)---              | (E,X,I,S,T,S)---              | (L,I,M,I,T)---              | (M,A,T,C,H)---              | (M,E,R,G,E)---              | (O,N)---              | (O,P,T,I,O,N,A,L)---              | (O,R,D,E,R)---              | (R,E,M,O,V,E)---              | (R,E,T,U,R,N)---              | (S,E,T)---              | (S,K,I,P)---              | (W,H,E,R,E)---              | (W,I,T,H)---              | (U,N,I,O,N)---              | (U,N,W,I,N,D)---              | (A,N,D)---              | (A,S)---              | (C,O,N,T,A,I,N,S)---              | (D,I,S,T,I,N,C,T)---              | (E,N,D,S)---              | (I,N)---              | (I,S)---              | (N,O,T)---              | (O,R)---              | (S,T,A,R,T,S)---              | (X,O,R)---              | (F,A,L,S,E)---              | (T,R,U,E)---              | (N,U,L,L)---              | (C,O,N,S,T,R,A,I,N,T)---              | (D,O)---              | (F,O,R)---              | (R,E,Q,U,I,R,E)---              | (U,N,I,Q,U,E)---              | (C,A,S,E)---              | (W,H,E,N)---              | (T,H,E,N)---              | (E,L,S,E)---              | (E,N,D)---              | (M,A,N,D,A,T,O,R,Y)---              | (S,C,A,L,A,R)---              | (O,F)---              | (A,D,D)---              | (D,R,O,P)---              ;--- --- SymbolicName = UnescapedSymbolicName---              | EscapedSymbolicName---              | HexLetter---              | (C,O,U,N,T)---              | (F,I,L,T,E,R)---              | (E,X,T,R,A,C,T)---              | (A,N,Y)---              | (N,O,N,E)---              | (S,I,N,G,L,E)---              ;--- --- UnescapedSymbolicName = IdentifierStart, { IdentifierPart } ;--- --- (* Based on the unicode identifier and pattern syntax---  *   (http://www.unicode.org/reports/tr31/)---  * And extended with a few characters.---  *)IdentifierStart = ID_Start---                 | Pc---                 ;--- --- (* Based on the unicode identifier and pattern syntax---  *   (http://www.unicode.org/reports/tr31/)---  * And extended with a few characters.---  *)IdentifierPart = ID_Continue---                | Sc---                ;--- --- (* Any character except "`", enclosed within `backticks`. Backticks are escaped with double backticks.---  *)EscapedSymbolicName = { '`', { ANY - ('`') }, '`' }- ;--- --- SP = { whitespace }- ;--- --- whitespace = SPACE---            | TAB---            | LF---            | VT---            | FF---            | CR---            | FS---            | GS---            | RS---            | US---            | ' '---            | '᠎'---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | ' '---            | '
'---            | '
'---            | ' '---            | '　'---            | ' '---            | ' '---            | ' '---            | Comment---            ;--- --- Comment = ('/*', { ANY - ('*') | ('*', ANY - ('/')) }, '*/')---         | ('//', { ANY - (LF | CR) }, [CR], (LF | EOI))---         ;--- --- LeftArrowHead = '<'---               | '⟨'---               | '〈'---               | '﹤'---               | '＜'---               ;--- --- RightArrowHead = '>'---                | '⟩'---                | '〉'---                | '﹥'---                | '＞'---                ;--- --- Dash = '-'---      | '­'---      | '‐'---      | '‑'---      | '‒'---      | '–'---      | '—'---      | '―'---      | '−'---      | '﹘'---      | '﹣'---      | '－'---      ;--- --- A = 'A' | 'a' ;--- B = 'B' | 'b' ;--- C = 'C' | 'c' ;--- D = 'D' | 'd' ;--- E = 'E' | 'e' ;--- F = 'F' | 'f' ;--- G = 'G' | 'g' ;--- H = 'H' | 'h' ;--- I = 'I' | 'i' ;--- K = 'K' | 'k' ;--- L = 'L' | 'l' ;--- M = 'M' | 'm' ;--- N = 'N' | 'n' ;--- O = 'O' | 'o' ;--- P = 'P' | 'p' ;--- Q = 'Q' | 'q' ;--- R = 'R' | 'r' ;--- S = 'S' | 's' ;--- T = 'T' | 't' ;--- U = 'U' | 'u' ;--- V = 'V' | 'v' ;--- W = 'W' | 'w' ;--- X = 'X' | 'x' ;--- Y = 'Y' | 'y' ;
− src/main/haskell/Hydra/Sources/Tier4/Ext/Graphql/Syntax.hs 
@@ -1,338 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Graphql.Syntax where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Grammars-import Hydra.Tools.GrammarToModule-import qualified Hydra.Grammar as G---and_ = terminal "&"-at_ = terminal "@"-bang_ = terminal "!"-colon_ = terminal ":"-directive_ = terminal "directive"-dollar_ = terminal "$"-ellipsis_ = terminal "..."-enum_ = terminal "enum"-equal_ = terminal "="-extend_ = terminal "extend"-false_ = terminal "false"-implements_ = terminal "implements"-input_ = terminal "input"-interface_ = terminal "interface"-lbracket_ = terminal "["-lcurly_ = terminal "{"-lparen_ = terminal "("-null_ = terminal "null"-on_ = terminal "on"-or_ = terminal "or"-rbracket_ = terminal "]"-rcurly_ = terminal "}"-repeatable_ = terminal "repeatable"-rparen_ = terminal ")"-scalar_ = terminal "scalar"-schema_ = terminal "schema"-true_ = terminal "true"-type_ = terminal "type"-union_ = terminal "union"--descriptionOpt = opt"Description"-directivesConst = "Directives" -- Directives_[Const]-directivesConstOpt = opt"Directives" -- Directives_[Const]opt--graphqlSyntaxModule :: Module-graphqlSyntaxModule = grammarToModule ns graphqlGrammar $-    Just ("A GraphQL model. Based on the (extended) BNF at:\n" ++-      "  https://spec.graphql.org/draft/#sec-Appendix-Grammar-Summary")-  where-    ns = Namespace "hydra/ext/org/graphql/syntax"--graphqlGrammar :: G.Grammar-graphqlGrammar = G.Grammar $ tokenDefinitions ++ documentDefinitions--tokenDefinitions :: [G.Production]-tokenDefinitions = [-  define "Name"        [regex "[A-Za-z][A-Za-z0-9]*"],-  define "IntValue"    [regex "-?(0|[1-9][0-9]*)"],-  define "FloatValue"  [regex "-?(0|[1-9][0-9]*)([.][0-9]+|[eE][+-]?[0-9]+)"],-  define "StringValue" [regex "[\"].*[\"]"]] -- TODO: the actual expression includes Unicode escape sequences--documentDefinitions :: [G.Production]-documentDefinitions = [-  define "Document" [-    star"Definition"],--  define "Definition" [-    "executable">: "ExecutableDefinition",-    "typeSystem">: "TypeSystemDefinitionOrExtension"],--  define "ExecutableDocument" [-    star"ExecutableDefinition"],--  define "ExecutableDefinition" [-    "operation">: "OperationDefinition",-    "fragment">: "FragmentDefinition"],--  define "OperationDefinition" [-    list["OperationType", opt"Name", opt"VariablesDefinition", opt"Directives", "SelectionSet"],-    "SelectionSet"],--  define "OperationType" [-    terminal "query",-    terminal "mutation",-    terminal "subscription"],--  define "SelectionSet" [-    list[lcurly_, star"Selection", rcurly_]],--  define "Selection" [-    "Field",-    "FragmentSpread",-    "InlineFragment"],--  define "Field" [-    list[opt"Alias", "Name", opt"Arguments", opt"Directives", opt"SelectionSet"]],--  define "Alias" [-    "Name", colon_],--  define "Arguments"{- [Const] -} [-    list[lparen_, star"Argument"{- [?Const] -}, rparen_]],--  define "Argument"{- [Const] -} [-    list["Name", colon_, "Value"{- [?Const] -}]],--  define "FragmentSpread" [-    list[ellipsis_, "FragmentName", opt"Directives"]],--  define "InlineFragment" [-    list[ellipsis_, opt"TypeCondition", opt"Directives", "SelectionSet"]],--  define "FragmentDefinition" [-    list[terminal "fragment", "FragmentName", "TypeCondition", opt"Directives", "SelectionSet"]],--  define "FragmentName" [-    "Name" {- but not on_ -}],--  define "TypeCondition" [-    on_, "NamedType"],--  define "Value"{- [Const] -} [-    {- [if not Const] -} "Variable",-    "int">: "IntValue",-    "float">: "FloatValue",-    "string">: "StringValue",-    "boolean">: "BooleanValue",-    "null">: "NullValue",-    "enum">: "EnumValue",-    "list">: "ListValue"{- [?Const] -},-    "object">: "ObjectValue"{- [?Const] -}],--  define "BooleanValue" [-    true_,-    false_],--  define "NullValue" [-    null_],--  define "EnumValue" [-    list["Name" {- but not true_ or false_ or null_ -}]],--  define "ListValue"{- [Const] -} [-    list[lbracket_, rbracket_],-    list[lbracket_, star"Value"{- [?Const] -}]],--  define "ObjectValue"{- [Const] -} [-    list[lcurly_, rcurly_],-    list[star"ObjectField"{- [?Const] -}]],--  define "ObjectField"{- [Const] -} [-    list["Name", colon_, "Value"{- [?Const] -}]],--  define "VariablesDefinition" [-    list["Variable", colon_, "Type", opt"DefaultValue", directivesConstOpt]],--  define "Variable" [-    "Name"],--  define "DefaultValue" [-    list[equal_, "Value"{- [Const] -}]],--  define "Type" [-    "named">: "NamedType",-    "list">: "ListType",-    "nonNull">: "NonNullType"],--  define "NamedType" [-    "Name"],--  define "ListType" [-    list[lbracket_, "Type", rbracket_]],--  define "NonNullType" [-    "named">: list["NamedType", bang_],-    "list">: list["ListType", bang_]],--  define "Directives"{- [Const] -} [-    star("Directive"{- [?Const] -})],--  define "Directive"{- [Const] -} [-    list[at_, "Name", opt("Arguments"{- [?Const] -})]],--  define "TypeSystemDocment" [-    star"TypeSystemDefinition"],--  define "TypeSystemDefinition" [-    "schema">: "SchemaDefinition",-    "type">: "TypeDefinition",-    "directive">: "DirectiveDefinition"],--  define "TypeSystemExtensionDocument" [-    star"TypeSystemDefinitionOrExtension"],--  define "TypeSystemDefinitionOrExtension" [-    "definition">: "TypeSystemDefinition",-    "extension">: "TypeSystemExtension"],--  define "TypeSystemExtension" [-    "schema">: "SchemaExtension",-    "type">: "TypeExtension"],--  define "SchemaDefinition" [-    list[descriptionOpt, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_]],--  define "SchemaExtension" [-    list[extend_, schema_, directivesConstOpt, lcurly_, "RootOperationTypeDefinition", rcurly_],-    list[extend_, schema_, directivesConst {- [lookahead != lcurly_] -}]],--  define "RootOperationTypeDefinition" [-    list["OperationType", colon_, "NamedType"]],--  define "Description" [-    "StringValue"],--  define "TypeDefinition" [-    "scalar">: "ScalarTypeDefinition",-    "object">: "ObjectTypeDefinition",-    "interface">: "InterfaceTypeDefinition",-    "union">: "UnionTypeDefinition",-    "enum">: "EnumTypeDefinition",-    "inputObject">: "InputObjectTypeDefinition"],--  define "TypeExtension" [-    "scalar">: "ScalarTypeExtension",-    "object">: "ObjectTypeExtension",-    "interface">: "InterfaceTypeExtension",-    "union">: "UnionTypeExtension",-    "enum">: "EnumTypeExtension",-    "inputObject">: "InputObjectTypeExtension"],--  define "ScalarTypeDefinition" [-    list[descriptionOpt, scalar_, "Name", directivesConstOpt ]],--  define "ScalarTypeExtension" [-    list[extend_, scalar_, "Name", directivesConst]],--  define "ObjectTypeDefinition" [-    list[descriptionOpt, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, opt("FieldsDefinition") {- [lookahead != lcurly_] -}]],--  define "ObjectTypeExtension" [-    list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"],-    list[extend_, type_, "Name", opt"ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}],-    list[extend_, type_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]],--  define "ImplementsInterfaces" [-    list["ImplementsInterfaces", and_, "NamedType"],-    list[implements_, opt(and_), "NamedType"]],--  define "FieldsDefinition" [-    list[lcurly_, star"FieldDefinition", rcurly_]],--  define "FieldDefinition" [-    list[descriptionOpt, "Name", opt"ArgumentsDefinition", colon_, "Type", directivesConstOpt]],--  define "ArgumentsDefinition" [-    list[lparen_, star"InputValueDefinition", rparen_]],--  define "InputValueDefinition" [-    list[descriptionOpt, "Name", colon_, "Type", opt"DefaultValue", directivesConstOpt]],--  define "InterfaceTypeDefinition" [-    list[descriptionOpt, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"],-    list[descriptionOpt, interface_, "Name", "ImplementsInterfaces", directivesConstOpt {- [lookahead != lcurly_] -}]],--  define "InterfaceTypeExtension" [-    list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConstOpt, "FieldsDefinition"],-    list[extend_, interface_, "Name", opt"ImplementsInterfaces", directivesConst {- [lookahead != lcurly_] -}],-    list[extend_, interface_, "Name", "ImplementsInterfaces" {- [lookahead != lcurly_] -}]],--  define "UnionTypeDefinition" [-    list[descriptionOpt, union_, "Name", directivesConstOpt, opt"UnionMemberTypes"]],--  define "UnionMemberTypes" [-    list["UnionMemberTypes", or_, "NamedType"],-    list[opt(or_), "NamedType"]],--  define "UnionTypeExtension" [-    list[extend_, union_, "Name", directivesConstOpt, "UnionMemberTypes"],-    list[extend_, union_, "Name", directivesConst]],--  define "EnumTypeDefinition" [-    list[descriptionOpt, enum_, "Name", directivesConstOpt, opt("EnumValuesDefinition")  {- [lookahead != lcurly_] -}]],--  define "EnumValuesDefinition" [-    list[lcurly_, star"EnumValueDefinition", rcurly_]],--  define "EnumValueDefinition" [-    list[descriptionOpt, "EnumValue", directivesConstOpt]],--  define "EnumTypeExtension" [-    list[extend_, enum_, "Name", directivesConstOpt, "EnumValuesDefinition"],-    list[extend_, enum_, "Name", directivesConst {- [lookahead != lcurly_] -}]],--  define "InputObjectTypeDefinition" [-    list[descriptionOpt, input_, "Name", directivesConstOpt, "InputFieldsDefinition"],-    list[descriptionOpt, input_, "Name", directivesConstOpt {- [lookahead != lcurly_] -}]],--  define "InputFieldsDefinition" [-    list[lcurly_, star"InputValueDefinition", rcurly_]],--  define "InputObjectTypeExtension" [-    list[extend_, input_, "Name", directivesConstOpt, "InputFieldsDefinition"],-    list[extend_, input_, "Name", directivesConst {- [lookahead != lcurly_] -}]],--  define "DirectiveDefinition" [-    list[descriptionOpt, directive_, at_, "Name", opt"ArgumentsDefinition", opt(repeatable_), on_, "DirectiveLocations"]],--  define "DirectiveLocations" [-    list["DirectiveLocations", or_, "DirectiveLocation"],-    list[opt(or_), "DirectiveLocation"]],--  define "DirectiveLocation" [-    "executable">: "ExecutableDirectiveLocation",-    "typeSystem">: "TypeSystemDirectiveLocation"],--  define "ExecutableDirectiveLocation" $ terminal <$> [-    "QUERY",-    "MUTATION",-    "SUBSCRIPTION",-    "FIELD",-    "FRAGMENT_DEFINITION",-    "FRAGMENT_SPREAD",-    "INLINE_FRAGMENT",-    "VARIABLE_DEFINITION"],--  define "TypeSystemDirectiveLocation" $ terminal <$> [-    "SCHEMA",-    "SCALAR",-    "OBJECT",-    "FIELD_DEFINITION",-    "ARGUMENT_DEFINITION",-    "INTERFACE",-    "UNION",-    "ENUM",-    "ENUM_VALUE",-    "INPUT_OBJECT",-    "INPUT_FIELD_DEFINITION"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Haskell/Ast.hs 
@@ -1,432 +0,0 @@-module Hydra.Sources.Tier4.Ext.Haskell.Ast where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---haskellAstModule :: Module-haskellAstModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just "A Haskell syntax model, loosely based on Language.Haskell.Tools.AST"-  where-    ns = Namespace "hydra/ext/haskell/ast"-    def = datatype ns-    ast = typeref ns--    elements = [--      def "Alternative" $ -- UAlt-        doc "A pattern-matching alternative" $-        record [-          "pattern">: ast "Pattern",-          "rhs">: ast "CaseRhs",-          "binds">: optional $ ast "LocalBindings"],--      def "Assertion" $ -- UAssertion (UClassAssert)-        doc "A type assertion" $-        union [-          "class">: ast "Assertion.Class",-          "tuple">: list $ ast "Assertion"],-        -- omitted for now: implicit and infix assertions--      def "Assertion.Class" $ -- UClassAssert-        record [-          "name">: ast "Name",-          "types">: list $ ast "Type"],--      def "CaseRhs" $ -- UCaseRhs'-        doc "The right-hand side of a pattern-matching alternative" $-        -- omitted for now: guarded-        ast "Expression",--      def "Constructor" $ -- UConDecl-        doc "A data constructor" $-        -- omitted for now: ordinary (positional), infix-        union [-          "ordinary">: ast "Constructor.Ordinary",-          "record">: ast "Constructor.Record"],--      def "Constructor.Ordinary" $-        doc "An ordinary (positional) data constructor" $-        record [-          "name">: ast "Name",-          "fields">: list $ ast "Type"],--      def "Constructor.Record" $-        doc "A record-style data constructor" $-        record [-          "name">: ast "Name",-          "fields">: list $ ast "FieldWithComments"],--      def "ConstructorWithComments" $-        doc "A data constructor together with any comments" $-        record [-          "body">: ast "Constructor",-          "comments">: optional string],--      def "DataDeclaration" $ -- UDataDecl-        doc "A data type declaration" $-        record [-          "keyword">: ast "DataDeclaration.Keyword",-          "context">: list $ ast "Assertion",-          "head">: ast "DeclarationHead",-          "constructors">: list $ ast "ConstructorWithComments",-          "deriving">: list $ ast "Deriving"],--      def "DataDeclaration.Keyword" $-        doc "The 'data' versus 'newtype keyword" $-        enum ["data", "newtype"],--      def "DeclarationWithComments" $-        doc "A data declaration together with any comments" $-        record [-          "body">: ast "Declaration",-          "comments">: optional string],--      def "Declaration" $ -- UDecl-        doc "A data or value declaration" $-        -- omitted for now: typeFamily, typeSignature, closedTypeFamily, gDataDecl, typeInst, dataInst, gDataInst, class, inst,-        --                  patternSynonym, deriv, fixity, default, patTypeSig, foreignImport, foreignExport, pragma,-        --                  role, splice-        union [-          "data">: ast "DataDeclaration",-          "type">: ast "TypeDeclaration",-          "valueBinding">: ast "ValueBinding",-          "typedBinding">: ast "TypedBinding"],--      def "DeclarationHead" $ -- UDeclHead-        doc "The left-hand side of a declaration" $-        -- omitted for now: infix application-        union [-          "application">: ast "DeclarationHead.Application",-          "parens">: ast "DeclarationHead",-          "simple">: ast "Name"],--      def "DeclarationHead.Application" $-        doc "An application-style declaration head" $-        record [-          "function">: ast "DeclarationHead",-          "operand">: ast "Variable"],--      def "Deriving" $ -- UDeriving-        doc "A 'deriving' statement" $-        -- omitted for now: infix, parenthesized, and application instance heads-        list $ ast "Name",--      def "Export" $ -- UExportSpec-        doc "An export statement" $-        union [-          "declaration">: ast "ImportExportSpec",-          "module">: ast "ModuleName"],--      def "Expression" $ -- UExpr-        doc "A data expression" $-        -- omitted for now: multi-if, unboxed tuple, tuple section, unboxed tuple section, parallel array,-        --                  enum, parallel array enum, list comp, parallel array comp, type application,-        --                  (all Template Haskell constructors), pragma, arrow definition, arrow application,-        --                  lambda cases, static, unboxed sum, hole-        union [-          "application">: ast "Expression.Application",-          "case">: ast "Expression.Case",-          "constructRecord">: ast "Expression.ConstructRecord",-          "do">: list $ ast "Statement", -- omitted for now: do vs. mdo-          "if">: ast "Expression.If",-          "infixApplication">: ast "Expression.InfixApplication",-          "literal">: ast "Literal",-          "lambda">: ast "Expression.Lambda",-          "leftSection">: ast "Expression.Section",-          "let">: ast "Expression.Let",-          "list">: list $ ast "Expression",-          "parens">: ast "Expression",-          "prefixApplication">: ast "Expression.PrefixApplication",-          "rightSection">: ast "Expression.Section",-          "tuple">: list $ ast "Expression",-          "typeSignature">: ast "Expression.TypeSignature",-          "updateRecord">: ast "Expression.UpdateRecord",-          "variable">: ast "Name"],--      def "Expression.Application" $-        doc "An application expression" $-        record [-          "function">: ast "Expression",-          "argument">: ast "Expression"],--      def "Expression.Case" $-        doc "A case expression" $-        record [-          "case">: ast "Expression",-          "alternatives">: list $ ast "Alternative"],--      def "Expression.ConstructRecord" $-        doc "A record constructor expression" $-        record [-          "name">: ast "Name",-          "fields">: list $ ast "FieldUpdate"],--      def "Expression.If" $-        doc "An 'if' expression" $-        record [-          "condition">: ast "Expression",-          "then">: ast "Expression",-          "else">: ast "Expression"],--      def "Expression.InfixApplication" $-        doc "An infix application expression" $-        record [-          "lhs">: ast "Expression",-          "operator">: ast "Operator",-          "rhs">: ast "Expression"],--      def "Expression.Lambda" $-        doc "A lambda expression" $-        record [-          "bindings">: list $ ast "Pattern",-          "inner">: ast "Expression"],--      def "Expression.Let" $-        doc "A 'let' expression" $-        record [-          "bindings">: list $ ast "LocalBinding",-          "inner">: ast "Expression"],--      def "Expression.PrefixApplication" $-        doc "A prefix expression" $-        record [-          "operator">: ast "Operator",-          "rhs">: ast "Expression"],--      def "Expression.Section" $-        doc "A section expression" $-        record [-          "operator">: ast "Operator",-          "expression">: ast "Expression"],--      def "Expression.TypeSignature" $-        doc "A type signature expression" $-        record [-          "inner">: ast "Expression",-          "type">: ast "Type"],--      def "Expression.UpdateRecord" $-        doc "An update record expression" $-        record [-          "inner">: ast "Expression",-          "fields">: list $ ast "FieldUpdate"],--      def "Field" $ -- UFieldDecl-        doc "A field (name/type pair)" $-        record [-          "name">: ast "Name",-          "type">: ast "Type"],--      def "FieldWithComments" $-        doc "A field together with any comments" $-        record [-          "field">: ast "Field",-          "comments">: optional string],--      def "FieldUpdate" $ -- UFieldUpdate-        doc "A field name and value" $-        -- omitted for now: pun, wildcard-        record [-          "name">: ast "Name",-          "value">: ast "Expression"],--      def "Import" $ -- UImportDecl-        doc "An import statement" $-        -- omitted for now: source, safe, pkg-        record [-          "qualified">: boolean,-          "module">: ast "ModuleName",-          "as">: optional $ ast "ModuleName",-          "spec">: optional $ ast "Import.Spec"],--      def "Import.Spec" $-        doc "An import specification" $-        union [-          "list">: list $ ast "ImportExportSpec",-          "hiding">: list $ ast "ImportExportSpec"],--      def "ImportModifier" $ -- UImportModifier-        doc "An import modifier ('pattern' or 'type')" $-        enum ["pattern", "type"],--      def "ImportExportSpec" $ -- UIESpec-        doc "An import or export specification" $-        record [-          "modifier">: optional $ ast "ImportModifier",-          "name">: ast "Name",-          "subspec">: optional $ ast "ImportExportSpec.Subspec"],--      def "ImportExportSpec.Subspec" $-        union [-          "all">: unit,-          "list">: list $ ast "Name"],--      def "Literal" $ -- ULiteral-        doc "A literal value" $-        -- omitted for now: frac, primChar-        union [-          "char">: uint16,-          "double">: float64,-          "float">: float32,-          "int">: int32,-          "integer">: bigint,-          "string">: string],--      def "LocalBinding" $ -- ULocalBind-        -- omitted for now: fixity, pragma-        union [-          "signature">: ast "TypeSignature",-          "value">: ast "ValueBinding"],--      def "LocalBindings" $ -- ULocalBinds-        list $ ast "LocalBinding",--      def "Module" $ -- UModule-        -- omitted for now: pragma-        record [-          "head">: optional $ ast "ModuleHead",-          "imports">: list $ ast "Import",-          "declarations">: list $ ast "DeclarationWithComments"],--      def "ModuleHead" $ -- UModuleHead-        -- omitted for now: pragma-        record [-          "comments">: optional string,-          "name">: ast "ModuleName",-          "exports">: list $ ast "Export"], -- UExportSpecs--      def "ModuleName" -- UModuleName-        string,--      def "Name" $ -- UName-        union [-          "implicit">: ast "QualifiedName",-          "normal">: ast "QualifiedName",-          "parens">: ast "QualifiedName"],--      def "NamePart" -- UNamePart-        string,--      def "Operator" $ -- UOperator-        union [-          "backtick">: ast "QualifiedName",-          "normal">: ast "QualifiedName"],--      def "Pattern" $ -- UPattern-        -- omitted for now: unboxed tuples, parallel arrays, irrefutable, bang, view, splice, quasiquote, plusk, unboxed sum-        union [-          "application">: ast "Pattern.Application",-          "as">: ast "Pattern.As",-          "list">: list $ ast "Pattern",-          "literal">: ast "Literal",-          "name">: ast "Name",-          "parens">: ast "Pattern",-          "record">: ast "Pattern.Record",-          "tuple">: list $ ast "Pattern",-          "typed">: ast "Pattern.Typed",-          "wildcard">: unit],--      def "Pattern.Application" $-        record [-          "name">: ast "Name",-          "args">: list $ ast "Pattern"],--      def "Pattern.As" $-        record [-          "name">: ast "Name",-          "inner">: ast "Pattern"],--      def "Pattern.Record" $-        record [-          "name">: ast "Name",-          "fields">: list $ ast "PatternField"],--      def "Pattern.Typed" $-        record [-          "inner">: ast "Pattern",-          "type">: ast "Type"],--      def "PatternField" $ -- UPatternField-        -- omitted for now: puns, wildcards-        record [-          "name">: ast "Name",-          "pattern">: ast "Pattern"],--      def "QualifiedName" $ -- UQualifiedName-        record [-          "qualifiers">: list $ ast "NamePart",-          "unqualified">: ast "NamePart"],--      def "RightHandSide" $ -- URhs-        -- omitted for now: guarded rhs-        ast "Expression",--      def "Statement" $ -- UStmt-        ast "Expression",--      def "Type" $ -- UType-        -- omitted for now: forall, unboxed tuple, parallel array, kinded, promoted, splice, quasiquote, bang,-        --                  lazy, unpack, nounpack, wildcard, named wildcard, sum-        union [-          "application">: ast "Type.Application",-          "ctx">: ast "Type.Context",-          "function">: ast "Type.Function",-          "infix">: ast "Type.Infix",-          "list">: ast "Type",-          "parens">: ast "Type",-          "tuple">: list $ ast "Type",-          "variable">: ast "Name"],--      def "Type.Application" $-        record [-          "context">: ast "Type",-          "argument">: ast "Type"],--      def "Type.Context" $-        record [-          "ctx">: ast "Assertion", -- UContext-          "type">: ast "Type"],--      def "Type.Function" $-        record [-          "domain">: ast "Type",-          "codomain">: ast "Type"],--      def "Type.Infix" $-        record [-          "lhs">: ast "Type",-          "operator">: ast "Operator",-          "rhs">: ast "Operator"],--      def "TypeDeclaration" $ -- UTypeDecl-        record [-          "name">: ast "DeclarationHead",-          "type">: ast "Type"],--      def "TypeSignature" $ -- UTypeSignature-        record [-          "name">: ast "Name",-          "type">: ast "Type"],--      def "TypedBinding" $ -- Added for convenience-        record [-          "typeSignature">: ast "TypeSignature",-          "valueBinding">: ast "ValueBinding"],--      def "ValueBinding" $ -- UValueBind-        -- omitted for now: funBind-        union [-          "simple">: ast "ValueBinding.Simple"],--      def "ValueBinding.Simple" $-        record [-          "pattern">: ast "Pattern",-          "rhs">: ast "RightHandSide",-          "localBindings">: optional $ ast "LocalBindings"],--      def "Variable" $-        -- omitted for now: kind constraints-        ast "Name"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Language.hs 
@@ -1,143 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Java.Language where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Base as Base-import Hydra.Dsl.Lib.Equality as Equality-import Hydra.Dsl.Lib.Flows as Flows-import Hydra.Dsl.Lib.Lists as Lists-import Hydra.Dsl.Lib.Logic as Logic-import Hydra.Dsl.Lib.Maps as Maps-import Hydra.Dsl.Lib.Sets as Sets-import Hydra.Dsl.Lib.Strings as Strings-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Data.Set as S---javaLanguageDefinition :: String -> TTerm a -> TElement a-javaLanguageDefinition = definitionInModule javaLanguageModule--javaLanguageModule :: Module-javaLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule] tier0Modules $-    Just "Language constraints for Java"-  where-    ns = Namespace "hydra/ext/java/language"-    elements = [-      el javaMaxTupleLengthDef,-      el javaLanguageDef,-      el reservedWordsDef-      ]--javaMaxTupleLengthDef :: TElement Int-javaMaxTupleLengthDef = javaLanguageDefinition "javaMaxTupleLength" $-  doc ("The maximum supported length of a tuple in Hydra-Java. "-    <> "Note: if this constant is changed, also change Tuples.java correspondingly") $-  int32 9--javaLanguageDef :: TElement (Language)-javaLanguageDef = javaLanguageDefinition "javaLanguage" $-  doc "Language constraints for Java" $-  typed languageT $-  record _Language [-    _Language_name>>: wrap _LanguageName "hydra/ext/java",-    _Language_constraints>>: record _LanguageConstraints [-      _LanguageConstraints_eliminationVariants>>: Sets.fromList @@ ref eliminationVariantsDef,-      _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [-        _LiteralVariant_boolean, -- boolean-        _LiteralVariant_float, -- (see float types)-        _LiteralVariant_integer, -- (see integer types)-        _LiteralVariant_string]), -- string-      _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [-         -- Bigfloat (e.g. as Java's BigDecimal) is excluded for now-        _FloatType_float32, -- float-        _FloatType_float64]), -- double-      _LanguageConstraints_functionVariants>>: Sets.fromList @@ ref functionVariantsDef,-      _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [-        _IntegerType_bigint, -- BigInteger-        _IntegerType_int8, -- byte (signed, 8-bit)-        _IntegerType_int16, -- short (signed, 16-bit)-        _IntegerType_int32, -- int (signed, 32-bit)-        _IntegerType_int64, -- long (signed, 64-bit)-        _IntegerType_uint16]), -- char (unsigned, 16-bit)-      _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [-        _TermVariant_application,-        _TermVariant_function,-        _TermVariant_let,-        _TermVariant_list,-        _TermVariant_literal,-        _TermVariant_map,-        _TermVariant_optional,-        _TermVariant_product,-        _TermVariant_record,-        _TermVariant_set,-        _TermVariant_union,-        _TermVariant_variable,-        _TermVariant_wrap]),-      _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [-        _TypeVariant_annotated,-        _TypeVariant_application,-        _TypeVariant_function,-        _TypeVariant_lambda,-        _TypeVariant_list,-        _TypeVariant_literal,-        _TypeVariant_map,-        _TypeVariant_optional,-        _TypeVariant_product,-        _TypeVariant_record,-        _TypeVariant_set,-        _TypeVariant_union,-        _TypeVariant_variable,-        _TypeVariant_wrap]),-      _LanguageConstraints_types>>: match _Type (Just true) [-        _Type_product>>: lambda "types" $ Equality.ltInt32 @@ (Lists.length @@ var "types") @@ (ref javaMaxTupleLengthDef)-      ]]]--reservedWordsDef :: TElement (S.Set String)-reservedWordsDef = javaLanguageDefinition "reservedWords" $-  doc "A set of reserved words in Java" $-  typed (setT stringT) $-  (Sets.fromList @@ (Lists.concat @@ list [var "specialNames", var "classNames", var "keywords", var "literals"]))-  `with` [-    "specialNames">:-      doc "Special names reserved for use by Hydra" $-      list ["Elements"],--    "classNames">:-      doc ("java.lang classes as of JDK 7\n"-        <> "See: https://docs.oracle.com/javase/7/docs/api/java/lang/package-summary.html") $-      list [-        "AbstractMethodError", "Appendable", "ArithmeticException", "ArrayIndexOutOfBoundsException",-        "ArrayStoreException", "AssertionError", "AutoCloseable", "Boolean", "BootstrapMethodError", "Byte",-        "CharSequence", "Character", "Class", "ClassCastException", "ClassCircularityError", "ClassFormatError",-        "ClassLoader", "ClassNotFoundException", "ClassValue", "CloneNotSupportedException", "Cloneable", "Comparable",-        "Compiler", "Deprecated", "Double", "Enum", "EnumConstantNotPresentException", "Error", "Exception",-        "ExceptionInInitializerError", "Float", "IllegalAccessError", "IllegalAccessException",-        "IllegalArgumentException", "IllegalMonitorStateException", "IllegalStateException",-        "IllegalThreadStateException", "IncompatibleClassChangeError", "IndexOutOfBoundsException",-        "InheritableThreadLocal", "InstantiationError", "InstantiationException", "Integer", "InternalError",-        "InterruptedException", "Iterable", "LinkageError", "Long", "Math", "NegativeArraySizeException",-        "NoClassDefFoundError", "NoSuchFieldError", "NoSuchFieldException", "NoSuchMethodError", "NoSuchMethodException",-        "NullPointerException", "Number", "NumberFormatException", "Object", "OutOfMemoryError", "Override", "Package",-        "Process", "ProcessBuilder", "Readable", "ReflectiveOperationException", "Runnable", "Runtime",-        "RuntimeException", "RuntimePermission", "SafeVarargs", "SecurityException", "SecurityManager", "Short",-        "StackOverflowError", "StackTraceElement", "StrictMath", "String", "StringBuffer", "StringBuilder",-        "StringIndexOutOfBoundsException", "SuppressWarnings", "System", "Thread", "ThreadDeath",-        "ThreadGroup", "ThreadLocal", "Throwable", "TypeNotPresentException",-        "UnknownError", "UnsatisfiedLinkError", "UnsupportedClassVersionError",-        "UnsupportedOperationException", "VerifyError", "VirtualMachineError", "Void"],--    "keywords">:-      doc ("Keywords and literals are taken from Oracle's Java Tutorials on 2022-05-27; said to be complete for Java 1.8 only\n"-          <> "See: https://docs.oracle.com/javase/tutorial/java/nutsandbolts/_keywords.html") $-      list [-        "abstract", "assert", "boolean", "break", "byte", "case", "catch", "char", "class", "const", "continue",-        "default", "do", "double", "else", "enum", "extends", "final", "finally", "float", "for", "goto", "if",-        "implements", "import", "instanceof", "int", "interface", "long", "native", "new", "package", "private",-        "protected", "public", "return", "short", "static", "strictfp", "super", "switch", "synchronized", "this",-        "throw", "throws", "transient", "try", "void", "volatile", "while"],--    "literals">:-      list ["false", "null", "true"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Java/Syntax.hs 
@@ -1,1742 +0,0 @@-module Hydra.Sources.Tier4.Ext.Java.Syntax where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Types as Types-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap---javaSyntaxModule :: Module-javaSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A Java syntax module. Based on the Oracle Java SE 12 BNF:\n" ++-      "  https://docs.oracle.com/javase/specs/jls/se12/html/jls-19.html\n" ++-      "Note: all *WithComments types were added manually, rather than derived from the BNF, which does not allow for comments.")-  where-    ns = Namespace "hydra/ext/java/syntax"-    def = datatype ns-    java = typeref ns--    elements = [----Productions from §3 (Lexical Structure)----Identifier:---  IdentifierChars but not a Keyword or BooleanLiteral or NullLiteral-      def "Identifier" string,---IdentifierChars:---  JavaLetter {JavaLetterOrDigit}------JavaLetter:---  any Unicode character that is a "Java letter"------JavaLetterOrDigit:---  any Unicode character that is a "Java letter-or-digit"----TypeIdentifier:---  Identifier but not var-      def "TypeIdentifier" $ java "Identifier",----Literal:-      def "Literal" $-        union [---  NullLiteral-          "null">: unit,---  IntegerLiteral-          "integer">: java "IntegerLiteral",---  FloatingPointLiteral-          "floatingPoint">: java "FloatingPointLiteral",---  BooleanLiteral-          "boolean">: boolean,---  CharacterLiteral-          "character">: uint16,---  StringLiteral-          "string">: java "StringLiteral"],-      def "IntegerLiteral" $-        doc "Note: this is an approximation which ignores encoding"-        bigint,-      def "FloatingPointLiteral" $-        doc "Note: this is an approximation which ignores encoding"-        bigfloat,-      def "StringLiteral" $-        doc "Note: this is an approximation which ignores encoding"-        string,----Productions from §4 (Types, Values, and Variables)----Type:-      def "Type" $ union [---  PrimitiveType-          "primitive">: java "PrimitiveTypeWithAnnotations",---  ReferenceType-          "reference">: java "ReferenceType"],----PrimitiveType:-      def "PrimitiveTypeWithAnnotations" $ record [-        "type">: java "PrimitiveType",-        "annotations">: list $ java "Annotation"],-      def "PrimitiveType" $ union [---  {Annotation} NumericType-        "numeric">: java "NumericType",---  {Annotation} boolean-        "boolean">: unit],----NumericType:-      def "NumericType" $ union [---  IntegralType-        "integral">: java "IntegralType",---  FloatingPointType-        "floatingPoint">: java "FloatingPointType"],----IntegralType:-      def "IntegralType" $ enum [---  (one of)---  byte short int long char-        "byte", "short", "int", "long", "char"],----FloatingPointType:-      def "FloatingPointType" $ enum [---  (one of)---  float double-        "float", "double"],----ReferenceType:-      def "ReferenceType" $ union [---  ClassOrInterfaceType-        "classOrInterface">: java "ClassOrInterfaceType",---  TypeVariable-        "variable">: java "TypeVariable",---  ArrayType-        "array">: java "ArrayType"],----ClassOrInterfaceType:-      def "ClassOrInterfaceType" $ union [---  ClassType-        "class">: java "ClassType",---  InterfaceType-        "interface">: java "InterfaceType"],----ClassType:-      def "ClassType" $ record [-        "annotations">: list $ java "Annotation",-        "qualifier">: java "ClassTypeQualifier",-        "identifier">: java "TypeIdentifier",-        "arguments">: list $ java "TypeArgument"],-      def "ClassTypeQualifier" $ union [---  {Annotation} TypeIdentifier [TypeArguments]-        "none">: unit,---  PackageName . {Annotation} TypeIdentifier [TypeArguments]-        "package">: java "PackageName",---  ClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments]-        "parent">: java "ClassOrInterfaceType"],----InterfaceType:---  ClassType-      def "InterfaceType" $ java "ClassType",----TypeVariable:---  {Annotation} TypeIdentifier-      def "TypeVariable" $ record [-        "annotations">: list $ java "Annotation",-        "identifier">: java "TypeIdentifier"],----ArrayType:-      def "ArrayType" $ record [-        "dims">: java "Dims",-        "variant">: java "ArrayType.Variant"],-      def "ArrayType.Variant" $ union [---  PrimitiveType Dims-        "primitive">: java "PrimitiveTypeWithAnnotations",---  ClassOrInterfaceType Dims-        "classOrInterface">: java "ClassOrInterfaceType",---  TypeVariable Dims-        "variable">: java "TypeVariable"],----Dims:---  {Annotation} [ ] {{Annotation} [ ]}-      def "Dims" $ list $ list $ java "Annotation",----TypeParameter:---  {TypeParameterModifier} TypeIdentifier [TypeBound]-      def "TypeParameter" $ record [-        "modifiers">: list $ java "TypeParameterModifier",-        "identifier">: java "TypeIdentifier",-        "bound">: optional $ java "TypeBound"],----TypeParameterModifier:---  Annotation-      def "TypeParameterModifier" $ java "Annotation",----TypeBound:-      def "TypeBound" $ union [---  extends TypeVariable-        "variable">: java "TypeVariable",---  extends ClassOrInterfaceType {AdditionalBound}-        "classOrInterface">: java "TypeBound.ClassOrInterface"],-      def "TypeBound.ClassOrInterface" $ record [-        "type">: java "ClassOrInterfaceType",-        "additional">: list $ java "AdditionalBound"],----AdditionalBound:---  & InterfaceType-      def "AdditionalBound" $ java "InterfaceType",----TypeArguments:---  < TypeArgumentList >---TypeArgumentList:---  TypeArgument {, TypeArgument}----TypeArgument:-      def "TypeArgument" $ union [---  ReferenceType-        "reference">: java "ReferenceType",---  Wildcard-        "wildcard">: java "Wildcard"],----Wildcard:---  {Annotation} ? [WildcardBounds]-      def "Wildcard" $ record [-        "annotations">: list $ java "Annotation",-        "wildcard">: optional $ java "WildcardBounds"],----WildcardBounds:-      def "WildcardBounds" $ union [---  extends ReferenceType-        "extends">: java "ReferenceType",---  super ReferenceType-        "super">: java "ReferenceType"],----Productions from §6 (Names)----ModuleName:-      def "ModuleName" $ record [---  Identifier-        "identifier">: java "Identifier",---  ModuleName . Identifier-        "name">: optional $ java "ModuleName"],----PackageName:---  Identifier---  PackageName . Identifier-      def "PackageName" $ list $ java "Identifier",----TypeName:-      def "TypeName" $ record [---  TypeIdentifier-        "identifier">: java "TypeIdentifier",---  PackageOrTypeName . TypeIdentifier-        "qualifier">: optional $ java "PackageOrTypeName"],----ExpressionName:---  Identifier---  AmbiguousName . Identifier-      def "ExpressionName" $ record [-        "qualifier">: optional $ java "AmbiguousName",-        "identifier">: java "Identifier"],----MethodName:---  Identifier-      def "MethodName" $ java "Identifier",----PackageOrTypeName:---  Identifier---  PackageOrTypeName . Identifier-      def "PackageOrTypeName" $ list $ java "Identifier",----AmbiguousName:---  Identifier---  AmbiguousName . Identifier-      def "AmbiguousName" $ list $ java "Identifier",----Productions from §7 (Packages and Modules)----CompilationUnit:-      def "CompilationUnit" $ union [---  OrdinaryCompilationUnit-        "ordinary">: java "OrdinaryCompilationUnit",---  ModularCompilationUnit-        "modular">: java "ModularCompilationUnit"],----OrdinaryCompilationUnit:---  [PackageDeclaration] {ImportDeclaration} {TypeDeclaration}-      def "OrdinaryCompilationUnit" $ record [-        "package">: optional $ java "PackageDeclaration",-        "imports">: list $ java "ImportDeclaration",-        "types">: list $ java "TypeDeclarationWithComments"],----ModularCompilationUnit:---  {ImportDeclaration} ModuleDeclaration-      def "ModularCompilationUnit" $ record [-        "imports">: list $ java "ImportDeclaration",-        "module">: java "ModuleDeclaration"],----PackageDeclaration:---  {PackageModifier} package Identifier {. Identifier} ;-      def "PackageDeclaration" $ record [-        "modifiers">: list $ java "PackageModifier",-        "identifiers">: list $ java "Identifier"],----PackageModifier:---  Annotation-      def "PackageModifier" $ java "Annotation",----ImportDeclaration:-      def "ImportDeclaration" $ union [---  SingleTypeImportDeclaration-        "singleType">: java "SingleTypeImportDeclaration",---  TypeImportOnDemandDeclaration-        "typeImportOnDemand">: java "TypeImportOnDemandDeclaration",---  SingleStaticImportDeclaration-        "singleStaticImport">: java "SingleStaticImportDeclaration",---  StaticImportOnDemandDeclaration-        "staticImportOnDemand">: java "StaticImportOnDemandDeclaration"],----SingleTypeImportDeclaration:---  import TypeName ;-      def "SingleTypeImportDeclaration" $ java "TypeName",----TypeImportOnDemandDeclaration:---  import PackageOrTypeName . * ;-      def "TypeImportOnDemandDeclaration" $ java "PackageOrTypeName",----SingleStaticImportDeclaration:---  import static TypeName . Identifier ;-      def "SingleStaticImportDeclaration" $ record [-        "typeName">: java "TypeName",-        "identifier">: java "Identifier"],----StaticImportOnDemandDeclaration:---  import static TypeName . * ;-      def "StaticImportOnDemandDeclaration" $ java "TypeName",----TypeDeclaration:-      def "TypeDeclaration" $ union [---  ClassDeclaration-        "class">: java "ClassDeclaration",---  InterfaceDeclaration-        "interface">: java "InterfaceDeclaration",---  ;-        "none">: unit],-      def "TypeDeclarationWithComments" $-        record [-          "value">: java "TypeDeclaration",-          "comments">: optional string],----ModuleDeclaration:---  {Annotation} [open] module Identifier {. Identifier} { {ModuleDirective} }-      def "ModuleDeclaration" $ record [-        "annotations">: list $ java "Annotation",-        "open">: boolean,-        "identifiers">: list $ java "Identifier",-        "directives">: list $ list $ java "ModuleDirective"],----ModuleDirective:-      def "ModuleDirective" $ union [---  requires {RequiresModifier} ModuleName ;-        "requires">: java "ModuleDirective.Requires",---  exports PackageName [to ModuleName {, ModuleName}] ;-        "exports">: java "ModuleDirective.ExportsOrOpens",---  opens PackageName [to ModuleName {, ModuleName}] ;-        "opens">: java "ModuleDirective.ExportsOrOpens",---  uses TypeName ;-        "uses">: java "TypeName",---  provides TypeName with TypeName {, TypeName} ;-        "provides">: java "ModuleDirective.Provides"],-      def "ModuleDirective.Requires" $ record [-        "modifiers">: list $ java "RequiresModifier",-        "module">: java "ModuleName"],-      def "ModuleDirective.ExportsOrOpens" $ record [-        "package">: java "PackageName",-        "modules">:-          doc "At least one module" $-          list $ java "ModuleName"],-      def "ModuleDirective.Provides" $ record [-        "to">: java "TypeName",-        "with">:-          doc "At least one type" $-          list $ java "TypeName"],----RequiresModifier:-      def "RequiresModifier" $ enum [---  (one of)---  transitive static-        "transitive", "static"],----Productions from §8 (Classes)----ClassDeclaration:-      def "ClassDeclaration" $ union [---  NormalClassDeclaration-        "normal">: java "NormalClassDeclaration",---  EnumDeclaration-        "enum">: java "EnumDeclaration"],----NormalClassDeclaration:---  {ClassModifier} class TypeIdentifier [TypeParameters] [Superclass] [Superinterfaces] ClassBody-      def "NormalClassDeclaration" $ record [-        "modifiers">: list $ java "ClassModifier",-        "identifier">: java "TypeIdentifier",-        "parameters">: list $ java "TypeParameter",-        "extends">: optional $ java "ClassType",-        "implements">: list $ java "InterfaceType",-        "body">: java "ClassBody"],----ClassModifier:-      def "ClassModifier" $ union [---  (one of)---  Annotation public protected private---  abstract static final strictfp-        "annotation">: java "Annotation",-        "public">: unit,-        "protected">: unit,-        "private">: unit,-        "abstract">: unit,-        "static">: unit,-        "final">: unit,-        "strictfp">: unit],----TypeParameters:---  < TypeParameterList >---TypeParameterList:---  TypeParameter {, TypeParameter}---Superclass:---  extends ClassType---Superinterfaces:---  implements InterfaceTypeList---InterfaceTypeList:---  InterfaceType {, InterfaceType}----ClassBody:---  { {ClassBodyDeclaration} }-      def "ClassBody" $ list $ java "ClassBodyDeclarationWithComments",----ClassBodyDeclaration:-      def "ClassBodyDeclaration" $ union [---  ClassMemberDeclaration-        "classMember">: java "ClassMemberDeclaration",---  InstanceInitializer-        "instanceInitializer">: java "InstanceInitializer",---  StaticInitializer-        "staticInitializer">: java "StaticInitializer",---  ConstructorDeclaration-        "constructorDeclaration">: java "ConstructorDeclaration"],-      def "ClassBodyDeclarationWithComments" $-        record [-          "value">: java "ClassBodyDeclaration",-          "comments">: optional string],----ClassMemberDeclaration:-      def "ClassMemberDeclaration" $ union [---  FieldDeclaration-        "field">: java "FieldDeclaration",---  MethodDeclaration-        "method">: java "MethodDeclaration",---  ClassDeclaration-        "class">: java "ClassDeclaration",---  InterfaceDeclaration-        "interface">: java "InterfaceDeclaration",---  ;-        "none">: unit],----FieldDeclaration:---  {FieldModifier} UnannType VariableDeclaratorList ;-      def "FieldDeclaration" $ record [-        "modifiers">: list $ java "FieldModifier",-        "unannType">: java "UnannType",-        "variableDeclarators">: nonemptyList $ java "VariableDeclarator"],----FieldModifier:---  (one of)-      def "FieldModifier" $ union [---  Annotation public protected private---  static final transient volatile-        "annotation">: java "Annotation",-        "public">: unit,-        "protected">: unit,-        "private">: unit,-        "static">: unit,-        "final">: unit,-        "transient">: unit,-        "volatile">: unit],----VariableDeclaratorList:---  VariableDeclarator {, VariableDeclarator}---VariableDeclarator:---  VariableDeclaratorId [= VariableInitializer]-      def "VariableDeclarator" $ record [-        "id">: java "VariableDeclaratorId",-        "initializer">: optional $ java "VariableInitializer"],----VariableDeclaratorId:---  Identifier [Dims]-      def "VariableDeclaratorId" $ record [-        "identifier">: java "Identifier",-        "dims">: optional $ java "Dims"],----VariableInitializer:-      def "VariableInitializer" $ union [---  Expression-        "expression">: java "Expression",---  ArrayInitializer-        "arrayInitializer">: java "ArrayInitializer"],----UnannType:---  UnannPrimitiveType---  UnannReferenceType-      def "UnannType" $-        doc "A Type which does not allow annotations" $-        java "Type",---UnannPrimitiveType:---  NumericType---  boolean---UnannReferenceType:---  UnannClassOrInterfaceType---  UnannTypeVariable---  UnannArrayType---UnannClassOrInterfaceType:---  UnannClassType---  UnannInterfaceType---UnannClassType:---  TypeIdentifier [TypeArguments]---  PackageName . {Annotation} TypeIdentifier [TypeArguments]---  UnannClassOrInterfaceType . {Annotation} TypeIdentifier [TypeArguments]-      def "UnannClassType" $-        doc "A ClassType which does not allow annotations" $-        java "ClassType",---UnannInterfaceType:---  UnannClassType---UnannTypeVariable:---  TypeIdentifier---UnannArrayType:---  UnannPrimitiveType Dims---  UnannClassOrInterfaceType Dims---  UnannTypeVariable Dims----MethodDeclaration:---  {MethodModifier} MethodHeader MethodBody-      def "MethodDeclaration" $ record [-        "annotations">:-          doc "Note: simple methods cannot have annotations" $-          list $ java "Annotation",-        "modifiers">: list $ java "MethodModifier",-        "header">: java "MethodHeader",-        "body">: java "MethodBody"],----MethodModifier:---  (one of)-      def "MethodModifier" $ union [---  Annotation public protected private---  abstract static final synchronized native strictfp-        "annotation">: java "Annotation",-        "public">: unit,-        "protected">: unit,-        "private">: unit,-        "abstract">: unit,-        "static">: unit,-        "final">: unit,-        "synchronized">: unit,-        "native">: unit,-        "strictfb">: unit],----MethodHeader:---  Result MethodDeclarator [Throws]---  TypeParameters {Annotation} Result MethodDeclarator [Throws]-      def "MethodHeader" $ record [-        "parameters">: list $ java "TypeParameter",-        "result">: java "Result",-        "declarator">: java "MethodDeclarator",-        "throws">: optional $ java "Throws"],----Result:-      def "Result" $ union [---  UnannType-        "type">: java "UnannType",---  void-        "void">: unit],----MethodDeclarator:---  Identifier ( [ReceiverParameter ,] [FormalParameterList] ) [Dims]-      def "MethodDeclarator" $ record [-        "identifier">: java "Identifier",-        "receiverParameter">: optional $ java "ReceiverParameter",-        "formalParameters">: nonemptyList $ java "FormalParameter"],----ReceiverParameter:---  {Annotation} UnannType [Identifier .] this-      def "ReceiverParameter" $ record [-        "annotations">: list $ java "Annotation",-        "unannType">: java "UnannType",-        "identifier">: optional $ java "Identifier"],----FormalParameterList:---  FormalParameter {, FormalParameter}---FormalParameter:-      def "FormalParameter" $ union [---  {VariableModifier} UnannType VariableDeclaratorId-        "simple">: java "FormalParameter.Simple",---  VariableArityParameter-        "variableArity">: java "VariableArityParameter"],-      def "FormalParameter.Simple" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "UnannType",-        "id">: java "VariableDeclaratorId"],----VariableArityParameter:---  {VariableModifier} UnannType {Annotation} ... Identifier-      def "VariableArityParameter" $ record [-        "modifiers">: java "VariableModifier",-        "type">: java "UnannType",-        "annotations">: list $ java "Annotation",-        "identifier">: java "Identifier"],----VariableModifier:-      def "VariableModifier" $ union [---  Annotation-        "annotation">: java "Annotation",---  final-        "final">: unit],----Throws:---  throws ExceptionTypeList-      def "Throws" $ nonemptyList $ java "ExceptionType",----ExceptionTypeList:---  ExceptionType {, ExceptionType}---ExceptionType:-      def "ExceptionType" $ union [---  ClassType-        "class">: java "ClassType",---  TypeVariable-        "variable">: java "TypeVariable"],----MethodBody:-      def "MethodBody" $ union [---  Block-        "block">: java "Block",---  ;-        "none">: unit],----InstanceInitializer:---  Block-      def "InstanceInitializer" $ java "Block",----StaticInitializer:---  static Block-      def "StaticInitializer" $ java "Block",----ConstructorDeclaration:---  {ConstructorModifier} ConstructorDeclarator [Throws] ConstructorBody-      def "ConstructorDeclaration" $ record [-        "modifiers">: list $ java "ConstructorModifier",-        "constructor">: java "ConstructorDeclarator",-        "throws">: optional $ java "Throws",-        "body">: java "ConstructorBody"],----ConstructorModifier:---  (one of)-      def "ConstructorModifier" $ union [---  Annotation public protected private-        "annotation">: java "Annotation",-        "public">: unit,-        "protected">: unit,-        "private">: unit],----ConstructorDeclarator:---  [TypeParameters] SimpleTypeName ( [ReceiverParameter ,] [FormalParameterList] )-      def "ConstructorDeclarator" $ record [-        "parameters">: list $ java "TypeParameter",-        "name">: java "SimpleTypeName",-        "receiverParameter">: optional $ java "ReceiverParameter",-        "formalParameters">: nonemptyList $ java "FormalParameter"],----SimpleTypeName:---  TypeIdentifier-      def "SimpleTypeName" $ java "TypeIdentifier",----ConstructorBody:---  { [ExplicitConstructorInvocation] [BlockStatements] }-      def "ConstructorBody" $ record [-        "invocation">: optional $ java "ExplicitConstructorInvocation",-        "statements">: list $ java "BlockStatement"],----ExplicitConstructorInvocation:-      def "ExplicitConstructorInvocation" $ record [-        "typeArguments">: list $ java "TypeArgument",-        "arguments">: list $ java "Expression",-        "variant">: java "ExplicitConstructorInvocation.Variant"],-      def "ExplicitConstructorInvocation.Variant" $ union [---  [TypeArguments] this ( [ArgumentList] ) ;-        "this">: unit,---  [TypeArguments] super ( [ArgumentList] ) ;---  ExpressionName . [TypeArguments] super ( [ArgumentList] ) ;-        "super">: optional $ java "ExpressionName",---  Primary . [TypeArguments] super ( [ArgumentList] ) ;-        "primary">: java "Primary"],----EnumDeclaration:---  {ClassModifier} enum TypeIdentifier [Superinterfaces] EnumBody-      def "EnumDeclaration" $ record [-        "modifiers">: list $ java "ClassModifier",-        "identifier">: java "TypeIdentifier",-        "implements">: list $ java "InterfaceType",-        "body">: java "EnumBody"],----EnumBody:---  { [EnumConstantList] [,] [EnumBodyDeclarations] }-      def "EnumBody" $ list $ java "EnumBody.Element",-      def "EnumBody.Element" $ record [-        "constants">: list $ java "EnumConstant",-        "bodyDeclarations">: list $ java "ClassBodyDeclaration"],----EnumConstantList:---  EnumConstant {, EnumConstant}---EnumConstant:---  {EnumConstantModifier} Identifier [( [ArgumentList] )] [ClassBody]-      def "EnumConstant" $ record [-        "modifiers">: list $ java "EnumConstantModifier",-        "identifier">: java "Identifier",-        "arguments">: list $ list $ java "Expression",-        "body">: optional $ java "ClassBody"],----EnumConstantModifier:---  Annotation-      def "EnumConstantModifier" $ java "Annotation",----EnumBodyDeclarations:---  ; {ClassBodyDeclaration}----Productions from §9 (Interfaces)----InterfaceDeclaration:-      def "InterfaceDeclaration" $ union [---  NormalInterfaceDeclaration-        "normalInterface">: java "NormalInterfaceDeclaration",---  AnnotationTypeDeclaration-        "annotationType">: java "AnnotationTypeDeclaration"],----NormalInterfaceDeclaration:---  {InterfaceModifier} interface TypeIdentifier [TypeParameters] [ExtendsInterfaces] InterfaceBody-      def "NormalInterfaceDeclaration" $ record [-        "modifiers">: list $ java "InterfaceModifier",-        "identifier">: java "TypeIdentifier",-        "parameters">: list $ java "TypeParameter",-        "extends">: list $ java "InterfaceType",-        "body">: java "InterfaceBody"],----InterfaceModifier:---  (one of)-      def "InterfaceModifier" $ union [---  Annotation public protected private---  abstract static strictfp-        "annotation">: java "Annotation",-        "public">: unit,-        "protected">: unit,-        "private">: unit,-        "abstract">: unit,-        "static">: unit,-        "strictfb">: unit],----ExtendsInterfaces:---  extends InterfaceTypeList----InterfaceBody:---  { {InterfaceMemberDeclaration} }-      def "InterfaceBody" $ list $ java "InterfaceMemberDeclaration",----InterfaceMemberDeclaration:-      def "InterfaceMemberDeclaration" $ union [---  ConstantDeclaration-        "constant">: java "ConstantDeclaration",---  InterfaceMethodDeclaration-        "interfaceMethod">: java "InterfaceMethodDeclaration",---  ClassDeclaration-        "class">: java "ClassDeclaration",---  InterfaceDeclaration-        "interface">: java "InterfaceDeclaration"],---  ;----ConstantDeclaration:---  {ConstantModifier} UnannType VariableDeclaratorList ;-      def "ConstantDeclaration" $ record [-        "modifiers">: list $ java "ConstantModifier",-        "type">: java "UnannType",-        "variables">: nonemptyList $ java "VariableDeclarator"],----ConstantModifier:---  (one of)-      def "ConstantModifier" $ union [---  Annotation public---  static final-        "annotation">: java "Annotation",-        "public">: unit,-        "static">: unit,-        "final">: unit],----InterfaceMethodDeclaration:---  {InterfaceMethodModifier} MethodHeader MethodBody-      def "InterfaceMethodDeclaration" $ record [-        "modifiers">: list $ java "InterfaceMethodModifier",-        "header">: java "MethodHeader",-        "body">: java "MethodBody"],----InterfaceMethodModifier:---  (one of)-      def "InterfaceMethodModifier" $ union [---  Annotation public private---  abstract default static strictfp-        "annotation">: java "Annotation",-        "public">: unit,-        "private">: unit,-        "abstract">: unit,-        "default">: unit,-        "static">: unit,-        "strictfp">: unit],----AnnotationTypeDeclaration:---  {InterfaceModifier} @ interface TypeIdentifier AnnotationTypeBody-      def "AnnotationTypeDeclaration" $ record [-        "modifiers">: list $ java "InterfaceModifier",-        "identifier">: java "TypeIdentifier",-        "body">: java "AnnotationTypeBody"],----AnnotationTypeBody:---  { {AnnotationTypeMemberDeclaration} }-      def "AnnotationTypeBody" $ list $ list $ java "AnnotationTypeMemberDeclaration",----AnnotationTypeMemberDeclaration:-      def "AnnotationTypeMemberDeclaration" $ union [---  AnnotationTypeElementDeclaration-        "annotationType">: java "AnnotationTypeElementDeclaration",---  ConstantDeclaration-        "constant">: java "ConstantDeclaration",---  ClassDeclaration-        "class">: java "ClassDeclaration",---  InterfaceDeclaration-        "interface">: java "InterfaceDeclaration"],---  ;----AnnotationTypeElementDeclaration:---  {AnnotationTypeElementModifier} UnannType Identifier ( ) [Dims] [DefaultValue] ;-      def "AnnotationTypeElementDeclaration" $ record [-        "modifiers">: list $ java "AnnotationTypeElementModifier",-        "type">: java "UnannType",-        "identifier">: java "Identifier",-        "dims">: optional $ java "Dims",-        "default">: optional $ java "DefaultValue"],----AnnotationTypeElementModifier:---  (one of)-      def "AnnotationTypeElementModifier" $ union [---  Annotation public-        "public">: java "Annotation",---  abstract-        "abstract">: unit],----DefaultValue:---  default ElementValue-      def "DefaultValue" $ java "ElementValue",----Annotation:-      def "Annotation" $ union [---  NormalAnnotation-        "normal">: java "NormalAnnotation",---  MarkerAnnotation-        "marker">: java "MarkerAnnotation",---  SingleElementAnnotation-        "singleElement">: java "SingleElementAnnotation"],----NormalAnnotation:---  @ TypeName ( [ElementValuePairList] )-      def "NormalAnnotation" $ record [-        "typeName">: java "TypeName",-        "pairs">: list $ java "ElementValuePair"],----ElementValuePairList:---  ElementValuePair {, ElementValuePair}---ElementValuePair:---  Identifier = ElementValue-      def "ElementValuePair" $ record [-        "key">: java "Identifier",-        "value">: java "ElementValue"],----ElementValue:-      def "ElementValue" $ union [---  ConditionalExpression-        "conditionalExpression">: java "ConditionalExpression",---  ElementValueArrayInitializer-        "elementValueArrayInitializer">: java "ElementValueArrayInitializer",---  Annotation-        "annotation">: java "Annotation"],----ElementValueArrayInitializer:---  { [ElementValueList] [,] }-      def "ElementValueArrayInitializer" $ list $ java "ElementValue",---ElementValueList:---  ElementValue {, ElementValue}----MarkerAnnotation:---  @ TypeName-      def "MarkerAnnotation" $ java "TypeName",----SingleElementAnnotation:-      def "SingleElementAnnotation" $ record [---  @ TypeName ( ElementValue )-        "name">: java "TypeName",-        "value">: optional $ java "ElementValue"],----  Productions from §10 (Arrays)----ArrayInitializer:---  { [VariableInitializerList] [,] }-      def "ArrayInitializer" $ list $ list $ java "VariableInitializer",---VariableInitializerList:---  VariableInitializer {, VariableInitializer}----Productions from §14 (Blocks and Statements)----Block:---  { [BlockStatements] }-      def "Block" $ list $ java "BlockStatement",----BlockStatements:---  BlockStatement {BlockStatement}---BlockStatement:-      def "BlockStatement" $ union [---  LocalVariableDeclarationStatement-        "localVariableDeclaration">: java "LocalVariableDeclarationStatement",---  ClassDeclaration-        "class">: java "ClassDeclaration",---  Statement-        "statement">: java "Statement"],----LocalVariableDeclarationStatement:---  LocalVariableDeclaration ;-      def "LocalVariableDeclarationStatement" $ java "LocalVariableDeclaration",----LocalVariableDeclaration:---  {VariableModifier} LocalVariableType VariableDeclaratorList-      def "LocalVariableDeclaration" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "LocalVariableType",-        "declarators">: nonemptyList $ java "VariableDeclarator"],----LocalVariableType:-      def "LocalVariableType" $ union [---  UnannType-        "type">: java "UnannType",---  var-        "var">: unit],----Statement:-      def "Statement" $ union [---  StatementWithoutTrailingSubstatement-        "withoutTrailing">: java "StatementWithoutTrailingSubstatement",---  LabeledStatement-        "labeled">: java "LabeledStatement",---  IfThenStatement-        "ifThen">: java "IfThenStatement",---  IfThenElseStatement-        "ifThenElse">: java "IfThenElseStatement",---  WhileStatement-        "while">: java "WhileStatement",---  ForStatement-        "for">: java "ForStatement"],----StatementNoShortIf:-      def "StatementNoShortIf" $ union [---  StatementWithoutTrailingSubstatement-        "withoutTrailing">: java "StatementWithoutTrailingSubstatement",---  LabeledStatementNoShortIf-        "labeled">: java "LabeledStatementNoShortIf",---  IfThenElseStatementNoShortIf-        "ifThenElse">: java "IfThenElseStatementNoShortIf",---  WhileStatementNoShortIf-        "while">: java "WhileStatementNoShortIf",---  ForStatementNoShortIf-        "for">: java "ForStatementNoShortIf"],----StatementWithoutTrailingSubstatement:-      def "StatementWithoutTrailingSubstatement" $ union [---  Block-        "block">: java "Block",---  EmptyStatement-        "empty">: java "EmptyStatement",---  ExpressionStatement-        "expression">: java "ExpressionStatement",---  AssertStatement-        "assert">: java "AssertStatement",---  SwitchStatement-        "switch">: java "SwitchStatement",---  DoStatement-        "do">: java "DoStatement",---  BreakStatement-        "break">: java "BreakStatement",---  ContinueStatement-        "continue">: java "ContinueStatement",---  ReturnStatement-        "return">: java "ReturnStatement",---  SynchronizedStatement-        "synchronized">: java "SynchronizedStatement",---  ThrowStatement-        "throw">: java "ThrowStatement",---  TryStatement-        "try">: java "TryStatement"],----EmptyStatement:---  ;-      def "EmptyStatement" unit,----LabeledStatement:---  Identifier : Statement-      def "LabeledStatement" $ record [-        "identifier">: java "Identifier",-        "statement">: java "Statement"],----LabeledStatementNoShortIf:---  Identifier : StatementNoShortIf-      def "LabeledStatementNoShortIf" $ record [-        "identifier">: java "Identifier",-        "statement">: java "StatementNoShortIf"],----ExpressionStatement:---  StatementExpression ;-      def "ExpressionStatement" $ java "StatementExpression",----StatementExpression:-      def "StatementExpression" $ union [---  Assignment-        "assignment">: java "Assignment",---  PreIncrementExpression-        "preIncrement">: java "PreIncrementExpression",---  PreDecrementExpression-        "preDecrement">: java "PreDecrementExpression",---  PostIncrementExpression-        "postIncrement">: java "PostIncrementExpression",---  PostDecrementExpression-        "postDecrement">: java "PostDecrementExpression",---  MethodInvocation-        "methodInvocation">: java "MethodInvocation",---  ClassInstanceCreationExpression-        "classInstanceCreation">: java "ClassInstanceCreationExpression"],----IfThenStatement:---  if ( Expression ) Statement-      def "IfThenStatement" $ record [-        "expression">: java "Expression",-        "statement">: java "Statement"],----IfThenElseStatement:---  if ( Expression ) StatementNoShortIf else Statement-      def "IfThenElseStatement" $ record [-        "cond">: optional $ java "Expression",-        "then">: java "StatementNoShortIf",-        "else">: java "Statement"],----IfThenElseStatementNoShortIf:---  if ( Expression ) StatementNoShortIf else StatementNoShortIf-      def "IfThenElseStatementNoShortIf" $ record [-        "cond">: optional $ java "Expression",-        "then">: java "StatementNoShortIf",-        "else">: java "StatementNoShortIf"],----AssertStatement:-      def "AssertStatement" $ union [---  assert Expression ;-        "single">: java "Expression",---  assert Expression : Expression ;-        "pair">: java "AssertStatement.Pair"],-      def "AssertStatement.Pair" $ record [-        "first">: java "Expression",-        "second">: java "Expression"],----SwitchStatement:---  switch ( Expression ) SwitchBlock-      def "SwitchStatement" $ record [-        "cond">: java "Expression",-        "block">: java "SwitchBlock"],----SwitchBlock:---  { {SwitchBlockStatementGroup} {SwitchLabel} }-      def "SwitchBlock" $ list $ java "SwitchBlock.Pair",-      def "SwitchBlock.Pair" $ record [-        "statements">: list $ java "SwitchBlockStatementGroup",-        "labels">: list $ java "SwitchLabel"],----SwitchBlockStatementGroup:---  SwitchLabels BlockStatements-      def "SwitchBlockStatementGroup" $ record [-        "labels">: nonemptyList $ java "SwitchLabel",-        "statements">: nonemptyList $ java "BlockStatement"],----SwitchLabels:---  SwitchLabel {SwitchLabel}---SwitchLabel:-      def "SwitchLabel" $ union [---  case ConstantExpression :-        "constant">: java "ConstantExpression",---  case EnumConstantName :-        "enumConstant">: java "EnumConstantName",---  default :-        "default">: unit],----EnumConstantName:---  Identifier-      def "EnumConstantName" $ java "Identifier",----WhileStatement:---  while ( Expression ) Statement-      def "WhileStatement" $ record [-        "cond">: optional $ java "Expression",-        "body">: java "Statement"],----WhileStatementNoShortIf:---  while ( Expression ) StatementNoShortIf-      def "WhileStatementNoShortIf" $ record [-        "cond">: optional $ java "Expression",-        "body">: java "StatementNoShortIf"],----DoStatement:---  do Statement while ( Expression ) ;-      def "DoStatement" $ record [-        "body">: java "Statement",-        "conde">: optional $ java "Expression"],----ForStatement:-      def "ForStatement" $ union [---  BasicForStatement-        "basic">: java "BasicForStatement",---  EnhancedForStatement-        "enhanced">: java "EnhancedForStatement"],----ForStatementNoShortIf:-      def "ForStatementNoShortIf" $ union [---  BasicForStatementNoShortIf-        "basic">: java "BasicForStatementNoShortIf",---  EnhancedForStatementNoShortIf-        "enhanced">: java "EnhancedForStatementNoShortIf"],----BasicForStatement:---  for ( [ForInit] ; [Expression] ; [ForUpdate] ) Statement-      def "BasicForStatement" $ record [-        "cond">: java "ForCond",-        "body">: java "Statement"],-      def "ForCond" $ record [-        "init">: optional $ java "ForInit",-        "cond">: optional $ java "Expression",-        "update">: optional $ java "ForUpdate"],---BasicForStatementNoShortIf:---  for ( [ForInit] ; [Expression] ; [ForUpdate] ) StatementNoShortIf-      def "BasicForStatementNoShortIf" $ record [-        "cond">: java "ForCond",-        "body">: java "StatementNoShortIf"],----ForInit:-      def "ForInit" $ union [---  StatementExpressionList-        "statements">: nonemptyList $ java "StatementExpression",---  LocalVariableDeclaration-        "localVariable">: java "LocalVariableDeclaration"],----ForUpdate:---  StatementExpressionList-      def "ForUpdate" $ nonemptyList $ java "StatementExpression",---  StatementExpressionList:---  StatementExpression {, StatementExpression}----EnhancedForStatement:-      def "EnhancedForStatement" $ record [---  for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) Statement-        "cond">: java "EnhancedForCond",-        "body">: java "Statement"],-      def "EnhancedForCond" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "LocalVariableType",-        "id">: java "VariableDeclaratorId",-        "expression">: java "Expression"],---EnhancedForStatementNoShortIf:---  for ( {VariableModifier} LocalVariableType VariableDeclaratorId : Expression ) StatementNoShortIf-      def "EnhancedForStatementNoShortIf" $ record [-        "cond">: java "EnhancedForCond",-        "body">: java "StatementNoShortIf"],----BreakStatement:---  break [Identifier] ;-      def "BreakStatement" $ optional $ java "Identifier",----ContinueStatement:---  continue [Identifier] ;-      def "ContinueStatement" $ optional $ java "Identifier",----ReturnStatement:---  return [Expression] ;-      def "ReturnStatement" $ optional $ java "Expression",----ThrowStatement:---  throw Expression ;-      def "ThrowStatement" $ java "Expression",----SynchronizedStatement:---  synchronized ( Expression ) Block-      def "SynchronizedStatement" $ record [-        "expression">: java "Expression",-        "block">: java "Block"],----TryStatement:-      def "TryStatement" $ union [---  try Block Catches-        "simple">: java "TryStatement.Simple",---  try Block [Catches] Finally-        "withFinally">: java "TryStatement.WithFinally",---  TryWithResourcesStatement-        "withResources">: java "TryWithResourcesStatement"],-      def "TryStatement.Simple" $ record [-        "block">: java "Block",-        "catches">: java "Catches"],-      def "TryStatement.WithFinally" $ record [-        "block">: java "Block",-        "catches">: optional $ java "Catches",-        "finally">: java "Finally"],----Catches:---  CatchClause {CatchClause}-      def "Catches" $ list $ java "CatchClause",----CatchClause:---  catch ( CatchFormalParameter ) Block-      def "CatchClause" $ record [-        "parameter">: optional $ java "CatchFormalParameter",-        "block">: java "Block"],----CatchFormalParameter:---  {VariableModifier} CatchType VariableDeclaratorId-      def "CatchFormalParameter" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "CatchType",-        "id">: java "VariableDeclaratorId"],----CatchType:---  UnannClassType {| ClassType}-      def "CatchType" $ record [-        "type">: java "UnannClassType",-        "types">: list $ java "ClassType"],----Finally:---  finally Block-      def "Finally" $ java "Block",----TryWithResourcesStatement:---  try ResourceSpecification Block [Catches] [Finally]-      def "TryWithResourcesStatement" $ record [-        "resourceSpecification">: java "ResourceSpecification",-        "block">: java "Block",-        "catches">: optional $ java "Catches",-        "finally">: optional $ java "Finally"],----ResourceSpecification:---  ( ResourceList [;] )-      def "ResourceSpecification" $ list $ java "Resource",----ResourceList:---  Resource {; Resource}---Resource:-      def "Resource" $ union [---  {VariableModifier} LocalVariableType Identifier = Expression-        "local">: java "Resource.Local",---  VariableAccess-        "variable">: java "VariableAccess"],-      def "Resource.Local" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "LocalVariableType",-        "identifier">: java "Identifier",-        "expression">: java "Expression"],----VariableAccess:-      def "VariableAccess" $ union [---  ExpressionName-        "expressionName">: java "ExpressionName",---  FieldAccess-        "fieldAccess">: java "FieldAccess"],----Productions from §15 (Expressions)----Primary:-      def "Primary" $ union [---  PrimaryNoNewArray-        "noNewArray">: java "PrimaryNoNewArray",---  ArrayCreationExpression-        "arrayCreation">: java "ArrayCreationExpression"],----PrimaryNoNewArray:-      def "PrimaryNoNewArray" $ union [---  Literal-        "literal">: java "Literal",---  ClassLiteral-        "classLiteral">: java "ClassLiteral",---  this-        "this">: unit,---  TypeName . this-        "dotThis">: java "TypeName",---  ( Expression )-        "parens">: java "Expression",---  ClassInstanceCreationExpression-        "classInstance">: java "ClassInstanceCreationExpression",---  FieldAccess-        "fieldAccess">: java "FieldAccess",---  ArrayAccess-        "arrayAccess">: java "ArrayAccess",---  MethodInvocation-        "methodInvocation">: java "MethodInvocation",---  MethodReference-        "methodReference">: java "MethodReference"],----ClassLiteral:-      def "ClassLiteral" $ union [---  TypeName {[ ]} . class-        "type">: java "TypeNameArray",---  NumericType {[ ]} . class-        "numericType">: java "NumericTypeArray",---  boolean {[ ]} . class-        "boolean">: java "BooleanArray",---  void . class-        "void">: unit],-      def "TypeNameArray" $ union [-        "simple">: java "TypeName",-        "array">: java "TypeNameArray"],-      def "NumericTypeArray" $ union [-        "simple">: java "NumericType",-        "array">: java "NumericTypeArray"],-      def "BooleanArray" $ union [-        "simple">: unit,-        "array">: java "BooleanArray"],----ClassInstanceCreationExpression:---  UnqualifiedClassInstanceCreationExpression---  ExpressionName . UnqualifiedClassInstanceCreationExpression---  Primary . UnqualifiedClassInstanceCreationExpression-      def "ClassInstanceCreationExpression" $ record [-        "qualifier">: optional $ java "ClassInstanceCreationExpression.Qualifier",-        "expression">: java "UnqualifiedClassInstanceCreationExpression"],-      def "ClassInstanceCreationExpression.Qualifier" $ union [-        "expression">: java "ExpressionName",-        "primary">: java "Primary"],----UnqualifiedClassInstanceCreationExpression:---  new [TypeArguments] ClassOrInterfaceTypeToInstantiate ( [ArgumentList] ) [ClassBody]-      def "UnqualifiedClassInstanceCreationExpression" $ record [-        "typeArguments">: list $ java "TypeArgument",-        "classOrInterface">: java "ClassOrInterfaceTypeToInstantiate",-        "arguments">: list $ java "Expression",-        "body">: optional $ java "ClassBody"],----ClassOrInterfaceTypeToInstantiate:---  {Annotation} Identifier {. {Annotation} Identifier} [TypeArgumentsOrDiamond]-      def "ClassOrInterfaceTypeToInstantiate" $ record [-        "identifiers">: nonemptyList $ java "AnnotatedIdentifier",-        "typeArguments">: optional $ java "TypeArgumentsOrDiamond"],-      def "AnnotatedIdentifier" $ record [-        "annotations">: list $ java "Annotation",-        "identifier">: java "Identifier"],----TypeArgumentsOrDiamond:-      def "TypeArgumentsOrDiamond" $ union [---  TypeArguments-        "arguments">: nonemptyList $ java "TypeArgument",---  <>-        "diamond">: unit],----FieldAccess:-      def "FieldAccess" $ record [-        "qualifier">: java "FieldAccess.Qualifier",-        "identifier">: java "Identifier"],-      def "FieldAccess.Qualifier" $ union [---  Primary . Identifier-        "primary">: java "Primary",---  super . Identifier-        "super">: unit,---  TypeName . super . Identifier-        "typed">: java "TypeName"],----ArrayAccess:-      def "ArrayAccess" $ record [-        "expression">: optional $ java "Expression",-        "variant">: java "ArrayAccess.Variant"],-      def "ArrayAccess.Variant" $ union [---  ExpressionName [ Expression ]-        "name">: java "ExpressionName",---  PrimaryNoNewArray [ Expression ]-        "primary">: java "PrimaryNoNewArray"],----MethodInvocation:-      def "MethodInvocation" $ record [-        "header">: java "MethodInvocation.Header",-        "arguments">: list $ java "Expression"],-      def "MethodInvocation.Header" $ union [---  MethodName ( [ArgumentList] )-        "simple">: java "MethodName",-        "complex">: java "MethodInvocation.Complex"],-      def "MethodInvocation.Complex" $ record [-        "variant">: java "MethodInvocation.Variant",-        "typeArguments">: list $ java "TypeArgument",-        "identifier">: java "Identifier"],-      def "MethodInvocation.Variant" $ union [---  TypeName . [TypeArguments] Identifier ( [ArgumentList] )-        "type">: java "TypeName",---  ExpressionName . [TypeArguments] Identifier ( [ArgumentList] )-        "expression">: java "ExpressionName",---  Primary . [TypeArguments] Identifier ( [ArgumentList] )-        "primary">: java "Primary",---  super . [TypeArguments] Identifier ( [ArgumentList] )-        "super">: unit,---  TypeName . super . [TypeArguments] Identifier ( [ArgumentList] )-        "typeSuper">: java "TypeName"],----ArgumentList:---  Expression {, Expression}----MethodReference:-      def "MethodReference" $ union [---  ExpressionName :: [TypeArguments] Identifier-        "expression">: java "MethodReference.Expression",---  Primary :: [TypeArguments] Identifier-        "primary">: java "MethodReference.Primary",---  ReferenceType :: [TypeArguments] Identifier-        "referenceType">: java"MethodReference.ReferenceType",---  super :: [TypeArguments] Identifier---  TypeName . super :: [TypeArguments] Identifier-        "super">: java "MethodReference.Super",---  ClassType :: [TypeArguments] new-        "new">: java "MethodReference.New",---  ArrayType :: new-        "array">: java "MethodReference.Array"],-      def "MethodReference.Expression" $ record [-        "name">: java "ExpressionName",-        "typeArguments">: list $ java "TypeArgument",-        "identifier">: java "Identifier"],-      def "MethodReference.Primary" $ record [-        "primary">: java "Primary",-        "typeArguments">: list $ java "TypeArgument",-        "identifier">: java "Identifier"],-      def "MethodReference.ReferenceType" $ record [-        "referenceType">: java "ReferenceType",-        "typeArguments">: list $ java "TypeArgument",-        "identifier">: java "Identifier"],-      def "MethodReference.Super" $ record [-        "typeArguments">: list $ java "TypeArgument",-        "identifier">: java "Identifier",-        "super">: boolean],-      def "MethodReference.New" $ record [-        "classType">: java "ClassType",-        "typeArguments">: list $ java "TypeArgument"],-      def "MethodReference.Array" $ java "ArrayType",----ArrayCreationExpression:-      def "ArrayCreationExpression" $ union [---  new PrimitiveType DimExprs [Dims]-        "primitive">: java "ArrayCreationExpression.Primitive",---  new ClassOrInterfaceType DimExprs [Dims]-        "classOrInterface">: java "ArrayCreationExpression.ClassOrInterface",---  new PrimitiveType Dims ArrayInitializer-        "primitiveArray">: java "ArrayCreationExpression.PrimitiveArray",---  new ClassOrInterfaceType Dims ArrayInitializer-        "classOrInterfaceArray">: java "ArrayCreationExpression.ClassOrInterfaceArray"],-      def "ArrayCreationExpression.Primitive" $ record [-        "type">: java "PrimitiveTypeWithAnnotations",-        "dimExprs">: nonemptyList $ java "DimExpr",-        "dims">: optional $ java "Dims"],-      def "ArrayCreationExpression.ClassOrInterface" $ record [-        "type">: java "ClassOrInterfaceType",-        "dimExprs">: nonemptyList $ java "DimExpr",-        "dims">: optional $ java "Dims"],-      def "ArrayCreationExpression.PrimitiveArray" $ record [-        "type">: java "PrimitiveTypeWithAnnotations",-        "dims">: nonemptyList $ java "Dims",-        "array">: java "ArrayInitializer"],-      def "ArrayCreationExpression.ClassOrInterfaceArray" $ record [-        "type">: java "ClassOrInterfaceType",-        "dims">: nonemptyList $ java "Dims",-        "array">: java "ArrayInitializer"],----DimExprs:---  DimExpr {DimExpr}---DimExpr:---  {Annotation} [ Expression ]-      def "DimExpr" $ record [-        "annotations">: list $ java "Annotation",-        "expression">: optional $ java "Expression"],----Expression:-      def "Expression" $ union [---  LambdaExpression-        "lambda">: java "LambdaExpression",---  AssignmentExpression-        "assignment">: java "AssignmentExpression"],----LambdaExpression:---  LambdaParameters -> LambdaBody-      def "LambdaExpression" $ record [-        "parameters">: java "LambdaParameters",-        "body">: java "LambdaBody"],----LambdaParameters:---  ( [LambdaParameterList] )---  Identifier-      def "LambdaParameters" $ union [-        "tuple">: list $ java "LambdaParameters",-        "single">: java "Identifier"],----LambdaParameterList:---  LambdaParameter {, LambdaParameter}---  Identifier {, Identifier}---LambdaParameter:-      def "LambdaParameter" $ union [---  {VariableModifier} LambdaParameterType VariableDeclaratorId-        "normal">: java "LambdaParameter.Normal",---  VariableArityParameter-        "variableArity">: java "VariableArityParameter"],-      def "LambdaParameter.Normal" $ record [-        "modifiers">: list $ java "VariableModifier",-        "type">: java "LambdaParameterType",-        "id">: java "VariableDeclaratorId"],----LambdaParameterType:-      def "LambdaParameterType" $ union [---  UnannType-        "type">: java "UnannType",---  var-        "var">: unit],----LambdaBody:-      def "LambdaBody" $ union [---  Expression-        "expression">: java "Expression",---  Block-        "block">: java "Block"],----AssignmentExpression:-      def "AssignmentExpression" $ union [---  ConditionalExpression-        "conditional">: java "ConditionalExpression",---  Assignment-        "assignment">: java "Assignment"],----Assignment:---  LeftHandSide AssignmentOperator Expression-      def "Assignment" $ record [-        "lhs">: java "LeftHandSide",-        "op">: java "AssignmentOperator",-        "expression">: java "Expression"],----LeftHandSide:-      def "LeftHandSide" $ union [---  ExpressionName-        "expressionName">: java "ExpressionName",---  FieldAccess-        "fieldAccess">: java "FieldAccess",---  ArrayAccess-        "arrayAccess">: java "ArrayAccess"],----AssignmentOperator:---  (one of)-      def "AssignmentOperator" $ enum [---  =  *=  /=  %=  +=  -=  <<=  >>=  >>>=  &=  ^=  |=-        "simple", "times", "div", "mod", "plus", "minus",-        "shiftLeft", "shiftRight", "shiftRightZeroFill", "and", "xor", "or"],----ConditionalExpression:-      def "ConditionalExpression" $ union [---  ConditionalOrExpression-        "simple">: java "ConditionalOrExpression",---  ConditionalOrExpression ? Expression : ConditionalExpression-        "ternaryCond">: java "ConditionalExpression.TernaryCond",---  ConditionalOrExpression ? Expression : LambdaExpression-        "ternaryLambda">: java "ConditionalExpression.TernaryLambda"],-      def "ConditionalExpression.TernaryCond" $ record [-        "cond">: java "ConditionalOrExpression",-        "ifTrue">: java "Expression",-        "ifFalse">: java "ConditionalExpression"],-      def "ConditionalExpression.TernaryLambda" $ record [-        "cond">: java "ConditionalOrExpression",-        "ifTrue">: java "Expression",-        "ifFalse">: java "LambdaExpression"],----ConditionalOrExpression:---  ConditionalAndExpression---  ConditionalOrExpression || ConditionalAndExpression-      def "ConditionalOrExpression" $ nonemptyList $ java "ConditionalAndExpression",----ConditionalAndExpression:---  InclusiveOrExpression---  ConditionalAndExpression && InclusiveOrExpression-      def "ConditionalAndExpression" $ nonemptyList $ java "InclusiveOrExpression",----InclusiveOrExpression:---  ExclusiveOrExpression---  InclusiveOrExpression | ExclusiveOrExpression-      def "InclusiveOrExpression" $ nonemptyList $ java "ExclusiveOrExpression",----ExclusiveOrExpression:---  AndExpression---  ExclusiveOrExpression ^ AndExpression-      def "ExclusiveOrExpression" $ nonemptyList $ java "AndExpression",----AndExpression:---  EqualityExpression---  AndExpression & EqualityExpression-      def "AndExpression" $ nonemptyList $ java "EqualityExpression",----EqualityExpression:-      def "EqualityExpression" $ union [---  RelationalExpression-        "unary">: java "RelationalExpression",---  EqualityExpression == RelationalExpression-        "equal">: java "EqualityExpression.Binary",---  EqualityExpression != RelationalExpression-        "notEqual">: java "EqualityExpression.Binary"],-      def "EqualityExpression.Binary" $ record [-        "lhs">: java "EqualityExpression",-        "rhs">: java "RelationalExpression"],----RelationalExpression:-      def "RelationalExpression" $ union [---  ShiftExpression-        "simple">: java "ShiftExpression",---  RelationalExpression < ShiftExpression-        "lessThan">: java "RelationalExpression.LessThan",---  RelationalExpression > ShiftExpression-        "greaterThan">: java "RelationalExpression.GreaterThan",---  RelationalExpression <= ShiftExpression-        "lessThanEqual">: java "RelationalExpression.LessThanEqual",---  RelationalExpression >= ShiftExpression-        "greaterThanEqual">: java "RelationalExpression.GreaterThanEqual",---  RelationalExpression instanceof ReferenceType-        "instanceof">: java "RelationalExpression.InstanceOf"],-      def "RelationalExpression.LessThan" $ record [-        "lhs">: java "RelationalExpression",-        "rhs">: java "ShiftExpression"],-      def "RelationalExpression.GreaterThan" $ record [-        "lhs">: java "RelationalExpression",-        "rhs">: java "ShiftExpression"],-      def "RelationalExpression.LessThanEqual" $ record [-        "lhs">: java "RelationalExpression",-        "rhs">: java "ShiftExpression"],-      def "RelationalExpression.GreaterThanEqual" $ record [-        "lhs">: java "RelationalExpression",-        "rhs">: java "ShiftExpression"],-      def "RelationalExpression.InstanceOf" $ record [-        "lhs">: java "RelationalExpression",-        "rhs">: java "ReferenceType"],----ShiftExpression:-      def "ShiftExpression" $ union [---  AdditiveExpression-        "unary">: java "AdditiveExpression",---  ShiftExpression << AdditiveExpression-        "shiftLeft">: java "ShiftExpression.Binary",---  ShiftExpression >> AdditiveExpression-        "shiftRight">: java "ShiftExpression.Binary",---  ShiftExpression >>> AdditiveExpression-        "shiftRightZeroFill">: java "ShiftExpression.Binary"],-      def "ShiftExpression.Binary" $ record [-        "lhs">: java "ShiftExpression",-        "rhs">: java "AdditiveExpression"],----AdditiveExpression:-      def "AdditiveExpression" $ union [---  MultiplicativeExpression-        "unary">: java "MultiplicativeExpression",---  AdditiveExpression + MultiplicativeExpression-        "plus">: java "AdditiveExpression.Binary",---  AdditiveExpression - MultiplicativeExpression-        "minus">: java "AdditiveExpression.Binary"],-      def "AdditiveExpression.Binary" $ record [-        "lhs">: java "AdditiveExpression",-        "rhs">: java "MultiplicativeExpression"],----MultiplicativeExpression:-      def "MultiplicativeExpression" $ union [---  UnaryExpression-        "unary">: java "UnaryExpression",---  MultiplicativeExpression * UnaryExpression-        "times">: java "MultiplicativeExpression.Binary",---  MultiplicativeExpression / UnaryExpression-        "divide">: java "MultiplicativeExpression.Binary",---  MultiplicativeExpression % UnaryExpression-        "mod">: java "MultiplicativeExpression.Binary"],-      def "MultiplicativeExpression.Binary" $ record [-        "lhs">: java "MultiplicativeExpression",-        "rhs">: java "UnaryExpression"],----UnaryExpression:-      def "UnaryExpression" $ union [---  PreIncrementExpression-        "preIncrement">: java "PreIncrementExpression",---  PreDecrementExpression-        "preDecrement">: java "PreDecrementExpression",---  + UnaryExpression-        "plus">: java "UnaryExpression",---  - UnaryExpression-        "minus">: java "UnaryExpression",---  UnaryExpressionNotPlusMinus-        "other">: java "UnaryExpressionNotPlusMinus"],----PreIncrementExpression:---  ++ UnaryExpression-      def "PreIncrementExpression" $ java "UnaryExpression",----PreDecrementExpression:---  -- UnaryExpression-      def "PreDecrementExpression" $ java "UnaryExpression",----UnaryExpressionNotPlusMinus:-      def "UnaryExpressionNotPlusMinus" $ union [---  PostfixExpression-        "postfix">: java "PostfixExpression",---  ~ UnaryExpression-        "tilde">: java "UnaryExpression",---  ! UnaryExpression-        "not">: java "UnaryExpression",---  CastExpression-        "cast">: java "CastExpression"],----PostfixExpression:-      def "PostfixExpression" $ union [---  Primary-        "primary">: java "Primary",---  ExpressionName-        "name">: java "ExpressionName",---  PostIncrementExpression-        "postIncrement">: java "PostIncrementExpression",---  PostDecrementExpression-        "postDecrement">: java "PostDecrementExpression"],----PostIncrementExpression:---  PostfixExpression ++-      def "PostIncrementExpression" $ java "PostfixExpression",----PostDecrementExpression:---  PostfixExpression ---      def "PostDecrementExpression" $ java "PostfixExpression",----CastExpression:-      def "CastExpression" $ union [---  ( PrimitiveType ) UnaryExpression-        "primitive">: java "CastExpression.Primitive",---  ( ReferenceType {AdditionalBound} ) UnaryExpressionNotPlusMinus-        "notPlusMinus">: java "CastExpression.NotPlusMinus",---  ( ReferenceType {AdditionalBound} ) LambdaExpression-        "lambda">: java "CastExpression.Lambda"],-      def "CastExpression.Primitive" $ record [-        "type">: java "PrimitiveTypeWithAnnotations",-        "expression">: java "UnaryExpression"],-      def "CastExpression.NotPlusMinus" $ record [-        "refAndBounds">: java "CastExpression.RefAndBounds",-        "expression">: java "UnaryExpression"],-      def "CastExpression.Lambda" $ record [-        "refAndBounds">: java "CastExpression.RefAndBounds",-        "expression">: java "LambdaExpression"],-      def "CastExpression.RefAndBounds" $ record [-        "type">: java "ReferenceType",-        "bounds">: list $ java "AdditionalBound"],----ConstantExpression:---  Expression-      def "ConstantExpression" $ java "Expression"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Json/Decoding.hs 
@@ -1,96 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Json.Decoding where---- TODO: standardized Tier-4 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier2.All--import qualified Hydra.Json as Json-import Hydra.Sources.Tier0.Json---jsonDecodingModule :: Module-jsonDecodingModule = Module (Namespace "hydra/ext/org/json/decoding") elements-    [jsonModelModule, hydraCoreModule] (jsonModelModule:tier0Modules) $-    Just "Decoding functions for JSON data"-  where-   elements = [-     Base.el decodeStringDef,-     Base.el decodeNumberDef,-     Base.el decodeBooleanDef,-     Base.el decodeArrayDef,-     Base.el decodeObjectDef,-     Base.el decodeFieldDef,-     Base.el decodeOptionalFieldDef]--jsonDecodingDefinition :: String -> TTerm a -> TElement a-jsonDecodingDefinition label = definitionInModule jsonDecodingModule ("decode" <> label)--valueT = TypeVariable Json._Value--decodeStringDef :: TElement (Json.Value -> Flow s String)-decodeStringDef  = jsonDecodingDefinition "String" $-  function valueT (flowT sT stringT) $-  match Json._Value (Just $ Flows.fail @@ "expected a string") [-    Json._Value_string>>: Flows.pure]--decodeNumberDef :: TElement (Json.Value -> Flow s Double)-decodeNumberDef  = jsonDecodingDefinition "Number" $-  function valueT (flowT sT Types.bigfloat) $-  match Json._Value (Just $ Flows.fail @@ "expected a number") [-    Json._Value_number>>: Flows.pure]--decodeBooleanDef :: TElement (Json.Value -> Flow s Bool)-decodeBooleanDef  = jsonDecodingDefinition "Boolean" $-  function valueT (flowT sT booleanT) $-  match Json._Value (Just $ Flows.fail @@ "expected a boolean") [-    Json._Value_boolean>>: Flows.pure]--decodeArrayDef :: TElement ((Json.Value -> Flow s a) -> Json.Value -> Flow s [a])-decodeArrayDef  = jsonDecodingDefinition "Array" $-  function (funT valueT (flowT sT aT)) (funT valueT (flowT sT (listT aT))) $-  lambda "decodeElem" $ match Json._Value (Just $ Flows.fail @@ "expected an array") [-    Json._Value_array>>: Flows.mapList @@ (var "decodeElem")]--decodeObjectDef :: TElement (Json.Value -> Flow s (M.Map String Json.Value))-decodeObjectDef  = jsonDecodingDefinition "Object" $-  function valueT (flowT sT (mapT stringT valueT)) $-  match Json._Value (Just $ Flows.fail @@ "expected an object") [-    Json._Value_object>>: Flows.pure]--decodeFieldDef :: TElement ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s a)-decodeFieldDef  = jsonDecodingDefinition "Field" $-  function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT aT))) $-  lambda "decodeValue" $ lambda "name" $ lambda "m" $-    Flows.bind-      @@ (ref decodeOptionalFieldDef @@ var "decodeValue" @@ var "name" @@ var "m")-      @@ (matchOpt (Flows.fail @@ ("missing field: " ++ var "name")) Flows.pure)--decodeOptionalFieldDef :: TElement ((Json.Value -> Flow s a) -> String -> (M.Map String Json.Value) -> Flow s (Maybe a))-decodeOptionalFieldDef  = jsonDecodingDefinition "OptionalField" $-  function (funT valueT (flowT sT aT)) (funT stringT (funT (mapT stringT valueT) (flowT sT (Types.optional aT)))) $-  lambda "decodeValue" $ lambda "name" $ lambda "m" $-    (matchOpt (Flows.pure @@ nothing) (lambda "v" (Flows.map @@ (lambda "x" (just $ var "x")) @@ (var "decodeValue" @@ var "v"))))-      @@ (Maps.lookup @@ var "name" @@ var "m")
− src/main/haskell/Hydra/Sources/Tier4/Ext/Pegasus/Pdl.hs 
@@ -1,128 +0,0 @@-module Hydra.Sources.Tier4.Ext.Pegasus.Pdl where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---pegasusPdlModule :: Module-pegasusPdlModule = Module ns elements [jsonModelModule] tier0Modules $-    Just ("A model for PDL (Pegasus Data Language) schemas. Based on the specification at:\n" ++-      "  https://linkedin.github.io/rest.li/pdl_schema")-  where-    ns = Namespace "hydra/ext/pegasus/pdl"-    def = datatype ns-    pdl = typeref ns-    json = typeref $ moduleNamespace jsonModelModule--    elements = [--      def "Annotations" $-        doc "Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas" $-        record [-          "doc">: optional string,-          "deprecated">: boolean],--      def "EnumField" $-        record [-          "name">: pdl "EnumFieldName",-          "annotations">: pdl "Annotations"],--      def "EnumFieldName"-        string,--      def "EnumSchema" $-        record [-          "fields">: list $ pdl "EnumField"],--      def "FieldName"-        string,--      def "NamedSchema" $-        record [-          "qualifiedName">: pdl "QualifiedName",-          "type">: pdl "NamedSchema.Type",-          "annotations">: pdl "Annotations"],--      def "NamedSchema.Type" $-        union [-          "record">: pdl "RecordSchema",-          "enum">: pdl "EnumSchema",-          "typeref">: pdl "Schema"],--      def "Name"-        string,--      def "Namespace"-        string,--      def "Package"-        string,--      def "PrimitiveType" $-        enum [-          "boolean",-          "bytes",-          "double",-          "float",-          "int",-          "long",-          "string"],--      def "PropertyKey"-        string,--      def "Property" $-        record [-          "key">: pdl "PropertyKey",-          "value">: optional $ json "Value"],--      def "QualifiedName" $-        record [-          "name">: pdl "Name",-          "namespace">: optional $ pdl "Namespace"],--      def "RecordField" $-        record [-          "name">: pdl "FieldName",-          "value">: pdl "Schema",-          "optional">: boolean,-          -- Note: the default value for an enum-valued must be one of the enumerated string symbols-          "default">: optional $ json "Value",-          "annotations">: pdl "Annotations"],--      def "RecordSchema" $-        record [-          "fields">: list $ pdl "RecordField",-          -- Note: all included schemas must be record schemas-          "includes">: list $ pdl "NamedSchema"],--      def "Schema" $-        union [-          "array">: pdl "Schema",-          "fixed">: int32,-          "inline">: pdl "NamedSchema",-          "map">: pdl "Schema",-          "named">: pdl "QualifiedName",-          "null">: unit,-          "primitive">: pdl "PrimitiveType",-          "union">: pdl "UnionSchema"],--      def "SchemaFile" $-        record [-          "namespace">: pdl "Namespace",-          "package">: optional $ pdl "Package",-          "imports">: list $ pdl "QualifiedName",-          "schemas">: list $ pdl "NamedSchema"],--      def "UnionMember" $-        record [-          "alias">: optional $ pdl "FieldName",-          "value">: pdl "Schema",-          -- Note: annotations are only available for aliased members-          "annotations">: pdl "Annotations"],--      -- Note: unions are not allowed as member types of other unions-      def "UnionSchema" $-        list $ pdl "UnionMember"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Mapping.hs 
@@ -1,118 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Pg.Mapping where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Pg.Mapping-import qualified Hydra.Dsl.Terms as Terms-import Hydra.Dsl.Types as Types-import Hydra.Sources.Tier4.Ext.Pg.Model---pgMappingModule :: Module-pgMappingModule = Module ns elements-    [pgModelModule, hydraCoreModule, hydraComputeModule] tier0Modules $-    Just "A model for property graph mapping specifications. See https://github.com/CategoricalData/hydra/wiki/Property-graphs"-  where-    ns = Namespace "hydra/pg/mapping"-    mappings = typeref ns-    compute = typeref $ moduleNamespace hydraComputeModule-    core = typeref $ moduleNamespace hydraCoreModule-    v3 = typeref $ moduleNamespace pgModelModule-    def = datatype ns-    toField (k, v) = Field k $ Terms.string v--    elements = [--      def "AnnotationSchema" $-        doc "Configurable annotation keys for property graph mapping specifications" $-        record [-          "vertexLabel">: string,-          "edgeLabel">: string,-          "vertexId">: string,-          "edgeId">: string,-          "propertyKey">: string,-          "propertyValue">: string,-          "outVertex">: string,-          "outVertexLabel">: string,-          "inVertex">: string,-          "inVertexLabel">: string,-          "outEdge">: string,-          "outEdgeLabel">: string,-          "inEdge">: string,-          "inEdgeLabel">: string,-          "ignore">: string],--      def "EdgeSpec" $-        doc "A mapping specification producing edges of a specified label." $-        record [-          "label">:-            doc "The label of the target edges, which must conform to the edge type associated with that label." $-            v3 "EdgeLabel",-          "id">:-            doc "A specification of the id of each target edge" $-            mappings "ValueSpec",-          "out">:-            doc "A specification of the out-vertex reference of each target edge" $-            mappings "ValueSpec",-          "in">:-            doc "A specification of the in-vertex reference of each target edge" $-            mappings "ValueSpec",-          "properties">:-            doc "Zero or more property specifications for each target edge" $-            list $ mappings "PropertySpec"],--      def "ElementSpec" $-        doc "Either a vertex specification or an edge specification" $-        union [-          "vertex">: mappings "VertexSpec",-          "edge">: mappings "EdgeSpec"],--      def "PropertySpec" $-        doc "A mapping specification producing properties of a specified key, and values of the appropriate type." $-        record [-          "key">:-            doc "The key of the target properties" $-            v3 "PropertyKey",-          "value">:-            doc "A specification of the value of each target property, which must conform to the type associated with the property key" $-            mappings "ValueSpec"],--      def "Schema" $-        doc "A set of mappings which translates between Hydra terms and annotations, and application-specific property graph types" $-        lambdas ["s", "t", "v"] $-          record [-            "vertexIdTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t",-            "vertexIds">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v",-            "edgeIdTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t",-            "edgeIds">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v",-            "propertyTypes">: compute "Coder" @@ "s" @@ "s" @@ core "Type" @@ "t",-            "propertyValues">: compute "Coder" @@ "s" @@ "s" @@ core "Term" @@ "v",-            "annotations">: mappings "AnnotationSchema",-            "defaultVertexId">: "v",-            "defaultEdgeId">: "v"],--      def "ValueSpec" $-        doc "A mapping specification producing values (usually literal values) whose type is understood in context" $-        union [-          "value">:-            doc "A trivial no-op specification which passes the entire value"-            unit,-          "pattern">:-            doc "A compact path representing the function, e.g. engine-${engineInfo/model/name}"-            string],--      def "VertexSpec" $-        doc "A mapping specification producing vertices of a specified label" $-        record [-          "label">:-            doc "The label of the target vertices, which must conform to the vertex type associated with that label." $-            v3 "VertexLabel",-          "id">:-            doc "A specification of the id of each target vertex" $-            mappings "ValueSpec",-          "properties">:-            doc "Zero or more property specifications for each target vertex" $-            list $ mappings "PropertySpec"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Model.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Pg.Model where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types--import Hydra.Sources.Core---pgModelModule :: Module-pgModelModule = Module ns elements [] tier0Modules $-    Just ("A typed property graph data model. " ++-      "Property graphs are parameterized a type for property and id values, " ++-      "while property graph schemas are parameterized by a type for property and id types")-  where-    ns = Namespace "hydra/pg/model"-    pg = typeref ns-    def = datatype ns--    elements = [--      def "Direction" $-        doc "The direction of an edge or edge pattern" $-          enum ["out", "in", "both", "undirected"],--      def "Edge" $-        doc "An edge" $-        lambda "v" $ record [-          "label">:-            doc "The label of the edge" $-            pg "EdgeLabel",-          "id">:-            doc "The unique identifier of the edge"-            "v",-          "out">:-            doc "The id of the out-vertex (tail) of the edge"-            "v",-          "in">:-            doc "The id of the in-vertex (head) of the edge"-            "v",-          "properties">:-            doc "A key/value map of edge properties" $-            Types.map (pg "PropertyKey") "v"],--      def "EdgeLabel" $-        doc "The label of an edge" $-        string,--      def "EdgeType" $-        doc "The type of an edge" $-        lambda "t" $ record [-            "label">:-              doc "The label of any edge of this edge type" $-              pg "EdgeLabel",-            "id">:-              doc "The type of the id of any edge of this edge type"-              "t",-            "out">:-              doc "The label of the out-vertex (tail) of any edge of this edge type" $-              pg "VertexLabel",-            "in">:-              doc "The label of the in-vertex (head) of any edge of this edge type" $-              pg "VertexLabel",-            "properties">:-              doc "A list of property types. The types are ordered for the sake of applications in which property order is significant." $-              list (pg "PropertyType" @@ "t")],--      def "Element" $-        doc "Either a vertex or an edge" $-        lambda "v" $ union [-          "vertex">: pg "Vertex" @@ "v",-          "edge">: pg "Edge" @@ "v"],--      def "ElementKind" $-        doc "The kind of an element: vertex or edge" $-        enum ["vertex", "edge"],--      def "ElementTree" $-        doc "An element together with its dependencies in some context" $-        lambda "v" $ record [-          "self">: pg "Element" @@ "v",-          "dependencies">: Types.list $ pg "ElementTree" @@ "v"],--      def "ElementType" $-        doc "The type of a vertex or edge" $-        lambda "t" $ union [-          "vertex">: pg "VertexType" @@ "t",-          "edge">: pg "EdgeType" @@ "t"],--      def "ElementTypeTree" $-        doc "An element type together with its dependencies in some context" $-        lambda "t" $ record [-          "self">: pg "ElementType" @@ "t",-          "dependencies">: Types.list $ pg "ElementTypeTree" @@ "t"],--      def "Graph" $-        doc "A graph; a self-contained collection of vertices and edges" $-        lambda "v" $ record [-          "vertices">: Types.map "v" $ pg "Vertex" @@ "v",-          "edges">: Types.map "v" $ pg "Edge" @@ "v"],--      def "GraphSchema" $-        doc "A graph schema; a vertex and edge types for the vertices and edges of a graph conforming to the schema" $-        lambda "t" $ record [-          "vertices">:-            doc "A unique vertex type for each vertex label which may occur in a graph" $-            Types.map (pg "VertexLabel") (pg "VertexType" @@ "t"),-          "edges">:-            doc "A unique edge type for each edge label which may occur in a graph" $-            Types.map (pg "EdgeLabel") (pg "EdgeType" @@ "t")],--      def "Label" $-        doc "Either a vertex or edge label" $-        union [-          "vertex">: pg "VertexLabel",-          "edge">: pg "EdgeLabel"],--      def "Property" $-        doc "A key/value property" $-        lambda "v" $ record [-          "key">:-            doc "They key of the property" $-            pg "PropertyKey",-          "value">:-            doc "The value of the property"-            "v"],--      def "PropertyKey" $-        doc "A property key"-        string,--      def "PropertyType" $-        doc "The type of a property" $-        lambda "t" $ record [-          "key">:-            doc "A property's key" $-            pg "PropertyKey",-          "value">:-            doc "The type of a property's value"-            "t",-          "required">:-            doc "Whether the property is required; values may be omitted from a property map otherwise"-            boolean],--      def "Vertex" $-        doc "A vertex" $-        lambda "v" $ record [-          "label">:-            doc "The label of the vertex" $-            pg "VertexLabel",-          "id">:-            doc "The unique identifier of the vertex"-            "v",-          "properties">:-            doc "A key/value map of vertex properties" $-            Types.map (pg "PropertyKey") "v"],--      def "VertexLabel" $-        doc "The label of a vertex. The default (null) vertex is represented by the empty string" $-        string,--      def "VertexType" $-        doc "The type of a vertex" $-        lambda "t" $ record [-          "label">:-            doc "The label of any vertex of this vertex type" $-            pg "VertexLabel",-          "id">:-            doc "The type of the id of any vertex of this vertex type"-            "t",-          "properties">:-            doc "A list of property types. The types are ordered for the sake of applications in which property order is significant." $-            list (pg "PropertyType" @@ "t")]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Query.hs 
@@ -1,144 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Pg.Query where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types-import Hydra.Sources.Core-import Hydra.Sources.Tier4.Ext.Pg.Model---pgQueryModule :: Module-pgQueryModule = Module ns elements [pgModelModule] tier0Modules $-    Just ("A common model for pattern-matching queries over property graphs")-  where-    ns = Namespace "hydra/pg/query"-    pg = typeref $ moduleNamespace pgModelModule-    q = typeref ns-    def = datatype ns--    elements = [--      -- table of bindings to list of integers-      def "AggregationQuery" $-        union [-          "count">: unit],--      def "ApplicationQuery" $-        nonemptyList $ q "Query",--      def "AssociativeExpression" $-        record [-          "operator">: q "BinaryOperator",-          "operands">: nonemptyList $ q "Expression"],--      def "BinaryExpression" $-        record [-          "left">: q "Expression",-          "operator">: q "BinaryOperator",-          "right">: q "Expression"],--      def "BinaryBooleanOperator" $-        enum ["and", "or", "xor"],--      def "BinaryOperator" $-        union [-          "boolean">: q "BinaryBooleanOperator",-          "comparison">: q "ComparisonOperator",-          "power">: unit],--      def "Binding" $-        record [-          "key">: q "Variable",-          "value">: q "Query"],--      def "ComparisonOperator" $-        enum ["eq", "neq", "lt", "lte", "gt", "gte"],--      def "EdgeProjectionPattern" $-        record [-          "direction">: pg "Direction",-          "label">: optional $ pg "EdgeLabel",-          "properties">: list $ q "PropertyPattern",-          "vertex">: optional $ q "VertexPattern"],--      def "Expression" $-        union [-          "associative">: q "AssociativeExpression",-          "binary">: q "BinaryExpression",-          "property">: q "PropertyProjection",-          "unary">: q "UnaryExpression",-          "variable">: q "Variable",-          "vertex">: q "VertexPattern"],--      def "LetQuery" $-        record [-          "bindings">: list $ q "Binding",-          "environment">: q "Query"],--      def "MatchQuery" $-        record [-          "optional">: boolean,-          "pattern">: list $ q "Projection",-          "where">: optional $ q "Expression"],--      def "Projection" $-        record [-          "value">: q "Expression",-          "as">: optional $ q "Variable"],--      def "Projections" $-        record [-          "all">: boolean,-          "explicit">: list $ q "Projection"],--      def "PropertyPattern" $-        record [-          "key">: pg "PropertyKey",-          "value">: q "PropertyValuePattern"],--      def "PropertyProjection" $-        record [-          "base">: q "Expression",-          "key">: pg "PropertyKey"],--      -- TODO: temporary-      def "PropertyValue" $ string,--      def "PropertyValuePattern" $-        union [-          "variable">: pg "PropertyKey",-          "value">: string], -- TODO: re-use pg property value parameter--      def "Query" $-        union [-          "application">: q "ApplicationQuery",-          "aggregate">: q "AggregationQuery",-          "LetQuery">: q "LetQuery",-          "match">: q "MatchQuery",-          "select">: q "SelectQuery",-          "value">: string],--      def "SelectQuery" $-        record [-          "distinct">: boolean,-          "projection">: q "Projections"],--      def "UnaryExpression" $-        record [-          "operator">: q "UnaryOperator",-          "operand">: q "Expression"],--      def "UnaryOperator" $-        enum ["negate"],--      def "Variable" string,--      def "VertexPattern" $-        record [-          "variable">: optional $ q "Variable",-          "label">: optional $ pg "VertexLabel",-          "properties">: list $ q "PropertyPattern",-          "edges">: list $ q "EdgeProjectionPattern"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Pg/Validation.hs 
@@ -1,331 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Pg.Validation where--import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types--import Hydra.Kernel hiding (Edge(..), _Edge, _Edge_in, _Edge_out, Element(..), _Element, Graph(..), _Graph)--import Hydra.Pg.Model as PG-import Hydra.Sources.Tier4.Ext.Pg.Model---validationDefinition :: String -> TTerm a -> TElement a-validationDefinition = definitionInModule pgValidationModule--pgValidationModule :: Module-pgValidationModule = Module (Namespace "hydra/pg/validation") elements-    [] [pgModelModule] $-    Just "Utilities for validating property graphs against property graph schemas"-  where-   elements = [-     el validateEdgeDef,-     el validateElementDef,-     el validateGraphDef,-     el validatePropertiesDef,-     el validateVertexDef,-     ---     el checkAllDef,-     el edgeErrorDef,-     el edgeLabelMismatchDef,-     el prependDef,-     el verifyDef,-     el vertexErrorDef,-     el vertexLabelMismatchDef]--validateEdgeDef :: TElement (-     (t -> v -> Maybe String)-  -> (v -> String)-  -> Y.Maybe (v -> Y.Maybe PG.VertexLabel)-  -> PG.EdgeType t-  -> PG.Edge v-  -> Y.Maybe String)-validateEdgeDef = validationDefinition "validateEdge" $-  functionN [-    funT tT (funT vT (optionalT stringT)),-    funT vT stringT,-    optionalT (funT vT (optionalT vertexLabelT)),-    edgeTypeTT,-    edgeVT,-    optionalT stringT] $-  lambda "checkValue" $ lambda "showValue" $ lambda "labelForVertexId" $ lambda "typ" $ lambda "el" $-    (ref checkAllDef @@ list [var "checkLabel", var "checkId", var "checkProperties", var "checkOut", var "checkIn"]-    `with` [-      "failWith">: typed (funT stringT stringT) $-        ref edgeErrorDef @@ var "showValue" @@ var "el",-      "checkLabel">: (ref verifyDef-        @@ (Equality.equalString-          @@ (unwrap _EdgeLabel @@ var "actual")-          @@ (unwrap _EdgeLabel @@ var "expected"))-        @@ (var "failWith" @@ (ref prependDef @@ "Wrong label" @@ (ref edgeLabelMismatchDef @@ var "expected" @@ var "actual"))))-        `with` [-          "expected">: project _EdgeType _EdgeType_label @@ var "typ",-          "actual">: project _Edge _Edge_label @@ var "el"],-      "checkId">: Optionals.map-        @@ (var "failWith" <.> (ref prependDef @@ "Invalid id"))-        @@ (var "checkValue" @@ (project _EdgeType _EdgeType_id @@ var "typ") @@ (project _Edge _Edge_id @@ var "el")),-      "checkProperties">: Optionals.map-        @@ (var "failWith" <.> (ref prependDef @@ "Invalid property"))-        @@ (ref validatePropertiesDef-          @@ var "checkValue"-          @@ (project _EdgeType _EdgeType_properties @@ var "typ")-          @@ (project _Edge _Edge_properties @@ var "el")),-      "checkOut">: ifOpt (var "labelForVertexId")-        nothing-        (lambda "f" $ ifOpt (var "f" @@ (project _Edge _Edge_out @@ var "el"))-          (just (var "failWith" @@ (ref prependDef @@ "Out-vertex does not exist" @@ (var "showValue" @@ (project _Edge _Edge_out @@ var "el")))))-          (lambda "label" $ ref verifyDef-            @@ (Equality.equalString-              @@ (unwrap _VertexLabel @@ var "label")-              @@ (unwrap _VertexLabel @@ (project _EdgeType _EdgeType_out @@ var "typ")))-            @@ (var "failWith" @@ (ref prependDef @@ "Wrong out-vertex label" @@ (ref vertexLabelMismatchDef @@ (project _EdgeType _EdgeType_out @@ var "typ") @@ var "label"))))),-      "checkIn">: ifOpt (var "labelForVertexId")-        nothing-        (lambda "f" $ ifOpt (var "f" @@ (project _Edge _Edge_in @@ var "el"))-          (just (var "failWith" @@ (ref prependDef @@ "In-vertex does not exist" @@ (var "showValue" @@ (project _Edge _Edge_in @@ var "el")))))-          (lambda "label" $ ref verifyDef-            @@ (Equality.equalString-              @@ (unwrap _VertexLabel @@ var "label")-              @@ (unwrap _VertexLabel @@ (project _EdgeType _EdgeType_in @@ var "typ")))-            @@ (var "failWith" @@ (ref prependDef @@ "Wrong in-vertex label" @@ (ref vertexLabelMismatchDef @@ (project _EdgeType _EdgeType_in @@ var "typ") @@ var "label")))))])--validateElementDef :: TElement (-     (t -> v -> Maybe String)-  -> (v -> String)-  -> Y.Maybe (v -> Y.Maybe PG.VertexLabel)-  -> PG.ElementType t-  -> PG.Element v-  -> Y.Maybe String)-validateElementDef = validationDefinition "validateElement" $-  functionN [-    funT tT (funT vT (optionalT stringT)),-    funT vT stringT,-    optionalT (funT vT (optionalT vertexLabelT)),-    elementTypeTT,-    elementVT,-    optionalT stringT] $-  lambda "checkValue" $ lambda "showValue" $ lambda "labelForVertexId" $ lambda "typ" $ lambda "el" $-    (match _ElementType Nothing [-        _ElementType_vertex>>: lambda "vt" $ (match _Element Nothing [-            _Element_edge>>: lambda "e" $ just (ref prependDef @@ "Edge instead of vertex" @@ (var "showValue" @@ (project _Edge _Edge_id @@ var "e"))),-            _Element_vertex>>: lambda "vertex" $ ref validateVertexDef-              @@ var "checkValue"-              @@ var "showValue"-              @@ var "vt"-              @@ var "vertex"]) @@ var "el",---        _ElementType_edge>>: constant nothing]) @@ var "typ"-        _ElementType_edge>>: lambda "et" $ (match _Element Nothing [-            _Element_vertex>>: lambda "v" $ just (ref prependDef @@ "Vertex instead of edge" @@ (var "showValue" @@ (project _Vertex _Vertex_id @@ var "v"))),-            _Element_edge>>: lambda "edge" $ ref validateEdgeDef-              @@ var "checkValue"-              @@ var "showValue"-              @@ var "labelForVertexId"-              @@ var "et"-              @@ var "edge"]) @@ var "el"]) @@ var "typ"--validateGraphDef :: TElement (-     (t -> v -> Maybe String)-  -> (v -> String)-  -> PG.GraphSchema t-  -> PG.Graph v-  -> Y.Maybe String)-validateGraphDef = validationDefinition "validateGraph" $-  functionNWithClasses [-    funT tT (funT vT (optionalT stringT)),-    funT vT stringT,-    graphSchemaTT,-    graphVT,-    optionalT stringT] ordV $-  lambda "checkValue" $ lambda "showValue" $ lambda "schema" $ lambda "graph" $-    (ref checkAllDef @@ list [var "checkVertices", var "checkEdges"])-    `with` [-      "checkVertices">: (ref checkAllDef-          @@ (Lists.map @@ var "checkVertex" @@ (Maps.values @@ (project _Graph _Graph_vertices @@ var "graph"))))-        `with` [-          "checkVertex">: lambda "el" $ ifOpt (Maps.lookup-              @@ (project _Vertex _Vertex_label @@ var "el")-              @@ (project _GraphSchema _GraphSchema_vertices @@ var "schema"))-            (just (ref vertexErrorDef @@ var "showValue" @@ var "el"-              @@ (ref prependDef @@ "Unexpected label" @@ (unwrap _VertexLabel @@ (project _Vertex _Vertex_label @@ var "el")))))-            (lambda "t" $ ref validateVertexDef-              @@ var "checkValue"-              @@ var "showValue"-              @@ var "t"-              @@ var "el")],-      "checkEdges">: (ref checkAllDef-          @@ (Lists.map @@ var "checkEdge" @@ (Maps.values @@ (project _Graph _Graph_edges @@ var "graph"))))-        `with` [-          "checkEdge">: lambda "el" $ ifOpt (Maps.lookup-              @@ (project _Edge _Edge_label @@ var "el")-              @@ (project _GraphSchema _GraphSchema_edges @@ var "schema"))-            (just (ref edgeErrorDef @@ var "showValue" @@ var "el"-              @@ (ref prependDef @@ "Unexpected label" @@ (unwrap _EdgeLabel @@ (project _Edge _Edge_label @@ var "el")))))-            (lambda "t" $ ref validateEdgeDef-              @@ var "checkValue"-              @@ var "showValue"-              @@ var "labelForVertexId"-              @@ var "t"-              @@ var "el"),-          "labelForVertexId">: typed (optionalT (funT vT (optionalT vertexLabelT))) $-            just $ lambda "i" $ Optionals.map @@ (project _Vertex _Vertex_label) @@ (Maps.lookup @@ var "i" @@ (project _Graph _Graph_vertices @@ var "graph"))]]--validatePropertiesDef :: TElement (-     (t -> v -> Maybe String)-  -> [PG.PropertyType t]-  -> M.Map PG.PropertyKey v-  -> Y.Maybe String)-validatePropertiesDef = validationDefinition "validateProperties" $-  functionN [-    funT tT (funT vT (optionalT stringT)),-    listT propertyTypeTT,-    mapT propertyKeyT vT,-    optionalT stringT] $-  lambda "checkValue" $ lambda "types" $ lambda "props" $-    ((ref checkAllDef @@ list [var "checkTypes", var "checkValues"])-    `with` [-      "checkTypes">: ref checkAllDef @@ (Lists.map @@ var "checkType" @@ var "types"),-      "checkType">:-        typed (funT propertyTypeTT $ optionalT stringT) $-        lambda "t" $ ifElse (project _PropertyType _PropertyType_required @@ var "t")-          (ifOpt (Maps.lookup @@ (project _PropertyType _PropertyType_key @@ var "t") @@ var "props")-            (just (ref prependDef @@ "Missing value for " @@ (unwrap _PropertyKey @@ (project _PropertyType _PropertyType_key @@ var "t"))))-            (constant nothing))-          nothing,-      "checkValues">: ((ref checkAllDef @@ (Lists.map @@ var "checkPair" @@ (Maps.toList @@ var "props")))-        `with` [-          "m">: typed (mapT propertyKeyT tT) $-            Maps.fromList @@ (Lists.map-              @@ (lambda "p" $ pair-                (project _PropertyType _PropertyType_key @@ var "p")-                (project _PropertyType _PropertyType_value @@ var "p"))-              @@ var "types"),-          "checkPair">: lambda "pair" $ ((ifOpt (Maps.lookup @@ var "key" @@ var "m")-              (just (ref prependDef @@ "Unexpected key" @@ (unwrap _PropertyKey @@ var "key")))-              (lambda "typ" $ Optionals.map-                @@ (ref prependDef @@ "Invalid value")-                @@ (var "checkValue" @@ var "typ" @@ var "val")))-            `with` [-              "key">: first @@ var "pair",-              "val">: second @@ var "pair"])])])--validateVertexDef :: TElement (-     (t -> v -> Maybe String)-  -> (v -> String)-  -> PG.VertexType t-  -> PG.Vertex v-  -> Y.Maybe String)-validateVertexDef = validationDefinition "validateVertex" $-  functionN [-    funT tT (funT vT (optionalT stringT)),-    funT vT stringT,-    vertexTypeTT,-    vertexVT,-    optionalT stringT] $-  lambda "checkValue" $ lambda "showValue" $ lambda "typ" $ lambda "el" $-    ((ref checkAllDef @@ list [var "checkLabel", var "checkId", var "checkProperties"])-    `with` [-      "failWith">: typed (funT stringT stringT) $-        ref vertexErrorDef @@ var "showValue" @@ var "el",-      "checkLabel">: (ref verifyDef-        @@ (Equality.equalString-          @@ (unwrap _VertexLabel @@ var "actual")-          @@ (unwrap _VertexLabel @@ var "expected"))-        @@ (var "failWith" @@ (ref prependDef @@ "Wrong label" @@ (ref vertexLabelMismatchDef @@ var "expected" @@ var "actual"))))-        `with` [-          "expected">: project _VertexType _VertexType_label @@ var "typ",-          "actual">: project _Vertex _Vertex_label @@ var "el"],-      "checkId">: Optionals.map-        @@ (var "failWith" <.> (ref prependDef @@ "Invalid id"))-        @@ (var "checkValue" @@ (project _VertexType _VertexType_id @@ var "typ") @@ (project _Vertex _Vertex_id @@ var "el")),-      "checkProperties">: Optionals.map-        @@ (var "failWith" <.> (ref prependDef @@ "Invalid property"))-        @@ (ref validatePropertiesDef-          @@ var "checkValue"-          @@ (project _VertexType _VertexType_properties @@ var "typ")-          @@ (project _Vertex _Vertex_properties @@ var "el"))])--------checkAllDef :: TElement ([Y.Maybe a] -> Y.Maybe a)-checkAllDef = validationDefinition "checkAll" $-  function (listT $ optionalT aT) (optionalT aT) $-  lambda "checks" (-    (Lists.safeHead @@ var "errors")-    `with` [-      "errors">: Optionals.cat @@ var "checks"])--edgeErrorDef :: TElement ((v -> String) -> PG.Edge v -> String -> String)-edgeErrorDef = validationDefinition "edgeError" $-  functionN [funT vT stringT, edgeVT, stringT, stringT] $-  lambda "showValue" $ lambda "e" $-    ref prependDef @@ ("Invalid edge with id " ++ (var "showValue" @@ (project _Edge _Edge_id @@ var "e")))--edgeLabelMismatchDef :: TElement (PG.EdgeLabel -> PG.EdgeLabel -> String)-edgeLabelMismatchDef = validationDefinition "edgeLabelMismatch" $-  functionN [edgeLabelT, edgeLabelT, stringT] $-  lambda "expected" $ lambda "actual" $-    "expected " ++ (unwrap _EdgeLabel @@ var "expected") ++ ", found " ++ (unwrap _EdgeLabel @@ var "actual")--prependDef :: TElement (String -> String -> String)-prependDef = validationDefinition "prepend" $-  functionN [stringT, stringT, stringT] $-  lambda "prefix" $ lambda "msg" $-    (var "prefix") ++ ": " ++ (var "msg")--verifyDef :: TElement (Bool -> String -> Maybe String)-verifyDef = validationDefinition "verify" $-  functionN [booleanT, stringT, optionalT stringT] $-  lambda "b" $ lambda "err" $-    ifElse (var "b")-      nothing-      (just $ var "err")--vertexErrorDef :: TElement ((v -> String) -> PG.Vertex v -> String -> String)-vertexErrorDef = validationDefinition "vertexError" $-  functionN [funT vT stringT, vertexVT, stringT, stringT] $-  lambda "showValue" $ lambda "v" $-    ref prependDef @@ ("Invalid vertex with id " ++ (var "showValue" @@ (project _Vertex _Vertex_id @@ var "v")))--vertexLabelMismatchDef :: TElement (PG.VertexLabel -> PG.VertexLabel -> String)-vertexLabelMismatchDef = validationDefinition "vertexLabelMismatch" $-  functionN [vertexLabelT, vertexLabelT, stringT] $-  lambda "expected" $ lambda "actual" $-    "expected " ++ (unwrap _VertexLabel @@ var "expected") ++ ", found " ++ (unwrap _VertexLabel @@ var "actual")--ordV = (M.fromList [(Name "v", S.fromList [TypeClassOrdering])])--edgeLabelT = TypeVariable _EdgeLabel-edgeTypeTT = Types.apply (TypeVariable _EdgeType) tT-edgeVT = Types.apply (TypeVariable _Edge) vT-elementTypeTT = Types.apply (TypeVariable _ElementType) tT-elementVT = Types.apply (TypeVariable _Element) vT-graphSchemaTT = Types.apply (TypeVariable _GraphSchema) tT-graphVT = Types.apply (TypeVariable _Graph) vT-propertyKeyT = TypeVariable _PropertyKey-propertyTypeTT = Types.apply (TypeVariable _PropertyType) tT-vertexLabelT = TypeVariable _VertexLabel-vertexTypeTT = Types.apply (TypeVariable _VertexType) tT-vertexVT = Types.apply (TypeVariable _Vertex) vT-tT = Types.var "t"-vT = Types.var "v"
− src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Any.hs 
@@ -1,151 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Protobuf.Any where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---pbAnyNs = Namespace "hydra/ext/protobuf/any"-pbAny = typeref pbAnyNs--protobufAnyModule :: Module-protobufAnyModule = Module pbAnyNs elements [hydraCoreModule] tier0Modules $-    Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/any.proto"-  where-    def = datatype pbAnyNs--    elements = [---  // `Any` contains an arbitrary serialized protocol buffer message along with a---  // URL that describes the type of the serialized message.---  //---  // Protobuf library provides support to pack/unpack Any values in the form---  // of utility functions or additional generated methods of the Any type.---  //---  // Example 1: Pack and unpack a message in C++.---  //---  //     Foo foo = ...;---  //     Any any;---  //     any.PackFrom(foo);---  //     ...---  //     if (any.UnpackTo(&foo)) {---  //       ...---  //     }---  //---  // Example 2: Pack and unpack a message in Java.---  //---  //     Foo foo = ...;---  //     Any any = Any.pack(foo);---  //     ...---  //     if (any.is(Foo.class)) {---  //       foo = any.unpack(Foo.class);---  //     }---  //     // or ...---  //     if (any.isSameTypeAs(Foo.getDefaultInstance())) {---  //       foo = any.unpack(Foo.getDefaultInstance());---  //     }---  //---  // Example 3: Pack and unpack a message in Python.---  //---  //     foo = Foo(...)---  //     any = Any()---  //     any.Pack(foo)---  //     ...---  //     if any.Is(Foo.DESCRIPTOR):---  //       any.Unpack(foo)---  //       ...---  //---  // Example 4: Pack and unpack a message in Go---  //---  //      foo := &pb.Foo{...}---  //      any, err := anypb.New(foo)---  //      if err != nil {---  //        ...---  //      }---  //      ...---  //      foo := &pb.Foo{}---  //      if err := any.UnmarshalTo(foo); err != nil {---  //        ...---  //      }---  //---  // The pack methods provided by protobuf library will by default use---  // 'type.googleapis.com/full.type.name' as the type URL and the unpack---  // methods only use the fully qualified type name after the last '/'---  // in the type URL, for example "foo.bar.com/x/y.z" will yield type---  // name "y.z".---  //---  // JSON---  //---  // The JSON representation of an `Any` value uses the regular---  // representation of the deserialized, embedded message, with an---  // additional field `@type` which contains the type URL. Example:---  //---  //     package google.profile;---  //     message Person {---  //       string first_name = 1;---  //       string last_name = 2;---  //     }---  //---  //     {---  //       "@type": "type.googleapis.com/google.profile.Person",---  //       "firstName": <string>,---  //       "lastName": <string>---  //     }---  //---  // If the embedded message type is well-known and has a custom JSON---  // representation, that representation will be embedded adding a field---  // `value` which holds the custom JSON in addition to the `@type`---  // field. Example (for message [google.protobuf.Duration][]):---  //---  //     {---  //       "@type": "type.googleapis.com/google.protobuf.Duration",---  //       "value": "1.212s"---  //     }---  //---  message Any {-      def "Any" $-        doc ("`Any` contains an arbitrary serialized protocol buffer message along with a " ++-             "URL that describes the type of the serialized message.") $-        record [---    // A URL/resource name that uniquely identifies the type of the serialized---    // protocol buffer message. This string must contain at least---    // one "/" character. The last segment of the URL's path must represent---    // the fully qualified name of the type (as in---    // `path/google.protobuf.Duration`). The name should be in a canonical form---    // (e.g., leading "." is not accepted).---    //---    // In practice, teams usually precompile into the binary all types that they---    // expect it to use in the context of Any. However, for URLs which use the---    // scheme `http`, `https`, or no scheme, one can optionally set up a type---    // server that maps type URLs to message definitions as follows:---    //---    // * If no scheme is provided, `https` is assumed.---    // * An HTTP GET on the URL must yield a [google.protobuf.Type][]---    //   value in binary format, or produce an error.---    // * Applications are allowed to cache lookup results based on the---    //   URL, or have them precompiled into a binary to avoid any---    //   lookup. Therefore, binary compatibility needs to be preserved---    //   on changes to types. (Use versioned type names to manage---    //   breaking changes.)---    //---    // Note: this functionality is not currently available in the official---    // protobuf release, and it is not used for type URLs beginning with---    // type.googleapis.com.---    //---    // Schemes other than `http`, `https` (or the empty scheme) might be---    // used with implementation specific semantics.---    //---    string type_url = 1;-          "typeUrl">:-            doc ("A URL/resource name that uniquely identifies the type of the serialized " ++-                 "protocol buffer message.")-            string,------    // Must be a valid serialized protocol buffer of the above specified type.---    bytes value = 2;-          "value">:-            doc "Must be a valid serialized protocol buffer of the above specified type."-            binary]]---  }
− src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Language.hs 
@@ -1,96 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Protobuf.Language (protobufLanguageModule) where---- Standard Tier-4 imports-import           Prelude hiding ((++))-import qualified Data.List                 as L-import qualified Data.Map                  as M-import qualified Data.Set                  as S-import qualified Data.Maybe                as Y-import           Hydra.Dsl.Base            as Base-import qualified Hydra.Dsl.Core            as Core-import qualified Hydra.Dsl.Graph           as Graph-import qualified Hydra.Dsl.Lib.Equality    as Equality-import qualified Hydra.Dsl.Lib.Flows       as Flows-import qualified Hydra.Dsl.Lib.Io          as Io-import qualified Hydra.Dsl.Lib.Lists       as Lists-import qualified Hydra.Dsl.Lib.Literals    as Literals-import qualified Hydra.Dsl.Lib.Logic       as Logic-import qualified Hydra.Dsl.Lib.Maps        as Maps-import qualified Hydra.Dsl.Lib.Math        as Math-import qualified Hydra.Dsl.Lib.Optionals   as Optionals-import qualified Hydra.Dsl.Lib.Sets        as Sets-import           Hydra.Dsl.Lib.Strings     as Strings-import qualified Hydra.Dsl.Module          as Module-import qualified Hydra.Dsl.Terms           as Terms-import qualified Hydra.Dsl.Types           as Types-import           Hydra.Sources.Tier3.All---protobufLanguageDefinition :: String -> TTerm a -> TElement a-protobufLanguageDefinition = definitionInModule protobufLanguageModule--protobufLanguageModule :: Module-protobufLanguageModule = Module ns elements [hydraCodersModule, hydraBasicsModule, hydraStripModule] tier0Modules $-    Just "Language constraints for Protobuf v3"-  where-    ns = Namespace "hydra/ext/protobuf/language"-    elements = [-      el protobufLanguageDef,-      el protobufReservedWordsDef]--protobufLanguageDef :: TElement (Language)-protobufLanguageDef = protobufLanguageDefinition "protobufLanguage" $-  doc "Language constraints for Protocol Buffers v3" $-  typed languageT $-  record _Language [-    _Language_name>>: wrap _LanguageName "hydra/ext/protobuf",-    _Language_constraints>>: record _LanguageConstraints [-      _LanguageConstraints_eliminationVariants>>: Sets.empty,-      _LanguageConstraints_literalVariants>>: Sets.fromList @@ list (unitVariant _LiteralVariant <$> [-        _LiteralVariant_binary,-        _LiteralVariant_boolean,-        _LiteralVariant_float,-        _LiteralVariant_integer,-        _LiteralVariant_string]),-      _LanguageConstraints_floatTypes>>: Sets.fromList @@ list (unitVariant _FloatType <$> [-        _FloatType_float32,-        _FloatType_float64]),-      _LanguageConstraints_functionVariants>>: Sets.empty,-      _LanguageConstraints_integerTypes>>: Sets.fromList @@ list (unitVariant _IntegerType <$> [-        _IntegerType_int32,-        _IntegerType_int64,-        _IntegerType_uint32,-        _IntegerType_uint64]),-      _LanguageConstraints_termVariants>>: Sets.fromList @@ list (unitVariant _TermVariant <$> [-        _TermVariant_list,-        _TermVariant_literal,-        _TermVariant_map,-        _TermVariant_optional,-        _TermVariant_record,-        _TermVariant_union]),-      _LanguageConstraints_typeVariants>>: Sets.fromList @@ list (unitVariant _TypeVariant <$> [-        _TypeVariant_annotated,-        _TypeVariant_list,-        _TypeVariant_literal,-        _TypeVariant_map,-        _TypeVariant_optional,-        _TypeVariant_record,-        _TypeVariant_union,-        _TypeVariant_variable]),-      _LanguageConstraints_types>>: match _Type (Just true) [-        _Type_map>>: lambda "mt" (match _Type (Just true) [-          _Type_optional>>: constant false] @@ (ref stripTypeDef @@ (Core.mapTypeValues @@ var "mt")))]]]--protobufReservedWordsDef :: TElement (S.Set String)-protobufReservedWordsDef = protobufLanguageDefinition "protobufReservedWords" $-  doc "A set of reserved words in Protobuf" $-  typed (setT stringT) $-  (Sets.fromList @@ (Lists.concat @@ list [var "fieldNames"]))-  `with` [-    "fieldNames">:-      doc "See: http://google.github.io/proto-lens/reserved-names.html" $-      list [-        "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl",-        "infixr", "instance", "let", "mdo", "module", "newtype", "of", "pattern", "proc", "rec", "then", "type", "where"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/Proto3.hs 
@@ -1,164 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Protobuf.Proto3 where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---proto3Ns = Namespace "hydra/ext/protobuf/proto3"-proto3 = typeref proto3Ns--proto3Module :: Module-proto3Module = Module proto3Ns elements [hydraCoreModule] tier0Modules $-    Just ("A model for Protocol Buffers v3 enum and message types, designed as a target for transformations."-      ++ "This model is loosely based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/type.proto,"-      ++ " as well as the proto3 reference documentation")-  where-    def = datatype proto3Ns-    elements = [--      def "Definition" $-        union [-          "enum">: proto3 "EnumDefinition",-          "message">: proto3 "MessageDefinition"],--      def "EnumDefinition" $-        doc "Enum type definition" $-        record [-          "name">:-            doc "Enum type name" $-            proto3 "TypeName",-          "values">:-            doc "Enum value definitions" $-            list $ proto3 "EnumValue",-          "options">:-            doc "Protocol buffer options" $-            list $ proto3 "Option"],--      def "EnumValue" $-        doc "Enum value definition" $-        record [-          "name">:-            doc "Enum value name" $-            proto3 "EnumValueName",-          "number">:-            doc "Enum value number"-            int32,-          "options">:-            doc "Protocol buffer options" $-            list $ proto3 "Option"],--      def "EnumValueName" string,--      def "Field" $-        doc "A single field of a message type" $-        record [-          "name">:-            doc "The field name" $-            proto3 "FieldName",-          "jsonName">:-            doc "The field JSON name" $-            optional string,-          "type">:-            doc "The datatype of the field" $-            proto3 "FieldType",-          "number">:-            doc "The field number"-            int32,-          "options">:-            doc "The protocol buffer options" $-            list $ proto3 "Option"],--      def "FieldName" $-        doc "The name of a field"-        string,--      def "FieldType" $-        union [-          "map">: proto3 "SimpleType",-          "oneof">: list $ proto3 "Field",-          "repeated">: proto3 "SimpleType",-          "simple">: proto3 "SimpleType"],--      def "FileReference" string,--      def "MessageDefinition" $-        doc "A protocol buffer message type" $-        record [-          "name">:-            doc "The fully qualified message name" $-            proto3 "TypeName",-          "fields">:-            doc "The list of fields" $-            list $ proto3 "Field",-          "options">:-            doc "The protocol buffer options" $-            list $ proto3 "Option"],--      def "Option" $-        doc ("A protocol buffer option, which can be attached to a message, field, " ++-             "enumeration, etc") $-        record [-          "name">:-            doc ("The option's name. For protobuf built-in options (options defined in " ++-                 "descriptor.proto), this is the short name. For example, `\"map_entry\"`. " ++-                 "For custom options, it should be the fully-qualified name. For example, " ++-                 "`\"google.api.http\"`.")-            string,-          "value">:-            doc ("The option's value") $-            proto3 "Value"],--      def "PackageName" string,--      def "ProtoFile" $-        doc "A .proto file, usually containing one or more enum or message type definitions" $-        record [-          "package">: proto3 "PackageName",-          "imports">: list $ proto3 "FileReference",-          "types">: list $ proto3 "Definition",-          "options">: list $ proto3 "Option"],--      def "ScalarType" $-        doc "One of several Proto3 scalar types" $-        enum [-          "bool",-          "bytes",-          "double",-          "fixed32",-          "fixed64",-          "float",-          "int32",-          "int64",-          "sfixed32",-          "sfixed64",-          "sint32",-          "sint64",-          "string",-          "uint32",-          "uint64"],--      def "SimpleType" $-        doc "A scalar type or a reference to an enum type or message type" $-        union [-          "reference">: proto3 "TypeName",-          "scalar">: proto3 "ScalarType"],--      def "TypeName" $-        doc "The local name of an enum type or message type"-        string,--      def "TypeReference" $-        doc "A reference to an enum type or message type"-        string,--      def "Value" $-        doc "A scalar value" $-        union [-          "boolean">: boolean,-          "string">: string-          -- Add other scalar value types as needed-        ]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Protobuf/SourceContext.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Protobuf.SourceContext where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Types as Types-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap---pbSourceContextNs = Namespace "hydra/ext/protobuf/sourceContext"-pbSourceContext = typeref pbSourceContextNs--protobufSourceContextModule :: Module-protobufSourceContextModule = Module pbSourceContextNs elements [hydraCoreModule] tier0Modules $-    Just "Based on https://github.com/protocolbuffers/protobuf/blob/main/src/google/protobuf/source_context.proto"-  where-    def = datatype pbSourceContextNs--    elements = [---  // `SourceContext` represents information about the source of a---  // protobuf element, like the file in which it is defined.---  message SourceContext {-      def "SourceContext" $-        doc ("`SourceContext` represents information about the source of a " ++-             "protobuf element, like the file in which it is defined.") $-        record [---    // The path-qualified name of the .proto file that contained the associated---    // protobuf element.  For example: `"google/protobuf/source_context.proto"`.---    string file_name = 1;-          "fileName">:-            doc ("The path-qualified name of the .proto file that contained the associated " ++-                 "protobuf element.  For example: `\"google/protobuf/source_context.proto\"`.")-            string]]---  }
− src/main/haskell/Hydra/Sources/Tier4/Ext/Rdf/Syntax.hs 
@@ -1,102 +0,0 @@-module Hydra.Sources.Tier4.Ext.Rdf.Syntax where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Types as Types-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap---rdfSyntaxModule :: Module-rdfSyntaxModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just "An RDF 1.1 syntax model"-  where-    ns = Namespace "hydra/ext/org/w3/rdf/syntax"-    def = datatype ns-    rdf = typeref ns--    elements = [--      def "BlankNode" string,--      def "RdfsClass"-        $ doc "Stand-in for rdfs:Class" unit,--      def "Dataset" $ set $ rdf "Quad",--      def "Description" $-        doc "A graph of RDF statements together with a distinguished subject and/or object node" $-        record [-          "subject">: rdf "Node",-          "graph">: rdf "Graph"],--      def "Graph" $ set $ rdf "Triple",--      def "Iri" $-        doc "An Internationalized Resource Identifier"-        string,--      def "IriOrLiteral" $-        doc ("An IRI or a literal; " ++-             "this type is a convenience for downstream models like SHACL which may exclude blank nodes") $-        union [-          "iri">: rdf "Iri",-          "literal">: rdf "Literal"],--      def "LangStrings" $-        doc "A convenience type which provides at most one string value per language, and optionally a value without a language" $-        Types.map (optional $ rdf "LanguageTag") string,--      def "LanguageTag" $-        doc "A BCP47 language tag"-        string,--      def "Literal" $-        doc "A value such as a string, number, or date" $-        record [-          "lexicalForm">:-            doc "a Unicode string, which should be in Normal Form C"-            string,-          "datatypeIri">:-            doc "an IRI identifying a datatype that determines how the lexical form maps to a literal value" $-            rdf "Iri",-          "languageTag">:-            doc "An optional language tag, present if and only if the datatype IRI is http://www.w3.org/1999/02/22-rdf-syntax-ns#langString" $-            optional $ rdf "LanguageTag"],--      def "Node" $-        union [-          "iri">: rdf "Iri",-          "bnode">: rdf "BlankNode",-          "literal">: rdf "Literal"],--      def "Property" $-        doc "A type representing an RDF property, and encapsulating its domain, range, and subclass relationships" $-        record [-          "domain">:-            doc "State that any resource that has a given property is an instance of one or more classes" $-            set $ rdf "RdfsClass",-          "range">:-            doc "States that the values of a property are instances of one or more classes" $-            set $ rdf "RdfsClass",-          "subPropertyOf">:-            set $ rdf "Property"],--      def "Quad" $-        doc "An RDF triple with an optional named graph component" $-        record [-          "subject">: rdf "Resource",-          "predicate">: rdf "Iri",-          "object">: rdf "Node",-          "graph">: optional $ rdf "Iri"],--      def "Resource" $-        union [-          "iri">: rdf "Iri",-          "bnode">: rdf "BlankNode"],--      def "Triple" $-        doc "An RDF triple defined by a subject, predicate, and object" $-        record [-          "subject">: rdf "Resource",-          "predicate">: rdf "Iri",-          "object">: rdf "Node"]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/RelationalModel.hs 
@@ -1,83 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.RelationalModel where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---relationalModelModule :: Module-relationalModelModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("An interpretation of Codd's Relational Model, " ++-      "as described in 'A Relational Model of Data for Large Shared Data Banks' (1970). " ++-      "Types ('domains') and values are parameterized so as to allow for application-specific implementations. " ++-      "No special support is provided for 'nonsimple' domains; i.e. relations are assumed to be normalized.")-  where-    ns = Namespace "hydra/ext/relationalModel"-    def = datatype ns-    rm = typeref ns--    elements = [-      def "ColumnName" $-        doc "A name for a domain which serves to identify the role played by that domain in the given relation; a 'role name' in Codd"-        string,--      def "ColumnSchema" $-        doc "An abstract specification of the domain represented by a column in a relation; a role" $-        lambda "t" $ record [-          "name">:-            doc "A unique name for the column" $-            rm "ColumnName",-          "domain">:-            doc "The domain (type) of the column" $-            "t",-          "isPrimaryKey">:-            doc "Whether this column represents the primary key of its relation"-            boolean],--      def "ForeignKey" $-        doc "A mapping from certain columns of a source relation to primary key columns of a target relation" $-        record [-          "foreignRelation">:-            doc "The name of the target relation" $-            rm "RelationName",-          "keys">:-            Types.map (rm "ColumnName") (rm "ColumnName")], -- TODO: nonempty map--      def "PrimaryKey" $-        doc "A primary key of a relation, specified either as a single column, or as a list of columns" $-        list $ rm "ColumnName", -- TODO: non-empty list--      def "Relation" $-        doc "A set of distinct n-tuples; a table" $-        lambda "v" $ set $ list "v",--      def "RelationName" $-        doc "A unique relation (table) name"-        string,--      def "RelationSchema" $ -- Note: this term is not in Codd-        doc "An abstract relation; the name and columns of a relation without its actual data" $-        lambda "t" $ record [-          "name">:-            doc "A unique name for the relation" $-            rm "RelationName",-          "columns">:-            doc "A list of column specifications" $-            list $ rm "ColumnSchema" @@ "t",-          "primaryKeys">:-            doc "Any number of primary keys for the relation, each of which must be valid for this relation" $-            list $ rm "PrimaryKey",-          "foreignKeys">:-            doc "Any number of foreign keys, each of which must be valid for both this relation and the target relation" $-            list $ rm "ForeignKey"],--      def "Relationship" $-        doc "A domain-unordered (string-indexed, rather than position-indexed) relation" $-        lambda "v" $ set $ Types.map (rm "ColumnName") "v",--      def "Row" $-        doc "An n-tuple which is an element of a given relation" $-        lambda "v" $ list "v"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Scala/Meta.hs 
@@ -1,1372 +0,0 @@-module Hydra.Sources.Tier4.Ext.Scala.Meta where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---scalaMetaModule :: Module-scalaMetaModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just "A Scala syntax model based on Scalameta (https://scalameta.org)"-  where-    ns = Namespace "hydra/ext/scala/meta"-    def = datatype ns-    meta = typeref ns--    elements = [--      def "PredefString" --  See scala/Predef.scala-        string,--      def "ScalaSymbol" $ --  See scala/Symbol.scala-        record [-          "name">: string],----  scala/meta/Trees.scala source below this line. Hydra type definitions inline---- package scala.meta------ import org.scalameta.invariants._--- import scala.meta.classifiers._--- import scala.meta.inputs._--- import scala.meta.tokens._--- import scala.meta.prettyprinters._--- import scala.meta.internal.trees._--- import scala.meta.internal.trees.Metadata.binaryCompatField--- @root trait Tree extends InternalTree {-      def "Tree" $ --  Note: ignoring fields of Tree and InternalTree for now-        union [-          "ref">: meta "Ref",-          "stat">: meta "Stat",-          "type">: meta "Type",-          "bounds">: meta "Type.Bounds",-          "pat">: meta "Pat",-          "member">: meta "Member",-          "ctor">: meta "Ctor",-          "template">: meta "Template",-          "mod">: meta "Mod",-          "enumerator">: meta "Enumerator",-          "importer">: meta "Importer",-          "importee">: meta "Importee",-          "caseTree">: meta "CaseTree",-          "source">: meta "Source",-          "quasi">: meta "Quasi"],---   def parent: Option[Tree]---   def children: List[Tree]------   def pos: Position---   def tokens(implicit dialect: Dialect): Tokens------   final override def canEqual(that: Any): Boolean = this eq that.asInstanceOf[AnyRef]---   final override def equals(that: Any): Boolean = this eq that.asInstanceOf[AnyRef]---   final override def hashCode: Int = System.identityHashCode(this)---   final override def toString = scala.meta.internal.prettyprinters.TreeToString(this)--- }------ object Tree extends InternalTreeXtensions {---   implicit def classifiable[T <: Tree]: Classifiable[T] = null---   implicit def showStructure[T <: Tree]: Structure[T] =---     scala.meta.internal.prettyprinters.TreeStructure.apply[T]---   implicit def showSyntax[T <: Tree](implicit dialect: Dialect): Syntax[T] =---     scala.meta.internal.prettyprinters.TreeSyntax.apply[T](dialect)--- }------ @branch trait Ref extends Tree-      def "Ref" $-        union [-          "name">: meta "Name",-          "init">: meta "Init"],--- @branch trait Stat extends Tree-      def "Stat" $-        union [-          "term">: meta "Data",-          "decl">: meta "Decl",-          "defn">: meta "Defn",-          "importExport">: meta "ImportExportStat"],------ @branch trait Name extends Ref { def value: String }-      def "Name" $-        union [-          "value">: string,-          "anonymous">: unit,-          "indeterminate">: meta "PredefString"],--- object Name {---   def apply(value: String): Name = if (value == "") Name.Anonymous() else Name.Indeterminate(value)---   def unapply(name: Name): Option[String] = Some(name.value)---   @ast class Anonymous() extends Name {---     def value = ""---     checkParent(ParentChecks.NameAnonymous)---   }---   @ast class Indeterminate(value: Predef.String @nonEmpty) extends Name--- }------ @branch trait Lit extends Data with Pat with Type {-      def "Lit" $-        union [---   def value: Any--- }--- object Lit {---   def unapply(arg: Lit): Option[Any] = Some(arg.value)---   @ast class Null() extends Lit { def value: Any = null }-          "null">: unit,---   @ast class Int(value: scala.Int) extends Lit-          "int">: int32,---   // NOTE: Lit.Double/Float are strings to work the same across JS/JVM. Example:---   // 1.4f.toString == "1.399999976158142" // in JS---   // 1.4f.toString == "1.4"               // in JVM---   // See https://www.scala-js.org/doc/semantics.html-- tostring-of-float-double-and-unit---   @ast class Double(format: scala.Predef.String) extends Lit { val value = format.toDouble }-          "double">: float64,---   object Double { def apply(double: scala.Double): Double = Lit.Double(double.toString) }---   @ast class Float(format: scala.Predef.String) extends Lit { val value = format.toFloat }-          "float">: float32,---   object Float { def apply(float: scala.Float): Float = Lit.Float(float.toString) }---   @ast class Byte(value: scala.Byte) extends Lit-          "byte">: int8,---   @ast class Short(value: scala.Short) extends Lit-          "short">: int16,---   @ast class Char(value: scala.Char) extends Lit-          "char">: uint16,---   @ast class Long(value: scala.Long) extends Lit-          "long">: int64,---   @ast class Boolean(value: scala.Boolean) extends Lit-          "boolean">: boolean,---   @ast class Unit() extends Lit { def value: Any = () }-          "unit">: unit,---   @ast class String(value: scala.Predef.String) extends Lit-          "string">: string,---   @ast class Symbol(value: scala.Symbol) extends Lit-          "symbol">: meta "ScalaSymbol"],--- }------ @branch trait Data extends Stat-      def "Data" $-        union [-          "lit">: meta "Lit",-          "ref">: meta "Data.Ref",-          "interpolate">: meta "Data.Interpolate",-          "xml">: meta "Data.Xml",-          "apply">: meta "Data.Apply",-          "applyUsing">: meta "Data.ApplyUsing",-          "applyType">: meta "Data.ApplyType",-          "assign">: meta "Data.Assign",-          "return">: meta "Data.Return",-          "throw">: meta "Data.Throw",-          "ascribe">: meta "Data.Ascribe",-          "annotate">: meta "Data.Annotate",-          "tuple">: meta "Data.Tuple",-          "block">: meta "Data.Block",-          "endMarker">: meta "Data.EndMarker",-          "if">: meta "Data.If",-          "quotedMacroExpr">: meta "Data.QuotedMacroExpr",-          "quotedMacroType">: meta "Data.QuotedMacroType",-          "splicedMacroExpr">: meta "Data.SplicedMacroExpr",-          "match">: meta "Data.Match",-          "try">: meta "Data.Try",-          "tryWithHandler">: meta "Data.TryWithHandler",-          "functionData">: meta "Data.FunctionData",-          "polyFunction">: meta "Data.PolyFunction",-          "partialFunction">: meta "Data.PartialFunction",-          "while">: meta "Data.While",-          "do">: meta "Data.Do",-          "for">: meta "Data.For",-          "forYield">: meta "Data.ForYield",-          "new">: meta "Data.New",-          "newAnonymous">: meta "Data.NewAnonymous",-          "placeholder">: meta "Data.Placeholder",-          "eta">: meta "Data.Eta",-          "repeated">: meta "Data.Repeated",-          "param">: meta "Data.Param"],--- object Data {---   @branch trait Ref extends Data with scala.meta.Ref-      def "Data.Ref" $-        union [-          "this">: meta "Data.This",-          "super">: meta "Data.Super",-          "name">: meta "Data.Name",-          "anonymous">: meta "Data.Anonymous",-          "select">: meta "Data.Select",-          "applyUnary">: meta "Data.ApplyUnary"],---   @ast class This(qual: scala.meta.Name) extends Data.Ref-      def "Data.This"-        unit,---   @ast class Super(thisp: scala.meta.Name, superp: scala.meta.Name) extends Data.Ref-      def "Data.Super" $-        record [-          "thisp">: meta "Name",-          "superp">: meta "Name"],---   @ast class Name(value: Predef.String @nonEmpty) extends scala.meta.Name with Data.Ref with Pat-      def "Data.Name" $-        record [-          "value">: meta "PredefString"],---   @ast class Anonymous() extends scala.meta.Name with Data.Ref {-      def "Data.Anonymous"-        unit,---     def value = ""---     checkParent(ParentChecks.AnonymousImport)---   }---   @ast class Select(qual: Data, name: Data.Name) extends Data.Ref with Pat-      def "Data.Select" $-        record [-          "qual">: meta "Data",-          "name">: meta "Data.Name"],---   @ast class Interpolate(prefix: Name, parts: List[Lit] @nonEmpty, args: List[Data]) extends Data {-      def "Data.Interpolate" $-        record [-          "prefix">: meta "Data.Name",-          "parts">: list $ meta "Lit",-          "args">: list $ meta "Data"],---     checkFields(parts.length == args.length + 1)---   }---   @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Data]) extends Data {-      def "Data.Xml" $-        record [-          "parts">: list $ meta "Lit",-          "args">: list $ meta "Data"],---     checkFields(parts.length == args.length + 1)---   }---   @ast class Apply(fun: Data, args: List[Data]) extends Data-      def "Data.Apply" $-        record [-          "fun">: meta "Data",-          "args">: list $ meta "Data"],---   @ast class ApplyUsing(fun: Data, args: List[Data]) extends Data-      def "Data.ApplyUsing" $-        record [-          "fun">: meta "Data",-          "targs">: list $ meta "Data"],---   @ast class ApplyType(fun: Data, targs: List[Type] @nonEmpty) extends Data-      def "Data.ApplyType" $-        record [-          "lhs">: meta "Data",-          "op">: meta "Data.Name",-          "targs">: list $ meta "Type",-          "args">: list $ meta "Data"],---   @ast class ApplyInfix(lhs: Data, op: Name, targs: List[Type], args: List[Data]) extends Data-      def "Data.ApplyInfix" $-        record [-          "lhs">: meta "Data",-          "op">: meta "Data.Name",-          "targs">: list $ meta "Type",-          "args">: list $ meta "Data"],---   @ast class ApplyUnary(op: Name, arg: Data) extends Data.Ref {-      def "Data.ApplyUnary" $-        record [-          "op">: meta "Data.Name",-          "arg">: meta "Data"],---     checkFields(op.isUnaryOp)---   }---   @ast class Assign(lhs: Data, rhs: Data) extends Data {-      def "Data.Assign" $-        record [-          "lhs">: meta "Data",-          "rhs">: meta "Data"],---     checkFields(lhs.is[Data.Quasi] || lhs.is[Data.Ref] || lhs.is[Data.Apply])---     checkParent(ParentChecks.DataAssign)---   }---   @ast class Return(expr: Data) extends Data-      def "Data.Return" $-        record [-          "expr">: meta "Data"],---   @ast class Throw(expr: Data) extends Data-      def "Data.Throw" $-        record [-          "expr">: meta "Data"],---   @ast class Ascribe(expr: Data, tpe: Type) extends Data-      def "Data.Ascribe" $-        record [-          "expr">: meta "Data",-          "tpe">: meta "Type"],---   @ast class Annotate(expr: Data, annots: List[Mod.Annot] @nonEmpty) extends Data-      def "Data.Annotate" $-        record [-          "expr">: meta "Data",-          "annots">: list $ meta "Mod.Annot"],---   @ast class Tuple(args: List[Data] @nonEmpty) extends Data {-      def "Data.Tuple" $-        record [-          "args">: list $ meta "Data"],---     // tuple must have more than one element---     // however, this element may be Quasi with "hidden" list of elements inside---     checkFields(args.length > 1 || (args.length == 1 && args.head.is[Data.Quasi]))---   }---   @ast class Block(stats: List[Stat]) extends Data {-      def "Data.Block" $-        record [-          "stats">: list $ meta "Stat"],---     // extension group block can have declarations without body too---     checkFields(stats.forall(st => st.isBlockStat || st.is[Decl]))---   }---   @ast class EndMarker(name: Data.Name) extends Data-      def "Data.EndMarker" $-        record [-          "name">: meta "Data.Name"],---   @ast class If(cond: Data, thenp: Data, elsep: Data) extends Data {-      def "Data.If" $-        record [-          "cond">: meta "Data",-          "thenp">: meta "Data",-          "elsep">: meta "Data"],---     @binaryCompatField(since = "4.4.0")---     private var _mods: List[Mod] = Nil---   }---   @ast class QuotedMacroExpr(body: Data) extends Data-      def "Data.QuotedMacroExpr" $-        record [-          "body">: meta "Data"],---   @ast class QuotedMacroType(tpe: Type) extends Data-      def "Data.QuotedMacroType" $-        record [-          "tpe">: meta "Type"],---   @ast class SplicedMacroExpr(body: Data) extends Data-      def "Data.SplicedMacroExpr" $-        record [-          "body">: meta "Data"],---   @ast class Match(expr: Data, cases: List[Case] @nonEmpty) extends Data {-      def "Data.Match" $-        record [-          "expr">: meta "Data",-          "cases">: list $ meta "Case"],---     @binaryCompatField(since = "4.4.5")---     private var _mods: List[Mod] = Nil---   }---   @ast class Try(expr: Data, catchp: List[Case], finallyp: Option[Data]) extends Data-      def "Data.Try" $-        record [-          "expr">: meta "Data",-          "catchp">: list $ meta "Case",-          "finallyp">: optional $ meta "Data"],---   @ast class TryWithHandler(expr: Data, catchp: Data, finallyp: Option[Data]) extends Data-      def "Data.TryWithHandler" $-        record [-          "expr">: meta "Data",-          "catchp">: meta "Data",-          "finallyp">: optional $ meta "Data"],------   @branch trait FunctionData extends Data {-      def "Data.FunctionData" $-        union [-          "contextFunction">: meta "Data.ContextFunction",-          "function">: meta "Data.Function"],---     def params: List[Data.Param]---     def body: Data---   }---   @ast class ContextFunction(params: List[Data.Param], body: Data) extends FunctionData {-      def "Data.ContextFunction" $-        record [-          "params">: list $ meta "Data.Param",-          "body">: meta "Data"],---     checkFields(---       params.forall(param =>---         param.is[Data.Param.Quasi] ||---           (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty)---       )---     )---   }---   @ast class Function(params: List[Data.Param], body: Data) extends FunctionData {-      def "Data.Function" $-        record [-          "params">: list $ meta "Data.Param",-          "body">: meta "Data"],---     checkFields(---       params.forall(param =>---         param.is[Data.Param.Quasi] ||---           (param.name.is[scala.meta.Name.Anonymous] ==> param.default.isEmpty)---       )---     )---     checkFields(---       params.exists(_.is[Data.Param.Quasi]) ||---         params.exists(_.mods.exists(_.is[Mod.Implicit])) ==> (params.length == 1)---     )---   }---   @ast class PolyFunction(tparams: List[Type.Param], body: Data) extends Data-      def "Data.PolyFunction" $-        record [-          "tparams">: list $ meta "Type.Param",-          "body">: meta "Data"],---   @ast class PartialFunction(cases: List[Case] @nonEmpty) extends Data-      def "Data.PartialFunction" $-        record [-          "cases">: list $ meta "Case"],---   @ast class While(expr: Data, body: Data) extends Data-      def "Data.While" $-        record [-          "expr">: meta "Data",-          "body">: meta "Data"],---   @ast class Do(body: Data, expr: Data) extends Data-      def "Data.Do" $-        record [-          "body">: meta "Data",-          "expr">: meta "Data"],---   @ast class For(enums: List[Enumerator] @nonEmpty, body: Data) extends Data {-      def "Data.For" $-        record [-          "enums">: list $ meta "Enumerator"],---     checkFields(---       enums.head.is[Enumerator.Generator] || enums.head.is[Enumerator.CaseGenerator] || enums.head---         .is[Enumerator.Quasi]---     )---   }---   @ast class ForYield(enums: List[Enumerator] @nonEmpty, body: Data) extends Data-      def "Data.ForYield" $-        record [-          "enums">: list $ meta "Enumerator"],---   @ast class New(init: Init) extends Data-      def "Data.New" $-        record [-          "init">: meta "Init"],---   @ast class NewAnonymous(templ: Template) extends Data-      def "Data.NewAnonymous" $-        record [-          "templ">: meta "Template"],---   @ast class Placeholder() extends Data-      def "Data.Placeholder"-        unit,---   @ast class Eta(expr: Data) extends Data-      def "Data.Eta" $-        record [-          "expr">: meta "Data"],---   @ast class Repeated(expr: Data) extends Data {-      def "Data.Repeated" $-        record [-          "expr">: meta "Data"],---     checkParent(ParentChecks.DataRepeated)---   }---   @ast class Param(mods: List[Mod], name: meta.Name, decltpe: Option[Type], default: Option[Data])---       extends Member-      def "Data.Param" $-        record [-          "mods">: list $ meta "Mod",-          "name">: meta "Name",-          "decltpe">: optional $ meta "Type",-          "default">: optional $ meta "Data"],---   def fresh(): Data.Name = fresh("fresh")---   def fresh(prefix: String): Data.Name = Data.Name(prefix + Fresh.nextId())--- }------ @branch trait Type extends Tree-      def "Type" $-        union [-          "ref">: meta "Type.Ref",-          "anonymousName">: meta "Type.AnonymousName",-          "apply">: meta "Type.Apply",-          "applyInfix">: meta "Type.ApplyInfix",-          "functionType">: meta "Type.FunctionType",-          "polyFunction">: meta "Type.PolyFunction",-          "implicitFunction">: meta "Type.ImplicitFunction",-          "tuple">: meta "Type.Tuple",-          "with">: meta "Type.With",-          "and">: meta "Type.And",-          "or">: meta "Type.Or",-          "refine">: meta "Type.Refine",-          "existential">: meta "Type.Existential",-          "annotate">: meta "Type.Annotate",-          "lambda">: meta "Type.Lambda",-          "macro">: meta "Type.Macro",-          "method">: meta "Type.Method",-          "placeholder">: meta "Type.Placeholder",-          "byName">: meta "Type.ByName",-          "repeated">: meta "Type.Repeated",-          "var">: meta "Type.Var",-          "typedParam">: meta "Type.TypedParam",-          "match">: meta "Type.Match"],--- object Type {---   @branch trait Ref extends Type with scala.meta.Ref-      def "Type.Ref" $-        union [-          "name">: meta "Type.Name",-          "select">: meta "Type.Select",-          "project">: meta "Type.Project",-          "singleton">: meta "Type.Singleton"],---   @ast class Name(value: String @nonEmpty) extends scala.meta.Name with Type.Ref-      def "Type.Name" $-        record [-          "value">: string],---   @ast class AnonymousName() extends Type-      def "Type.AnonymousName"-        unit,---   @ast class Select(qual: Data.Ref, name: Type.Name) extends Type.Ref {-      def "Type.Select" $-        record [-          "qual">: meta "Data.Ref",-          "name">: meta "Type.Name"],---     checkFields(qual.isPath || qual.is[Data.Super] || qual.is[Data.Ref.Quasi])---   }---   @ast class Project(qual: Type, name: Type.Name) extends Type.Ref-      def "Type.Project" $-        record [-          "qual">: meta "Type",-          "name">: meta "Type.Name"],---   @ast class Singleton(ref: Data.Ref) extends Type.Ref {-      def "Type.Singleton" $-        record [-          "ref">: meta "Data.Ref"],---     checkFields(ref.isPath || ref.is[Data.Super])---   }---   @ast class Apply(tpe: Type, args: List[Type] @nonEmpty) extends Type-      def "Type.Apply" $-        record [-          "tpe">: meta "Type",-          "args">: list $ meta "Type"],---   @ast class ApplyInfix(lhs: Type, op: Name, rhs: Type) extends Type-      def "Type.ApplyInfix" $-        record [-          "lhs">: meta "Type",-          "op">: meta "Type.Name",-          "rhs">: meta "Type"],---   @branch trait FunctionType extends Type {-      def "Type.FunctionType" $-        union [-          "function">: meta "Type.Function",-          "contextFunction">: meta "Type.ContextFunction"],---     def params: List[Type]---     def res: Type---   }---   @ast class Function(params: List[Type], res: Type) extends FunctionType-      def "Type.Function" $-        record [-          "params">: list $ meta "Type",-          "res">: meta "Type"],---   @ast class PolyFunction(tparams: List[Type.Param], tpe: Type) extends Type-      def "Type.PolyFunction" $-        record [-          "tparams">: list $ meta "Type.Param",-          "tpe">: meta "Type"],---   @ast class ContextFunction(params: List[Type], res: Type) extends FunctionType-      def "Type.ContextFunction" $-        record [-          "params">: list $ meta "Type",-          "res">: meta "Type"],---   @ast @deprecated("Implicit functions are not supported in any dialect")---   class ImplicitFunction(-      def "Type.ImplicitFunction" $-        record [---       params: List[Type],-          "params">: list $ meta "Type",---       res: Type-          "res">: meta "Type"],---   ) extends Type---   @ast class Tuple(args: List[Type] @nonEmpty) extends Type {-      def "Type.Tuple" $-        record [-          "args">: list $ meta "Type"],---     checkFields(args.length > 1 || (args.length == 1 && args.head.is[Type.Quasi]))---   }---   @ast class With(lhs: Type, rhs: Type) extends Type-      def "Type.With" $-        record [-          "lhs">: meta "Type",-          "rhs">: meta "Type"],---   @ast class And(lhs: Type, rhs: Type) extends Type-      def "Type.And" $-        record [-          "lhs">: meta "Type",-          "rhs">: meta "Type"],---   @ast class Or(lhs: Type, rhs: Type) extends Type-      def "Type.Or" $-        record [-          "lhs">: meta "Type",-          "rhs">: meta "Type"],---   @ast class Refine(tpe: Option[Type], stats: List[Stat]) extends Type {-      def "Type.Refine" $-        record [-          "tpe">: optional $ meta "Type",-          "stats">: list $ meta "Stat"],---     checkFields(stats.forall(_.isRefineStat))---   }---   @ast class Existential(tpe: Type, stats: List[Stat] @nonEmpty) extends Type {-      def "Type.Existential" $-        record [-          "tpe">: meta "Type",-          "stats">: list $ meta "Stat"],---     checkFields(stats.forall(_.isExistentialStat))---   }---   @ast class Annotate(tpe: Type, annots: List[Mod.Annot] @nonEmpty) extends Type-      def "Type.Annotate" $-        record [-          "tpe">: meta "Type",-          "annots">: list $ meta "Mod.Annot"],---   @ast class Lambda(tparams: List[Type.Param], tpe: Type) extends Type {-      def "Type.Lambda" $-        record [-          "tparams">: list $ meta "Type.Param",-          "tpe">: meta "Type"],---     checkParent(ParentChecks.LambdaType)---   }---   @ast class Macro(body: Data) extends Type-      def "Type.Macro" $-        record [-          "body">: meta "Data"],---   @deprecated("Method type syntax is no longer supported in any dialect", "4.4.3")---   @ast class Method(paramss: List[List[Data.Param]], tpe: Type) extends Type {-      def "Type.Method" $-        record [-          "paramss">: list $ list $ meta "Data.Param",-          "tpe">: meta "Type"],---     checkParent(ParentChecks.TypeMethod)---   }---   @ast class Placeholder(bounds: Bounds) extends Type-      def "Type.Placeholder" $-        record [-          "bounds">: meta "Type.Bounds"],---   @ast class Bounds(lo: Option[Type], hi: Option[Type]) extends Tree-      def "Type.Bounds" $-        record [-          "lo">: optional $ meta "Type",-          "hi">: optional $ meta "Type"],---   @ast class ByName(tpe: Type) extends Type {-      def "Type.ByName" $-        record [-          "tpe">: meta "Type"],---     checkParent(ParentChecks.TypeByName)---   }---   @ast class Repeated(tpe: Type) extends Type {-      def "Type.Repeated" $-        record [-          "tpe">: meta "Type"],---     checkParent(ParentChecks.TypeRepeated)---   }---   @ast class Var(name: Name) extends Type with Member.Type {-      def "Type.Var" $-        record [-          "name">: meta "Type.Name"],---     checkFields(name.value(0).isLower)---     checkParent(ParentChecks.TypeVar)---   }------   @ast class TypedParam(name: Name, typ: Type) extends Type with Member.Type-      def "Type.TypedParam" $-        record [-          "name">: meta "Name",-          "typ">: meta "Type"],---   @ast class Param(-      def "Type.Param" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: meta.Name,-          "name">: meta "Name",---       tparams: List[Type.Param],-          "tparams">: list $ meta "Type.Param",---       tbounds: Type.Bounds,-          "tbounds">: list $ meta "Type.Bounds",---       vbounds: List[Type],-          "vbounds">: list $ meta "Type",---       cbounds: List[Type]-          "cbounds">: list $ meta "Type"],---   ) extends Member------   @ast class Match(tpe: Type, cases: List[TypeCase] @nonEmpty) extends Type-      def "Type.Match" $-        record [-          "tpe">: meta "Type",-          "cases">: list $ meta "TypeCase"],---   def fresh(): Type.Name = fresh("fresh")---   def fresh(prefix: String): Type.Name = Type.Name(prefix + Fresh.nextId())--- }------ @branch trait Pat extends Tree-      def "Pat" $-        union [-          "var">: meta "Pat.Var",-          "wildcard">: unit,-          "seqWildcard">: unit,-          "bind">: meta "Pat.Bind",-          "alternative">: meta "Pat.Alternative",-          "tuple">: meta "Pat.Tuple",-          "repeated">: meta "Pat.Repeated",-          "extract">: meta "Pat.Extract",-          "extractInfix">: meta "Pat.ExtractInfix",-          "interpolate">: meta "Pat.Interpolate",-          "xml">: meta "Pat.Xml",-          "typed">: meta "Pat.Typed",-          "macro">: meta "Pat.Macro",-          "given">: meta "Pat.Given"],--- object Pat {---   @ast class Var(name: scala.meta.Data.Name) extends Pat with Member.Data { @-      def "Pat.Var" $-        record [-          "name">: meta "Data.Name"],---     // NOTE: can't do this check here because of things like `val X = 2`---     // checkFields(name.value(0).isLower)---     checkParent(ParentChecks.PatVar)---   }---   @ast class Wildcard() extends Pat---   @ast class SeqWildcard() extends Pat {---     checkParent(ParentChecks.PatSeqWildcard)---   }---   @ast class Bind(lhs: Pat, rhs: Pat) extends Pat {-      def "Pat.Bind" $-        record [-          "lhs">: meta "Pat",-          "rhs">: meta "Pat"],---     checkFields(lhs.is[Pat.Var] || lhs.is[Pat.Quasi])---   }---   @ast class Alternative(lhs: Pat, rhs: Pat) extends Pat-      def "Pat.Alternative" $-        record [-          "lhs">: meta "Pat",-          "rhs">: meta "Pat"],---   @ast class Tuple(args: List[Pat] @nonEmpty) extends Pat {-      def "Pat.Tuple" $-        record [-          "args">: list $ meta "Pat"],---     checkFields(args.length > 1 || (args.length == 1 && args.head.is[Pat.Quasi]))---   }---   @ast class Repeated(name: scala.meta.Data.Name) extends Pat-      def "Pat.Repeated" $-        record [-          "name">: meta "Data.Name"],---   @ast class Extract(fun: Data, args: List[Pat]) extends Pat {-      def "Pat.Extract" $-        record [-          "fun">: meta "Data",-          "args">: list $ meta "Pat"],---     checkFields(fun.isExtractor)---   }---   @ast class ExtractInfix(lhs: Pat, op: Data.Name, rhs: List[Pat]) extends Pat-      def "Pat.ExtractInfix" $-        record [-          "lhs">: meta "Pat",-          "op">: meta "Data.Name",-          "rhs">: list $ meta "Pat"],---   @ast class Interpolate(prefix: Data.Name, parts: List[Lit] @nonEmpty, args: List[Pat])-      def "Pat.Interpolate" $-        record [-          "prefix">: meta "Data.Name",-          "parts">: list $ meta "Lit"],---       extends Pat {---     checkFields(parts.length == args.length + 1)---   }---   @ast class Xml(parts: List[Lit] @nonEmpty, args: List[Pat]) extends Pat {-      def "Pat.Xml" $-        record [-          "parts">: list $ meta "Lit",-          "args">: list $ meta "Pat"],---     checkFields(parts.length == args.length + 1)---   }---   @ast class Typed(lhs: Pat, rhs: Type) extends Pat {-      def "Pat.Typed" $-        record [-          "lhs">: meta "Pat",-          "rhs">: meta "Type"],---     checkFields(!rhs.is[Type.Var] && !rhs.is[Type.Placeholder])---   }---   @ast class Macro(body: Data) extends Pat {-      def "Pat.Macro" $-        record [-          "body">: meta "Data"],---     checkFields(body.is[Data.QuotedMacroExpr] || body.is[Data.QuotedMacroType])---   }---   @ast class Given(tpe: Type) extends Pat-      def "Pat.Given" $-        record [-          "tpe">: meta "Type"],---   def fresh(): Pat.Var = Pat.Var(Data.fresh())---   def fresh(prefix: String): Pat.Var = Pat.Var(Data.fresh(prefix))--- }------ @branch trait Member extends Tree {-      def "Member" $-        union [-          "term">: meta "Member.Data",-          "type">: meta "Member.Type",-          "termParam">: meta "Data.Param",-          "typeParam">: meta "Type.Param",-          "self">: meta "Self"],---   def name: Name--- }--- object Member {---   @branch trait Data extends Member {-      def "Member.Data" $-        union [-          "pkg">: meta "Pkg",-          "object">: meta "Pkg.Object"],---     def name: scala.meta.Data.Name---   }---   @branch trait Type extends Member {-      def "Member.Type" $-        record [---     def name: scala.meta.Type.Name-          "name">: meta "Type.Name"],---   }--- }------ @branch trait Decl extends Stat-      def "Decl" $-        union [-          "val">: meta "Decl.Val",-          "var">: meta "Decl.Var",-          "def">: meta "Decl.Def",-          "type">: meta "Decl.Type",-          "given">: meta "Decl.Given"],--- object Decl {---   @ast class Val(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl-      def "Decl.Val" $-        record [-          "mods">: list $ meta "Mod",-          "pats">: list $ meta "Pat",-          "decltpe">: meta "Type"],---   @ast class Var(mods: List[Mod], pats: List[Pat] @nonEmpty, decltpe: scala.meta.Type) extends Decl-      def "Decl.Var" $-        record [-          "mods">: list $ meta "Mod",-          "pats">: list $ meta "Pat",-          "decltpe">: meta "Type"],---   @ast class Def(-      def "Decl.Def" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Data.Name,-          "name">: meta "Data.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       paramss: List[List[Data.Param]],-          "paramss">: list $ list $ meta "Data.Param",---       decltpe: scala.meta.Type-          "decltpe">: meta "Type"],---   ) extends Decl with Member.Data @-      --   @ast class Type(-      def "Decl.Type" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Type.Name,-          "name">: meta "Type.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       bounds: scala.meta.Type.Bounds-          "bounds">: meta "Type.Bounds"],---   ) extends Decl with Member.Type---   @ast class Given(-      def "Decl.Given" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Data.Name,-          "name">: meta "Data.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       sparams: List[List[Data.Param]],-          "sparams">: list $ list $ meta "Data.Param",---       decltpe: scala.meta.Type-          "decltpe">: meta "Type"],---   ) extends Decl with Member.Data @--- }------ @branch trait Defn extends Stat-      def "Defn" $-        union [-          "val">: meta "Defn.Val",-          "var">: meta "Defn.Var",-          "given">: meta "Defn.Given",-          "enum">: meta "Defn.Enum",-          "enumCase">: meta "Defn.EnumCase",-          "repeatedEnumCase">: meta "Defn.RepeatedEnumCase",-          "givenAlias">: meta "Defn.GivenAlias",-          "extensionGroup">: meta "Defn.ExtensionGroup",-          "def">: meta "Defn.Def",-          "macro">: meta "Defn.Macro",-          "type">: meta "Defn.Type",-          "class">: meta "Defn.Class",-          "trait">: meta "Defn.Trait",-          "object">: meta "Defn.Object"],--- object Defn {---   @ast class Val(-      def "Defn.Val" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       pats: List[Pat] @nonEmpty,-          "pats">: list $ meta "Pat",---       decltpe: Option[scala.meta.Type],-          "decltpe">: optional $ meta "Type",---       rhs: Data-          "rhs">: meta "Data"],---   ) extends Defn {---     checkFields(pats.forall(!_.is[Data.Name]))---   }---   @ast class Var(-      def "Defn.Var" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       pats: List[Pat] @nonEmpty,-          "pats">: list $ meta "Pat",---       decltpe: Option[scala.meta.Type],-          "decltpe">: meta "Type",---       rhs: Option[Data]-          "rhs">: optional $ meta "Data"],---   ) extends Defn {---     checkFields(pats.forall(!_.is[Data.Name]))---     checkFields(decltpe.nonEmpty || rhs.nonEmpty)---     checkFields(rhs.isEmpty ==> pats.forall(_.is[Pat.Var]))---   }---   @ast class Given(-      def "Defn.Given" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Name,-          "name">: meta "Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ list $ meta "Type.Param",---       sparams: List[List[Data.Param]],-          "sparams">: list $ list $ meta "Data.Param",---       templ: Template-          "templ">: meta "Template"],---   ) extends Defn---   @ast class Enum(-      def "Defn.Enum" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Type.Name,-          "name">: meta "Type.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       ctor: Ctor.Primary,-          "ctor">: meta "Ctor.Primary",---       templ: Template-          "template">: meta "Template"],---   ) extends Defn with Member.Type---   @ast class EnumCase(-      def "Defn.EnumCase" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Data.Name,-          "name">: meta "Data.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       ctor: Ctor.Primary,-          "ctor">: meta "Ctor.Primary",---       inits: List[Init]-          "inits">: list $ meta "Init"],---   ) extends Defn with Member.Data { @---     checkParent(ParentChecks.EnumCase)---   }---   @ast class RepeatedEnumCase(-      def "Defn.RepeatedEnumCase" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       cases: List[Data.Name]-          "cases">: list $ meta "Data.Name"],---   ) extends Defn {---     checkParent(ParentChecks.EnumCase)---   }---   @ast class GivenAlias(-      def "Defn.GivenAlias" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Name,-          "name">: meta "Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ list $ meta "Type.Param",---       sparams: List[List[Data.Param]],-          "sparams">: list $ list $ meta "Data.Param",---       decltpe: scala.meta.Type,-          "decltpe">: meta "Type",---       body: Data-          "body">: meta "Data"],---   ) extends Defn---   @ast class ExtensionGroup(-      def "Defn.ExtensionGroup" $-        record [---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       paramss: List[List[Data.Param]],-          "parmss">: list $ list $ meta "Data.Param",---       body: Stat-          "body">: meta "Stat"],---   ) extends Defn---   @ast class Def(-      def "Defn.Def" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Data.Name,-          "name">: meta "Data.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       paramss: List[List[Data.Param]],-          "paramss">: list $ list $ meta "Data.Param",---       decltpe: Option[scala.meta.Type],-          "decltpe">: optional $ meta "Type",---       body: Data-          "body">: meta "Data"],---   ) extends Defn with Member.Data { @---     checkFields(paramss.forall(onlyLastParamCanBeRepeated))---   }---   @ast class Macro(-      def "Defn.Macro" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Data.Name,-          "name">: meta "Data.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       paramss: List[List[Data.Param]],-          "paramss">: list $ list $ meta "Data.Param",---       decltpe: Option[scala.meta.Type],-          "decltpe">: optional $ meta "Type",---       body: Data-          "body">: meta "Data"],---   ) extends Defn with Member.Data @---   @ast class Type(-      def "Defn.Type" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Type.Name,-          "name">: meta "Type.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       body: scala.meta.Type-          "body">: meta "Type"],---   ) extends Defn with Member.Type {---     @binaryCompatField("4.4.0")---     private var _bounds: scala.meta.Type.Bounds = scala.meta.Type.Bounds(None, None)---   }---   @ast class Class(-      def "Defn.Class" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Type.Name,-          "name">: meta "Type.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       ctor: Ctor.Primary,-          "ctor">: meta "Ctor.Primary",---       templ: Template-          "template">: meta "Template"],---   ) extends Defn with Member.Type---   @ast class Trait(-      def "Defn.Trait" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: scala.meta.Type.Name,-          "name">: meta "Type.Name",---       tparams: List[scala.meta.Type.Param],-          "tparams">: list $ meta "Type.Param",---       ctor: Ctor.Primary,-          "ctor">: meta "Ctor.Primary",---       templ: Template-          "template">: meta "Template"],---   ) extends Defn with Member.Type {---     checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor]))---   }---   @ast class Object(mods: List[Mod], name: Data.Name, templ: Template)-      def "Defn.Object" $-        record [-          "name">: meta "Data.Name"], --  from Member.Data---       extends Defn with Member.Data { @---     checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor]))---   }--- }------ @ast class Pkg(ref: Data.Ref, stats: List[Stat]) extends Member.Data with Stat { @-      def "Pkg" $-        record [-          "name">: meta "Data.Name", --  from Member.Data-          "ref">: meta "Data.Ref",-          "stats">: list $ meta "Stat"],---   checkFields(ref.isQualId)---   def name: Data.Name = ref match {---     case name: Data.Name => name---     case Data.Select(_, name: Data.Name) => name---   }--- }--- object Pkg {---   @ast class Object(mods: List[Mod], name: Data.Name, templ: Template)---       extends Member.Data with Stat { @-      def "Pkg.Object" $-        record [-          "mods">: list $ meta "Mod",-          "name">: meta "Data.Name",-          "template">: meta "Template"],---     checkFields(templ.is[Template.Quasi] || templ.stats.forall(!_.is[Ctor]))---   }--- }------ // NOTE: The names of Ctor.Primary and Ctor.Secondary here is always Name.Anonymous.--- // While seemingly useless, this name is crucial to one of the key principles behind the semantic API:--- // "every definition and every reference should carry a name".--- @branch trait Ctor extends Tree with Member-      def "Ctor" $-        union [-          "primary">: meta "Ctor.Primary",-          "secondary">: meta "Ctor.Secondary"],--- object Ctor {---   @ast class Primary(mods: List[Mod], name: Name, paramss: List[List[Data.Param]]) extends Ctor-      def "Ctor.Primary" $-        record [-          "mods">: list $ meta "Mod",-          "name">: meta "Name",-          "paramss">: list $ list $ meta "Data.Param"],---   @ast class Secondary(-      def "Ctor.Secondary" $-        record [---       mods: List[Mod],-          "mods">: list $ meta "Mod",---       name: Name,-          "name">: meta "Name",---       paramss: List[List[Data.Param]] @nonEmpty,-          "paramss">: list $ list $ meta "Data.Param",---       init: Init,-          "init">: meta "Init",---       stats: List[Stat]-          "stats">: list $ meta "Stat"],---   ) extends Ctor with Stat {---     checkFields(stats.forall(_.isBlockStat))---   }--- }------ // NOTE: The name here is always Name.Anonymous.--- // See comments to Ctor.Primary and Ctor.Secondary for justification.--- @ast class Init(tpe: Type, name: Name, argss: List[List[Data]]) extends Ref {-      def "Init" $-        record [-          "tpe">: meta "Type",-          "name">: meta "Name",-          "argss">: list $ list $ meta "Data"],---   checkFields(tpe.isConstructable)---   checkParent(ParentChecks.Init)--- }------ @ast class Self(name: Name, decltpe: Option[Type]) extends Member-      def "Self"-        unit,------ @ast class Template(-      def "Template" $-        record [---     early: List[Stat],-          "early">: list $ meta "Stat",---     inits: List[Init],-          "inits">: list $ meta "Init",---     self: Self,-          "self">: meta "Self",---     stats: List[Stat]-          "stats">: list $ meta "Stat"],--- ) extends Tree {---   @binaryCompatField("4.4.0")---   private var _derives: List[Type] = Nil---   checkFields(early.forall(_.isEarlyStat && inits.nonEmpty))---   checkFields(stats.forall(_.isTemplateStat))--- }------ @branch trait Mod extends Tree-      def "Mod" $-        union [-          "annot">: meta "Mod.Annot",-          "private">: meta "Mod.Private",-          "protected">: meta "Mod.Protected",-          "implicit">: unit,-          "final">: unit,-          "sealed">: unit,-          "open">: unit,-          "super">: unit,-          "override">: unit,-          "case">: unit,-          "abstract">: unit,-          "covariant">: unit,-          "contravariant">: unit,-          "lazy">: unit,-          "valParam">: unit,-          "varParam">: unit,-          "infix">: unit,-          "inline">: unit,-          "using">: unit,-          "opaque">: unit,-          "transparent">: unit],--- object Mod {---   @ast class Annot(init: Init) extends Mod {-      def "Mod.Annot" $-        record [-          "init">: meta "Init"],---     @deprecated("Use init instead", "1.9.0")---     def body = init---   }---   @ast class Private(within: Ref) extends Mod {-      def "Mod.Private" $-        record [-          "within">: meta "Ref"],---     checkFields(within.isWithin)---   }---   @ast class Protected(within: Ref) extends Mod {-      def "Mod.Protected" $-        record [-          "within">: meta "Ref"],---     checkFields(within.isWithin)---   }---   @ast class Implicit() extends Mod---   @ast class Final() extends Mod---   @ast class Sealed() extends Mod---   @ast class Open() extends Mod---   @deprecated("Super traits introduced in dotty, but later removed.")---   @ast class Super() extends Mod---   @ast class Override() extends Mod---   @ast class Case() extends Mod---   @ast class Abstract() extends Mod---   @ast class Covariant() extends Mod---   @ast class Contravariant() extends Mod---   @ast class Lazy() extends Mod---   @ast class ValParam() extends Mod---   @ast class VarParam() extends Mod---   @ast class Infix() extends Mod---   @ast class Inline() extends Mod---   @ast class Using() extends Mod---   @ast class Opaque() extends Mod---   @ast class Transparent() extends Mod--- }------ @branch trait Enumerator extends Tree-      def "Enumerator" $-        union [-          "generator">: meta "Enumerator.Generator",-          "caseGenerator">: meta "Enumerator.CaseGenerator",-          "val">: meta "Enumerator.Val",-          "guard">: meta "Enumerator.Guard"],--- object Enumerator {---   @ast class Generator(pat: Pat, rhs: Data) extends Enumerator-      def "Enumerator.Generator" $-        record [-          "pat">: meta "Pat",-          "rhs">: meta "Data"],---   @ast class CaseGenerator(pat: Pat, rhs: Data) extends Enumerator-      def "Enumerator.CaseGenerator" $-        record [-          "pat">: meta "Pat",-          "rhs">: meta "Data"],---   @ast class Val(pat: Pat, rhs: Data) extends Enumerator-      def "Enumerator.Val" $-        record [-          "pat">: meta "Pat",-          "rhs">: meta "Data"],---   @ast class Guard(cond: Data) extends Enumerator-      def "Enumerator.Guard" $-        record [-          "cond">: meta "Data"],--- }------ @branch trait ImportExportStat extends Stat {-      def "ImportExportStat" $-        union [-          "import">: meta "Import",-          "export">: meta "Export"],---   def importers: List[Importer]--- }--- @ast class Import(importers: List[Importer] @nonEmpty) extends ImportExportStat-      def "Import" $-        record [-          "importers">: list $ meta "Importer"],--- @ast class Export(importers: List[Importer] @nonEmpty) extends ImportExportStat-      def "Export" $-        record [-          "importers">: list $ meta "Importer"],------ @ast class Importer(ref: Data.Ref, importees: List[Importee] @nonEmpty) extends Tree {-      def "Importer" $-        record [-          "ref">: meta "Data.Ref",-          "importees">: list $ meta "Importee"],---   checkFields(ref.isStableId)--- }------ @branch trait Importee extends Tree with Ref-      def "Importee" $-        union [-          "wildcard">: unit,-          "given">: meta "Importee.Given",-          "givenAll">: unit,-          "name">: meta "Importee.Name",-          "rename">: meta "Importee.Rename",-          "unimport">: meta "Importee.Unimport"],--- object Importee {---   @ast class Wildcard() extends Importee---   @ast class Given(tpe: Type) extends Importee-      def "Importee.Given" $-        record [-          "tpe">: meta "Type"],---   @ast class GivenAll() extends Importee---   @ast class Name(name: scala.meta.Name) extends Importee {-      def "Importee.Name" $-        record [-          "name">: meta "Name"],---     checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate])---   }---   @ast class Rename(name: scala.meta.Name, rename: scala.meta.Name) extends Importee {-      def "Importee.Rename" $-        record [-          "name">: meta "Name",-          "rename">: meta "Name"],---     checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate])---     checkFields(rename.is[scala.meta.Name.Quasi] || rename.is[scala.meta.Name.Indeterminate])---   }---   @ast class Unimport(name: scala.meta.Name) extends Importee {-      def "Importee.Unimport" $-        record [-          "name">: meta "Name"],---     checkFields(name.is[scala.meta.Name.Quasi] || name.is[scala.meta.Name.Indeterminate])---   }--- }------ @branch trait CaseTree extends Tree {-      def "CaseTree" $-        union [-          "case">: meta "Case",-          "typeCase">: meta "TypeCase"],---   def pat: Tree---   def body: Tree--- }--- @ast class Case(pat: Pat, cond: Option[Data], body: Data) extends CaseTree-      def "Case" $-        record [-          "pat">: meta "Pat",-          "cond">: optional $ meta "Data",-          "body">: meta "Data"],--- @ast class TypeCase(pat: Type, body: Type) extends CaseTree-      def "TypeCase" $-        record [-          "pat">: meta "Type",-          "body">: meta "Type"],------ @ast class Source(stats: List[Stat]) extends Tree {-      def "Source" $-        record [-          "stats">: list $ meta "Stat"],---   // NOTE: This validation has been removed to allow dialects with top-level terms.---   // Ideally, we should push the validation into a dialect-specific prettyprinter when -- 220 is fixed.---   // checkFields(stats.forall(_.isTopLevelStat))--- }------ package internal.trees {---   // NOTE: Quasi is a base trait for a whole bunch of classes.---   // Every root, branch and ast trait/class among scala.meta trees (except for quasis themselves)---   // has a corresponding quasi, e.g. Data.Quasi or Type.Quasi.---   //---   // Here's how quasis represent unquotes---   // (XXX below depends on the position where the unquote occurs, e.g. q"$x" will result in Data.Quasi):---   //   * $x => XXX.Quasi(0, XXX.Name("x"))---   //   * ..$xs => XXX.Quasi(1, XXX.Quasi(0, XXX.Name("xs"))---   //   * ...$xss => XXX.Quasi(2, XXX.Quasi(0, XXX.Name("xss"))---   //   * ..{$fs($args)} => Complex ellipses aren't supported yet---   @branch trait Quasi extends Tree {-      def "Quasi" --  TODO-        unit]---     def rank: Int---     def tree: Tree---     def pt: Class[_]---     def become[T <: Quasi: AstInfo]: T---   }------   @registry object All--- }
− src/main/haskell/Hydra/Sources/Tier4/Ext/Shacl/Model.hs 
@@ -1,273 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Shacl.Model where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Sources.Tier4.Ext.Rdf.Syntax-import Hydra.Dsl.Types as Types---shaclModelModule :: Module-shaclModelModule = Module ns elements [rdfSyntaxModule] tier0Modules $-    Just "A SHACL syntax model. See https://www.w3.org/TR/shacl"-  where-    ns = Namespace "hydra/ext/org/w3/shacl/model"-    def = datatype ns-    shacl = typeref ns-    rdf = typeref $ moduleNamespace rdfSyntaxModule--    elements = [--      def "Closed" $-        see "https://www.w3.org/TR/shacl/#ClosedPatterConstraintComponent" $-        record [-          "isClosed">: boolean,-          "ignoredProperties">: optional $ set $ rdf "Property"],--      def "CommonConstraint" $-        doc "Any of a number of constraint parameters which can be applied either to node or property shapes" $-        union [-          "and">:-            see "https://www.w3.org/TR/shacl/#AndConstraintComponent" $-            set $ shacl "Reference" @@ shacl "Shape",--          "closed">:-            see "https://www.w3.org/TR/shacl/#ClosedConstraintComponent" $-            shacl "Closed",--          "class">:-            see "https://www.w3.org/TR/shacl/#ClassConstraintComponent" $-            set $ rdf "RdfsClass",--          "datatype">:-            see "https://www.w3.org/TR/shacl/#DatatypeConstraintComponent" $-            rdf "Iri",--          "disjoint">:-            see "https://www.w3.org/TR/shacl/#DisjointConstraintComponent" $-            set $ rdf "Property",--          "equals">:-            see "https://www.w3.org/TR/shacl/#EqualsConstraintComponent" $-            set $ rdf "Property",--          "hasValue">:-            doc ("Specifies the condition that at least one value node is equal to the given RDF term. " ++-                 "See https://www.w3.org/TR/shacl/#HasValueConstraintComponent") $-            set $ rdf "Node",--          "in">:-            doc ("Specifies the condition that each value node is a member of a provided SHACL list. " ++-                 "See https://www.w3.org/TR/shacl/#InConstraintComponent") $-            list $ rdf "Node",--          "languageIn">:-            see "https://www.w3.org/TR/shacl/#LanguageInConstraintComponent" $-            set $ rdf "LanguageTag",--          "nodeKind">:-            see "https://www.w3.org/TR/shacl/#NodeKindConstraintComponent" $-            shacl "NodeKind",--          "node">:-            see "https://www.w3.org/TR/shacl/#NodeConstraintComponent" $-            set $ shacl "Reference" @@ shacl "NodeShape",--          "not">:-            see "https://www.w3.org/TR/shacl/#NotConstraintComponent" $-            set $ shacl "Reference" @@ shacl "Shape",--          "maxExclusive">:-            see "https://www.w3.org/TR/shacl/#MaxExclusiveConstraintComponent" $-            rdf "Literal",--          "maxInclusive">:-            see "https://www.w3.org/TR/shacl/#MaxInclusiveConstraintComponent" $-            rdf "Literal",--          "maxLength">:-            see "https://www.w3.org/TR/shacl/#MaxLengthConstraintComponent" $-            bigint,--          "minExclusive">:-            see "https://www.w3.org/TR/shacl/#MinExclusiveConstraintComponent" $-            rdf "Literal",--          "minInclusive">:-            see "https://www.w3.org/TR/shacl/#MinInclusiveConstraintComponent" $-            rdf "Literal",--          "minLength">:-            see "https://www.w3.org/TR/shacl/#MinLengthConstraintComponent" $-            bigint,--          "pattern">:-            see "https://www.w3.org/TR/shacl/#PatternConstraintComponent" $-            shacl "Pattern",--          "property">:-            see "https://www.w3.org/TR/shacl/#PropertyConstraintComponent" $-            set $ shacl "Reference" @@ shacl "PropertyShape",--          "or">:-            see "https://www.w3.org/TR/shacl/#OrConstraintComponent" $-            set $ shacl "Reference" @@ shacl "Shape",--          "xone">:-            see "https://www.w3.org/TR/shacl/#XoneConstraintComponent" $-            set $ shacl "Reference" @@ shacl "Shape"],--      def "CommonProperties" $-        doc "Common constraint parameters and other properties for SHACL shapes" $-        record [-          "constraints">:-            doc "Common constraint parameters attached to this shape"-            $ set $ shacl "CommonConstraint",--          "deactivated">:-            see "https://www.w3.org/TR/shacl/#deactivated" $-            optional boolean,--          "message">:-            see "https://www.w3.org/TR/shacl/#message" $-            rdf "LangStrings",--          "severity">:-            see "https://www.w3.org/TR/shacl/#severity" $-            shacl "Severity",--          "targetClass">:-            see "https://www.w3.org/TR/shacl/#targetClass" $-            set $ rdf "RdfsClass",--          "targetNode">:-            see "https://www.w3.org/TR/shacl/#targetNode" $-            set $ rdf "IriOrLiteral",--          "targetObjectsOf">:-            see "https://www.w3.org/TR/shacl/#targetObjectsOf" $-            set $ rdf "Property",--          "targetSubjectsOf">:-            see "https://www.w3.org/TR/shacl/#targetSubjectsOf" $-            set $ rdf "Property"],--      def "Definition" $-        doc "An instance of a type like sh:Shape or sh:NodeShape, together with a unique IRI for that instance" $-        lambda "a" $ record [-          "iri">: rdf "Iri",-          "target">: "a"],--      def "NodeKind" $ union [-        "blankNode">: doc "A blank node" unit,-        "iri">: doc "An IRI" unit,-        "literal">: doc "A literal" unit,-        "blankNodeOrIri">: doc "A blank node or an IRI" unit,-        "blankNodeOrLiteral">: doc "A blank node or a literal" unit,-        "iriOrLiteral">: doc "An IRI or a literal" unit],--      def "NodeShape" $-        doc "A SHACL node shape. See https://www.w3.org/TR/shacl/#node-shapes" $-        record [-          "common">: shacl "CommonProperties"],--      def "Pattern" $-        doc "A SHACL pattern. See https://www.w3.org/TR/shacl/#PatternConstraintComponent" $-        record [-          "regex">: string,-          "flags">: optional string],--      def "PropertyShape" $-        doc "A SHACL property shape. See https://www.w3.org/TR/shacl/#property-shapes" $-        record [-          "common">: shacl "CommonProperties",--          "constraints">:-            doc "Any property shape -specific constraint parameters" $-            set $ shacl "PropertyShapeConstraint",--          "defaultValue">:-            see "https://www.w3.org/TR/shacl/#defaultValue" $-            optional $ rdf "Node",--          "description">:-            see "https://www.w3.org/TR/shacl/#name" $-            rdf "LangStrings",--          "name">:-            see "https://www.w3.org/TR/shacl/#name" $-            rdf "LangStrings",--          "order">:-            see "https://www.w3.org/TR/shacl/#order" $-            optional bigint,--          "path">: rdf "Iri"], -- TODO-          -- Note: sh:group is omitted for now, for lack of a clear definition of PropertyGroup--      def "PropertyShapeConstraint" $-        doc "A number of constraint parameters which are specific to property shapes, and cannot be applied to node shapes" $-        union [--          "lessThan">:-            see "https://www.w3.org/TR/shacl/#LessThanConstraintComponent" $-            set $ rdf "Property",--          "lessThanOrEquals">:-            see "https://www.w3.org/TR/shacl/#LessThanOrEqualsConstraintComponent" $-            set $ rdf "Property",--          "maxCount">:-            doc ("The maximum cardinality. Node shapes cannot have any value for sh:maxCount. " ++-                 "See https://www.w3.org/TR/shacl/#MaxCountConstraintComponent") $-            bigint,--          "minCount">:-            doc ("The minimum cardinality. Node shapes cannot have any value for sh:minCount. " ++-                 "See https://www.w3.org/TR/shacl/#MinCountConstraintComponent") $-            bigint,--          "uniqueLang">:-            see "https://www.w3.org/TR/shacl/#UniqueLangConstraintComponent" $-            boolean,--          "qualifiedValueShape">:-            see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $-            shacl "QualifiedValueShape"],--      def "QualifiedValueShape" $-        see "https://www.w3.org/TR/shacl/#QualifiedValueShapeConstraintComponent" $-        record [-          "qualifiedValueShape">: shacl "Reference" @@ shacl "Shape",-          "qualifiedMaxCount">: bigint,-          "qualifiedMinCount">: bigint,-          "qualifiedValueShapesDisjoint">: optional boolean],--      def "Reference" $-        doc "Either an instance of a type like sh:Shape or sh:NodeShape, or an IRI which refers to an instance of that type" $-        lambda "a" $ union [-          "named">: rdf "Iri",-          "anonymous">:-            doc "An anonymous instance"-            "a",-          "definition">:-            doc "An inline definition" $-            shacl "Definition" @@ "a"],--      def "Severity" $ union [-        "info">: doc "A non-critical constraint violation indicating an informative message" unit,-        "warning">: doc "A non-critical constraint violation indicating a warning" unit,-        "violation">: doc "A constraint violation" unit],--      def "Shape" $-        doc "A SHACL node or property shape. See https://www.w3.org/TR/shacl/#shapes" $-        union [-          "node">: shacl "NodeShape",-          "property">: shacl "PropertyShape"],--      def "ShapesGraph" $-        doc ("An RDF graph containing zero or more shapes that is passed into a SHACL validation process " ++-             "so that a data graph can be validated against the shapes") $-        set $ shacl "Definition" @@ shacl "Shape"]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Tabular.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Sources.Tier4.Ext.Tabular where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---tabularModule :: Module-tabularModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A simple, untyped tabular data model, suitable for CSVs and TSVs")-  where-    ns = Namespace "hydra/ext/tabular"-    def = datatype ns-    tabular = typeref ns--    elements = [-      def "DataRow" $-        doc "A data row, containing optional-valued cells; one per column" $-        lambda "v" $-          list $ optional "v",--      def "HeaderRow" $-        doc "A header row, containing column names (but no types or data)" $-        list string,--      def "Table" $-        doc "A simple table as in a CSV file, having an optional header row and any number of data rows" $-        lambda "v" $ record [-          "header">:-            doc "The optional header row of the table. If present, the header must have the same number of cells as each data row." $-            optional $ tabular "HeaderRow",-          "data">:-            doc "The data rows of the table. Each row must have the same number of cells." $-            list (tabular "DataRow" @@ "v")]]
− src/main/haskell/Hydra/Sources/Tier4/Ext/Yaml/Model.hs 
@@ -1,76 +0,0 @@-module Hydra.Sources.Tier4.Ext.Yaml.Model where--import Hydra.Sources.Tier3.All-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap-import Hydra.Dsl.Types as Types---yamlModelModule :: Module-yamlModelModule = Module ns elements [hydraCoreModule] tier0Modules $-    Just ("A basic YAML representation model. Based on:\n" ++-      "  https://yaml.org/spec/1.2/spec.html\n" ++-      "The Serialization and Presentation properties of YAML,\n" ++-      "including directives, comments, anchors, style, formatting, and aliases, are not supported by this model.\n" ++-      "In addition, tags are omitted from this model, and non-standard scalars are unsupported.")-  where-    ns = Namespace "hydra/ext/org/yaml/model"-    def = datatype ns-    model = typeref ns--    elements = [-      {--      Every YAML node has an optional scalar tag or non-specific tag (omitted from this model)-      -}-      def "Node" $-        doc "A YAML node (value)" $-        union [-          "mapping">: Types.map (model "Node") (model "Node"), -- Failsafe schema: tag:yaml.org,2002:map-          "scalar">: model "Scalar",-          "sequence">: list $ model "Node"], -- Failsafe schema: tag:yaml.org,2002:seq--      def "Scalar" $-        doc "A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here" $-        union [-          {--          Represents a true/false value--          JSON schema: tag:yaml.org,2002:bool-          -}-          "bool">:-            doc "Represents a true/false value"-            boolean,-          {--          Represents an approximation to real numbers--          JSON schema: tag:yaml.org,2002:float--          In addition to arbitrary-precision floating-point numbers in scientific notation,-          YAML allows for three special values, which are not supported here:-          positive and negative infinity (.inf and -.inf), and "not a number (.nan)-          -}-          "float">:-            doc "Represents an approximation to real numbers"-            bigfloat,-          {--          Represents arbitrary sized finite mathematical integers--          JSON schema: tag:yaml.org,2002:int-          -}-          "int">:-            doc "Represents arbitrary sized finite mathematical integers"-            bigint,-          {--          Represents the lack of a value--          JSON schema: tag:yaml.org,2002:null-          -}-          "null">:-            doc "Represents the lack of a value"-            unit,-          {--          Failsafe schema: tag:yaml.org,2002:str-          -}-          "str">:-            doc "A string value"-            string]]
− src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Lists.hs 
@@ -1,80 +0,0 @@-module Hydra.Sources.Tier4.Test.Lib.Lists (listPrimitiveTests) where--import Hydra.Dsl.Tests-import Hydra.Dsl.Terms---listPrimitiveTests :: TestGroup-listPrimitiveTests = TestGroup "hydra/lib/lists primitives" Nothing groups []-  where-    groups = [-      listsApply,-      listsBind,-      listsConcat,-      listsHead,-      listsIntercalate,-      listsIntersperse,-      listsLast,-      listsLength,-      listsMap,-      listsPure]--listsApply :: TestGroup-listsApply = TestGroup "apply" Nothing [] [-    test [primitive _strings_toUpper, primitive _strings_toLower] ["One", "Two", "Three"] ["ONE", "TWO", "THREE", "one", "two", "three"]]-  where-    test funs lst result = primCase _lists_apply [list funs, stringList lst] (stringList result)--listsBind :: TestGroup-listsBind = TestGroup "bind" Nothing [] [-    test [1, 2, 3, 4] (primitive _lists_pure <.> primitive _math_neg) (negate <$> [1, 2, 3, 4])]-  where-    test lst fun result = primCase _lists_bind [intList lst, fun] (intList result)--listsConcat :: TestGroup-listsConcat = TestGroup "concat" Nothing [] [-    test [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 4, 5, 6, 7, 8]]-  where-    test lists result = primCase _lists_concat [intListList lists] (intList result)--listsHead :: TestGroup-listsHead = TestGroup "head" Nothing [] [-    test [1, 2, 3] 1]-  where-    test lst result = primCase _lists_head [intList lst] (int32 result)--listsIntercalate :: TestGroup-listsIntercalate = TestGroup "intercalate" Nothing [] [-    test [0, 0] [[1, 2, 3], [4, 5], [6, 7, 8]] [1, 2, 3, 0, 0, 4, 5, 0, 0, 6, 7, 8]]-  where-    test ifx lists result = primCase _lists_intercalate [intList ifx, intListList lists] (intList result)--listsIntersperse :: TestGroup-listsIntersperse = TestGroup "intersperse" Nothing [] [-    test "and" ["one", "two", "three"] ["one", "and", "two", "and", "three"]]-  where-    test ifx lst result = primCase _lists_intersperse [string ifx, stringList lst] (stringList result)--listsLast :: TestGroup-listsLast = TestGroup "last" Nothing [] [-    test [1, 2, 3] 3]-  where-    test lst result = primCase _lists_last [intList lst] (int32 result)--listsLength :: TestGroup-listsLength = TestGroup "length" Nothing [] [-    test [1, 2, 3] 3]-  where-    test lst result = primCase _lists_length [intList lst] (int32 result)--listsMap :: TestGroup-listsMap = TestGroup "map" Nothing [] [-    test (primitive _strings_toUpper) ["one", "two"] ["ONE", "TWO"]]-  where-    test fun lst result = primCase _lists_map [fun, stringList lst] (stringList result)--listsPure :: TestGroup-listsPure = TestGroup "pure" Nothing [] [-    test "one"]-  where-    test arg = primCase _lists_pure [string arg] (stringList [arg])
− src/main/haskell/Hydra/Sources/Tier4/Test/Lib/Strings.hs 
@@ -1,58 +0,0 @@-module Hydra.Sources.Tier4.Test.Lib.Strings (stringPrimitiveTests) where--import Hydra.Dsl.Tests---stringPrimitiveTests :: TestGroup-stringPrimitiveTests = TestGroup "hydra/lib/strings primitives" Nothing groups []-  where-    groups = [stringsCat, stringsLength, stringsSplitOn, stringsToLower, stringsToUpper]--stringsCat :: TestGroup-stringsCat = TestGroup "cat" Nothing [] [-    test ["one", "two", "three"] "onetwothree",-    test ["", "one", "", ""] "one",-    test [] ""]-  where-    test ls result = primCase _strings_cat [list (string <$> ls)] (string result)--stringsLength :: TestGroup-stringsLength = TestGroup "length" Nothing [] [-    test "" 0,-    test "a" 1,-    test "one" 3]-  where-    test s result = primCase _strings_length [string s] (int32 result)--stringsSplitOn :: TestGroup-stringsSplitOn = TestGroup "splitOn" Nothing [] [-    test "ss" "Mississippi" ["Mi", "i", "ippi"],-    test "Mississippi" "Mississippi" ["", ""],--    test " " "one two three" ["one", "two", "three"],-    test " " " one two three " ["", "one", "two", "three", ""],-    test " " "  one two three" ["", "", "one", "two", "three"],-    test "  " "  one two three" ["", "one two three"],--    test "aa" "aaa" ["", "a"],--    test "a" "" [""],--    test "" "abc" ["", "a", "b", "c"],-    test "" "" [""]]-  where-    test s0 s1 result = primCase _strings_splitOn [string s0, string s1] (list (string <$> result))--stringsToLower :: TestGroup-stringsToLower = TestGroup "toLower" Nothing [] [-    test "One TWO threE" "one two three",-    test "Abc123" "abc123"]-  where-    test s result = primCase _strings_toLower [string s] (string result)--stringsToUpper :: TestGroup-stringsToUpper = TestGroup "toUpper" Nothing [] [-    test "One TWO threE" "ONE TWO THREE",-    test "Abc123" "ABC123"]-  where-    test s result = primCase _strings_toUpper [string s] (string result)
− src/main/haskell/Hydra/Sources/Tier4/Test/TestSuite.hs 
@@ -1,44 +0,0 @@-module Hydra.Sources.Tier4.Test.TestSuite (testSuiteModule) where--import Hydra.Testing-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types-import Hydra.Sources.Tier3.All--import Hydra.Sources.Tier4.Test.Lib.Lists-import Hydra.Sources.Tier4.Test.Lib.Strings---testSuiteNs = Namespace "hydra/test/testSuite"--testSuiteModule :: Module-testSuiteModule = Module testSuiteNs elements [] tier0Modules $-    Just "Test cases for primitive functions"-  where-    elements = [-      groupElement "allTests" allTests]--groupElement :: String -> TestGroup -> Element-groupElement lname group = Element name $ setTermType (Just typ) $ encodeGroup group-  where-    encodeGroup (TestGroup name desc groups cases) = Terms.record _TestGroup [-      Field _TestGroup_name $ Terms.string name,-      Field _TestGroup_description $ Terms.optional (Terms.string <$> desc),-      Field _TestGroup_subgroups $ Terms.list (encodeGroup <$> groups),-      Field _TestGroup_cases $ Terms.list (encodeCase <$> cases)]-    encodeCase (TestCase desc style input output) = Terms.record _TestCase [-      Field _TestCase_description $ Terms.optional (Terms.string <$> desc),-      Field _TestCase_evaluationStyle $ Terms.variant _EvaluationStyle (case style of-        EvaluationStyleEager -> _EvaluationStyle_eager-        EvaluationStyleLazy -> _EvaluationStyle_lazy) Terms.unit,-      Field _TestCase_input $ coreEncodeTerm input,-      Field _TestCase_output $ coreEncodeTerm output]-    name = unqualifyName $ QualifiedName (Just testSuiteNs) lname-    typ = TypeVariable _TestGroup--allTests :: TestGroup-allTests = TestGroup "All tests" Nothing primTests []-  where-    primTests = [-      listPrimitiveTests,-      stringPrimitiveTests]
+ src/main/haskell/Hydra/Sources/Yaml/Model.hs view
@@ -0,0 +1,96 @@+module Hydra.Sources.Yaml.Model where++import Hydra.Kernel+import Hydra.Dsl.Annotations+import Hydra.Dsl.Bootstrap+import Hydra.Dsl.Types as Types++import qualified Hydra.Sources.Kernel.Types.Accessors   as Accessors+import qualified Hydra.Sources.Kernel.Types.Ast         as Ast+import qualified Hydra.Sources.Kernel.Types.Coders      as Coders+import qualified Hydra.Sources.Kernel.Types.Compute     as Compute+import qualified Hydra.Sources.Kernel.Types.Constraints as Constraints+import qualified Hydra.Sources.Kernel.Types.Core        as Core+import qualified Hydra.Sources.Kernel.Types.Grammar     as Grammar+import qualified Hydra.Sources.Kernel.Types.Graph       as Graph+import qualified Hydra.Sources.Kernel.Types.Json        as Json+import qualified Hydra.Sources.Kernel.Types.Mantle      as Mantle+import qualified Hydra.Sources.Kernel.Types.Module      as Module+import qualified Hydra.Sources.Kernel.Types.Phantoms    as Phantoms+import qualified Hydra.Sources.Kernel.Types.Relational  as Relational+import qualified Hydra.Sources.Kernel.Types.Query       as Query+import qualified Hydra.Sources.Kernel.Types.Tabular     as Tabular+import qualified Hydra.Sources.Kernel.Types.Testing     as Testing+import qualified Hydra.Sources.Kernel.Types.Topology    as Topology+import qualified Hydra.Sources.Kernel.Types.Typing      as Typing+import qualified Hydra.Sources.Kernel.Types.Workflow    as Workflow+++yamlModelModule :: Module+yamlModelModule = Module ns elements [Core.module_] [Core.module_] $+    Just ("A basic YAML representation model. Based on:\n" +++      "  https://yaml.org/spec/1.2/spec.html\n" +++      "The Serialization and Presentation properties of YAML,\n" +++      "including directives, comments, anchors, style, formatting, and aliases, are not supported by this model.\n" +++      "In addition, tags are omitted from this model, and non-standard scalars are unsupported.")+  where+    ns = Namespace "hydra.ext.org.yaml.model"+    def = datatype ns+    model = typeref ns++    elements = [+      {-+      Every YAML node has an optional scalar tag or non-specific tag (omitted from this model)+      -}+      def "Node" $+        doc "A YAML node (value)" $+        union [+          "mapping">: Types.map (model "Node") (model "Node"), -- Failsafe schema: tag:yaml.org,2002:map+          "scalar">: model "Scalar",+          "sequence">: list $ model "Node"], -- Failsafe schema: tag:yaml.org,2002:seq++      def "Scalar" $+        doc "A union of scalars supported in the YAML failsafe and JSON schemas. Other scalars are not supported here" $+        union [+          {-+          Represents a true/false value++          JSON schema: tag:yaml.org,2002:bool+          -}+          "bool">:+            doc "Represents a true/false value"+            boolean,+          {-+          Represents an approximation to real numbers++          JSON schema: tag:yaml.org,2002:float++          In addition to arbitrary-precision floating-point numbers in scientific notation,+          YAML allows for three special values, which are not supported here:+          positive and negative infinity (.inf and -.inf), and "not a number (.nan)+          -}+          "float">:+            doc "Represents an approximation to real numbers"+            bigfloat,+          {-+          Represents arbitrary sized finite mathematical integers++          JSON schema: tag:yaml.org,2002:int+          -}+          "int">:+            doc "Represents arbitrary sized finite mathematical integers"+            bigint,+          {-+          Represents the lack of a value++          JSON schema: tag:yaml.org,2002:null+          -}+          "null">:+            doc "Represents the lack of a value"+            unit,+          {-+          Failsafe schema: tag:yaml.org,2002:str+          -}+          "str">:+            doc "A string value"+            string]]
+ src/main/haskell/Hydra/Staging/Json/Serde.hs view
@@ -0,0 +1,84 @@+module Hydra.Staging.Json.Serde where++import Hydra.Tools.Monads+import qualified Hydra.Compute as Compute+import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Monads as Monads+import qualified Hydra.Ext.Org.Json.Coder as JsonCoder+import qualified Hydra.Tools.Bytestrings as Bytestrings+import qualified Hydra.Json as Json++import qualified Data.ByteString.Lazy as BS+import qualified Control.Monad as CM+import qualified Data.Aeson as A+import qualified Data.Aeson.KeyMap as AKM+import qualified Data.Aeson.Key as AK+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified Data.Scientific as SC+import qualified Data.Char as C+import qualified Data.String as String+++aesonValueToBytes :: A.Value -> BS.ByteString+aesonValueToBytes = A.encode++aesonValueToJsonValue :: A.Value -> Json.Value+aesonValueToJsonValue v = case v of+  A.Object km -> Json.ValueObject $ M.fromList (mapPair <$> AKM.toList km)+    where+      mapPair (k, v) = (AK.toString k, aesonValueToJsonValue v)+  A.Array a -> Json.ValueArray (aesonValueToJsonValue <$> V.toList a)+  A.String t -> Json.ValueString $ T.unpack t+  A.Number s -> Json.ValueNumber $ SC.toRealFloat s+  A.Bool b -> Json.ValueBoolean b+  A.Null -> Json.ValueNull++bytesToAesonValue :: BS.ByteString -> Either String A.Value+bytesToAesonValue = A.eitherDecode++bytesToJsonValue :: BS.ByteString -> Either String Json.Value+bytesToJsonValue bs = aesonValueToJsonValue <$> bytesToAesonValue bs++jsonByteStringCoder :: Core.Type -> Compute.Flow Graph.Graph (Compute.Coder Graph.Graph Graph.Graph Core.Term BS.ByteString)+jsonByteStringCoder typ = do+  coder <- JsonCoder.jsonCoder typ+  return Compute.Coder {+    Compute.coderEncode = fmap jsonValueToBytes . Compute.coderEncode coder,+    Compute.coderDecode = \bs -> case bytesToJsonValue bs of+        Left msg -> Monads.fail $ "JSON parsing failed: " ++ msg+        Right v -> Compute.coderDecode coder v}++-- | A convenience which maps typed terms to and from pretty-printed JSON strings, as opposed to JSON objects+jsonStringCoder :: Core.Type -> Compute.Flow Graph.Graph (Compute.Coder Graph.Graph Graph.Graph Core.Term String)+jsonStringCoder typ = do+  serde <- jsonByteStringCoder typ+  return Compute.Coder {+    Compute.coderEncode = fmap Bytestrings.bytesToString . Compute.coderEncode serde,+    Compute.coderDecode = Compute.coderDecode serde . Bytestrings.stringToBytes}++jsonValueToAesonValue :: Json.Value -> A.Value+jsonValueToAesonValue v = case v of+    Json.ValueArray l -> A.Array $ V.fromList (jsonValueToAesonValue <$> l)+    Json.ValueBoolean b -> A.Bool b+    Json.ValueNull -> A.Null+    Json.ValueNumber d -> A.Number $ SC.fromFloatDigits d+    Json.ValueObject m -> A.Object $ AKM.fromList (mapPair <$> M.toList m)+      where+        mapPair (k, v) = (AK.fromString k, jsonValueToAesonValue v)+    Json.ValueString s -> A.String $ T.pack s++jsonValueToBytes :: Json.Value -> BS.ByteString+jsonValueToBytes = aesonValueToBytes . jsonValueToAesonValue++jsonValueToString :: Json.Value -> String+jsonValueToString = Bytestrings.bytesToString . jsonValueToBytes++jsonValuesToString :: [Json.Value] -> String+jsonValuesToString = L.intercalate "\n" . fmap jsonValueToString++stringToJsonValue :: String -> Either String Json.Value+stringToJsonValue = bytesToJsonValue . Bytestrings.stringToBytes
+ src/main/haskell/Hydra/Staging/Yaml/Coder.hs view
@@ -0,0 +1,127 @@+module Hydra.Staging.Yaml.Coder (yamlCoder) where++import Hydra.Kernel+import Hydra.Adapt.Terms+import Hydra.Staging.Yaml.Language+import Hydra.Adapt.Utils+import qualified Hydra.Ext.Org.Yaml.Model as YM+import qualified Hydra.Dsl.Terms as Terms++import qualified Control.Monad as CM+import qualified Data.Map as M+import qualified Data.Maybe as Y+++literalCoder :: LiteralType -> Flow Graph (Coder Graph Graph Literal YM.Scalar)+literalCoder at = pure $ case at of+  LiteralTypeBoolean -> Coder {+    coderEncode = \(LiteralBoolean b) -> pure $ YM.ScalarBool b,+    coderDecode = \s -> case s of+      YM.ScalarBool b -> pure $ LiteralBoolean b+      _ -> unexpected "boolean" $ show s}+  LiteralTypeFloat _ -> Coder {+    coderEncode = \(LiteralFloat (FloatValueBigfloat f)) -> pure $ YM.ScalarFloat f,+    coderDecode = \s -> case s of+      YM.ScalarFloat f -> pure $ LiteralFloat $ FloatValueBigfloat f+      _ -> unexpected "floating-point value" $ show s}+  LiteralTypeInteger _ -> Coder {+    coderEncode = \(LiteralInteger (IntegerValueBigint i)) -> pure $ YM.ScalarInt i,+    coderDecode = \s -> case s of+      YM.ScalarInt i -> pure $ LiteralInteger $ IntegerValueBigint i+      _ -> unexpected "integer" $ show s}+  LiteralTypeString -> Coder {+    coderEncode = \(LiteralString s) -> pure $ YM.ScalarStr s,+    coderDecode = \s -> case s of+      YM.ScalarStr s' -> pure $ LiteralString s'+      _ -> unexpected "string" $ show s}++recordCoder :: RowType -> Flow Graph (Coder Graph Graph Term YM.Node)+recordCoder rt = do+    coders <- CM.mapM (\f -> (,) <$> pure f <*> termCoder (fieldTypeType f)) (rowTypeFields rt)+    return $ Coder (encode coders) (decode coders)+  where+    encode coders term = case deannotateTerm term of+      TermRecord (Record _ fields) -> YM.NodeMapping . M.fromList . Y.catMaybes <$> CM.zipWithM encodeField coders fields+        where+          encodeField (ft, coder) (Field (Name fn) fv) = case (fieldTypeType ft, fv) of+            (TypeOptional _, TermOptional Nothing) -> pure Nothing+            _ -> Just <$> ((,) <$> pure (yamlString fn) <*> coderEncode coder fv)+      _ -> unexpected "record" $ show term+    decode coders n = case n of+      YM.NodeMapping m -> Terms.record (rowTypeTypeName rt) <$>+          CM.mapM (decodeField m) coders -- Note: unknown fields are ignored+        where+          decodeField a (FieldType fname@(Name fn) ft, coder) = do+            v <- coderDecode coder $ Y.fromMaybe yamlNull $ M.lookup (yamlString fn) m+            return $ Field fname v+      _ -> unexpected "mapping" $ show n+    getCoder coders fname = Y.maybe error pure $ M.lookup fname coders+      where+        error = fail $ "no such field: " ++ fname++termCoder :: Type -> Flow Graph (Coder Graph Graph Term YM.Node)+termCoder typ = case deannotateType typ of+  TypeLiteral at -> do+    ac <- literalCoder at+    return Coder {+      coderEncode = \t -> case t of+         TermLiteral av -> YM.NodeScalar <$> coderEncode ac av+         _ -> unexpected "literal" $ show t,+      coderDecode = \n -> case n of+        YM.NodeScalar s -> Terms.literal <$> coderDecode ac s+        _ -> unexpected "scalar node" $ show n}+  TypeList lt -> do+    lc <- termCoder lt+    return Coder {+      coderEncode = \t -> case t of+         TermList els -> YM.NodeSequence <$> CM.mapM (coderEncode lc) els+         _ -> unexpected "list" $ show t,+      coderDecode = \n -> case n of+        YM.NodeSequence nodes -> Terms.list <$> CM.mapM (coderDecode lc) nodes+        _ -> unexpected "sequence" $ show n}+  TypeOptional ot -> do+    oc <- termCoder ot+    return Coder {+      coderEncode = \t -> case t of+         TermOptional el -> Y.maybe (pure yamlNull) (coderEncode oc) el+         _ -> unexpected "optional" $ show t,+      coderDecode = \n -> case n of+        YM.NodeScalar YM.ScalarNull -> pure $ Terms.optional Nothing+        _ -> Terms.optional . Just <$> coderDecode oc n}+  TypeMap (MapType kt vt) -> do+    kc <- termCoder kt+    vc <- termCoder vt+    let encodeEntry (k, v) = (,) <$> coderEncode kc k <*> coderEncode vc v+    let decodeEntry (k, v) = (,) <$> coderDecode kc k <*> coderDecode vc v+    return Coder {+      coderEncode = \t -> case t of+        TermMap m -> YM.NodeMapping . M.fromList <$> CM.mapM encodeEntry (M.toList m)+        _ -> unexpected "term" $ show t,+      coderDecode = \n -> case n of+        YM.NodeMapping m -> Terms.map . M.fromList <$> CM.mapM decodeEntry (M.toList m)+        _ -> unexpected "mapping" $ show n}+  TypeRecord rt -> recordCoder rt+  TypeUnit -> pure unitCoder+  _ -> fail $ "unsupported type variant: " ++ show (typeVariant typ)++unitCoder :: Coder Graph Graph Term YM.Node+unitCoder = Coder encode decode+  where+    encode term = case deannotateTerm term of+      TermUnit -> pure $ YM.NodeScalar $ YM.ScalarNull+      _ -> unexpected "unit" $ show term+    decode n = case n of+      (YM.NodeScalar YM.ScalarNull) -> pure Terms.unit+      _ -> unexpected "null" $ show n++yamlCoder :: Type -> Flow Graph (Coder Graph Graph Term YM.Node)+yamlCoder typ = do+  adapter <- languageAdapter yamlLanguage typ+  coder <- termCoder $ adapterTarget adapter+  return $ composeCoders (adapterCoder adapter) coder++yamlNull :: YM.Node+yamlNull = YM.NodeScalar YM.ScalarNull++yamlString :: String -> YM.Node+yamlString = YM.NodeScalar . YM.ScalarStr
+ src/main/haskell/Hydra/Staging/Yaml/Language.hs view
@@ -0,0 +1,34 @@+module Hydra.Staging.Yaml.Language where++import Hydra.Kernel++import qualified Data.Set as S+++yamlLanguage :: Language+yamlLanguage = Language (LanguageName "hydra.ext.yaml") $ LanguageConstraints {+  languageConstraintsEliminationVariants = S.empty,+  languageConstraintsLiteralVariants = S.fromList [+    LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],+  languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],+  languageConstraintsFunctionVariants = S.empty,+  languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],+  languageConstraintsTermVariants = S.fromList [+    TermVariantLiteral,+    TermVariantList,+    TermVariantMap,+    TermVariantOptional,+    TermVariantRecord,+    TermVariantUnit],+    -- Note: TermVariantUnit is excluded because YAML null is used for optionals+  languageConstraintsTypeVariants = S.fromList [+    TypeVariantLiteral,+    TypeVariantList,+    TypeVariantMap,+    TypeVariantOptional,+    TypeVariantRecord,+    TypeVariantUnit],+    -- Note: TypeVariantUnit is excluded because YAML null is used for optionals+  languageConstraintsTypes = \typ -> case deannotateType typ of+    TypeOptional (TypeOptional _) -> False+    _ -> True }
+ src/main/haskell/Hydra/Staging/Yaml/Modules.hs view
@@ -0,0 +1,39 @@+module Hydra.Staging.Yaml.Modules (moduleToYaml) where++import Hydra.Kernel+import Hydra.Adapt.Modules+import Hydra.Staging.Yaml.Serde+import Hydra.Staging.Yaml.Language+import qualified Hydra.Ext.Org.Yaml.Model as YM+import qualified Hydra.Dsl.Types as Types++import qualified Control.Monad as CM+import qualified Data.List as L+import qualified Data.Map as M+++constructModule ::+  Module+  -> M.Map (Type) (Coder Graph Graph Term YM.Node)+  -> [(Binding, TypedTerm)]+  -> Flow Graph YM.Node+constructModule mod coders pairs = do+    keyvals <- withTrace "encoding terms" (CM.mapM toYaml pairs)+    return $ YM.NodeMapping $ M.fromList keyvals+  where+    toYaml (el, (TypedTerm term typ)) = withTrace ("element " ++ unName (bindingName el)) $ do+      encode <- case M.lookup typ coders of+        Nothing -> fail $ "no coder found for type " ++ show typ+        Just coder -> pure $ coderEncode coder+      node <- encode term+      return (YM.NodeScalar $ YM.ScalarStr $ localNameOf $ bindingName el, node)+    ns = unNamespace $ moduleNamespace mod+    localNameOf name = L.drop (1 + L.length ns) $ unName name++moduleToYaml :: Module -> Flow Graph (M.Map FilePath String)+moduleToYaml mod = withTrace ("print module " ++ (unNamespace $ moduleNamespace mod)) $ do+    node <- transformModule yamlLanguage encodeTerm constructModule mod+    return $ M.fromList [(path, hydraYamlToString node)]+  where+    path = namespaceToFilePath CaseConventionCamel (FileExtension "yaml") $ moduleNamespace mod+    encodeTerm _ = fail $ "only type definitions are expected in this mapping to YAML"
+ src/main/haskell/Hydra/Staging/Yaml/Serde.hs view
@@ -0,0 +1,80 @@+module Hydra.Staging.Yaml.Serde where++import Hydra.Kernel+import Hydra.Staging.Yaml.Coder+import Hydra.Tools.Bytestrings+import qualified Hydra.Ext.Org.Yaml.Model as YM++import qualified Data.ByteString.Lazy as BS+import qualified Control.Monad as CM+import qualified Data.YAML as DY+import qualified Data.YAML.Event as DYE+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.ByteString.Lazy.Char8 as LB+++bytesToHsYaml :: BS.ByteString -> Flow (Graph) (DY.Node DY.Pos)+bytesToHsYaml bs = case DY.decodeNode bs of+    Left (pos, msg) -> fail $ "YAML parser failure at " ++ show pos ++ ": " ++ msg+    Right docs -> if L.null docs+      then fail "no YAML document"+      else if L.length docs > 1+      then fail "multiple YAML documents"+      else case L.head docs of+        (DY.Doc node) -> pure node++bytesToHydraYaml :: BS.ByteString -> Flow (Graph) YM.Node+bytesToHydraYaml = bytesToHsYaml CM.>=> hsYamlToHydraYaml++hsYamlToBytes :: DY.Node () -> BS.ByteString+hsYamlToBytes node = DY.encodeNode [DY.Doc node]++hsYamlToHydraYaml :: DY.Node x -> Flow (Graph) YM.Node+hsYamlToHydraYaml hs = case hs of+  DY.Scalar _ s -> YM.NodeScalar <$> case s of+     DY.SNull -> pure YM.ScalarNull+     DY.SBool b -> pure $ YM.ScalarBool b+     DY.SFloat f -> pure $ YM.ScalarFloat f+     DY.SInt i -> pure $ YM.ScalarInt i+     DY.SStr t -> pure $ YM.ScalarStr $ T.unpack t+     DY.SUnknown _ _ -> fail "YAML unknown scalars are unsupported"+  DY.Mapping _ _ m -> YM.NodeMapping . M.fromList <$> CM.mapM mapPair (M.toList m)+    where+      mapPair (k, v) = (,) <$> hsYamlToHydraYaml k <*> hsYamlToHydraYaml v+  DY.Sequence _ _ s -> YM.NodeSequence <$> CM.mapM hsYamlToHydraYaml s+  DY.Anchor {} -> fail "YAML anchors are unsupported"++hydraYamlToBytes :: YM.Node -> BS.ByteString+hydraYamlToBytes = hsYamlToBytes . hydraYamlToHsYaml++hydraYamlToHsYaml :: YM.Node -> DY.Node ()+hydraYamlToHsYaml hy = case hy of+  YM.NodeMapping m -> DY.Mapping () DYE.untagged $ M.fromList $ mapPair <$> M.toList m+    where+      mapPair (k, v) = (,) (hydraYamlToHsYaml k) (hydraYamlToHsYaml v)+  YM.NodeScalar s -> DY.Scalar () $ case s of+    YM.ScalarBool b -> DY.SBool b+    YM.ScalarFloat f -> DY.SFloat f+    YM.ScalarInt i -> DY.SInt i+    YM.ScalarNull -> DY.SNull+    YM.ScalarStr s -> DY.SStr $ T.pack s+  YM.NodeSequence s -> DY.Sequence () DYE.untagged $ hydraYamlToHsYaml <$> s++hydraYamlToString :: YM.Node -> String+hydraYamlToString = bytesToString . hydraYamlToBytes++yamlByteStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) BS.ByteString)+yamlByteStringCoder typ = do+  coder <- yamlCoder typ+  return Coder {+    coderEncode = fmap hydraYamlToBytes . coderEncode coder,+    coderDecode = bytesToHydraYaml CM.>=> coderDecode coder}++yamlStringCoder :: Type -> Flow (Graph) (Coder (Graph) (Graph) (Term) String)+yamlStringCoder typ = do+  serde <- yamlByteStringCoder typ+  return Coder {+    coderEncode = fmap LB.unpack . coderEncode serde,+    coderDecode = coderDecode serde . LB.pack}
− src/main/haskell/Hydra/TermAdapters.hs 
@@ -1,402 +0,0 @@--- | Adapter framework for types and terms--module Hydra.TermAdapters (-  fieldAdapter,-  functionProxyName,-  functionProxyType,-  termAdapter,-) where--import Hydra.Printing-import Hydra.AdapterUtils-import Hydra.Basics-import Hydra.Strip-import Hydra.Coders-import Hydra.Compute-import Hydra.Core-import Hydra.Schemas-import Hydra.Graph-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Reduction-import Hydra.Rewriting-import Hydra.LiteralAdapters-import Hydra.Dsl.Terms-import Hydra.Reduction-import Hydra.Tier1-import Hydra.Tier2-import qualified Hydra.Dsl.Expect as Expect-import qualified Hydra.Dsl.Types as Types--import qualified Control.Monad as CM-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Text.Read as TR-import qualified Data.Maybe as Y---_context :: Name-_context = Name "context"--_record :: Name-_record = Name "record"--fieldAdapter :: FieldType -> Flow (AdapterContext) (SymmetricAdapter (AdapterContext) (FieldType) (Field))-fieldAdapter ftyp = do-  ad <- termAdapter $ fieldTypeType ftyp-  return $ Adapter (adapterIsLossy ad) ftyp (ftyp { fieldTypeType = adapterTarget ad })-    $ bidirectional $ \dir (Field name term) -> Field name <$> encodeDecode dir (adapterCoder ad) term---- | This function accounts for recursive type definitions-forTypeReference :: Name -> Flow (AdapterContext) (SymmetricAdapter (AdapterContext) (Type) (Term))-forTypeReference name = withTrace ("adapt named type " ++ unName name) $ do-  let lossy = False -- Note: we cannot know in advance whether the adapter is lossy or not-  let placeholder = Adapter lossy (TypeVariable name) (TypeVariable name) $ bidirectional $-        \dir term -> do-          cx <- getState-          case M.lookup name (adapterContextAdapters cx) of-            Nothing -> fail $ "no adapter for reference type " ++ unName name-            Just ad -> encodeDecode dir (adapterCoder ad) term-  cx <- getState-  let adapters = adapterContextAdapters cx-  case M.lookup name adapters of-    Nothing -> do-      -- Insert a placeholder until the actual adapter has been constructed-      putState (cx {adapterContextAdapters = M.insert name placeholder adapters})-      mt <- withGraphContext $ resolveType $ TypeVariable name-      case mt of-        Nothing -> pure $ Adapter lossy (TypeVariable name) (TypeVariable name) $ bidirectional $ const pure-        Just t -> do-          actual <- termAdapter t-          putState (cx {adapterContextAdapters = M.insert name actual adapters})-          return actual-    Just ad -> pure ad--functionProxyName :: Name-functionProxyName = Name "hydra/core.FunctionProxy"--functionProxyType :: Type -> Type-functionProxyType dom = TypeUnion $ RowType functionProxyName [-  FieldType _Elimination_wrap Types.string,-  FieldType _Elimination_optional Types.string,-  FieldType _Elimination_record Types.string,-  FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)-  FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),-  FieldType _Function_primitive Types.string,-  FieldType _Term_variable Types.string]--functionToUnion :: TypeAdapter-functionToUnion t@(TypeFunction (FunctionType dom _)) = do-    ut <- unionType-    ad <- termAdapter ut-    return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)-  where-    encode ad term = coderEncode (adapterCoder ad) $ case fullyStripTerm term of-      TermFunction f -> case f of-        FunctionElimination e -> case e of-          EliminationWrap (Name name) -> variant functionProxyName _Elimination_wrap $ string name-          EliminationOptional _ -> variant functionProxyName _Elimination_optional $ string $ show term -- TODO-          EliminationRecord _ -> variant functionProxyName _Elimination_record $ string $ show term -- TODO-          EliminationUnion _ -> variant functionProxyName _Elimination_union $ string $ show term -- TODO-        FunctionLambda _ -> variant functionProxyName _Function_lambda $ string $ show term -- TODO-        FunctionPrimitive (Name name) -> variant functionProxyName _Function_primitive $ string name-      TermVariable (Name var) -> variant functionProxyName _Term_variable $ string var--    decode ad term = do-        (Field fname fterm) <- coderDecode (adapterCoder ad) term >>= Expect.injection-        Y.fromMaybe (notFound fname) $ M.lookup fname $ M.fromList [-          (_Elimination_wrap, forWrapped fterm),-          (_Elimination_optional, forOptionalCases fterm),-          (_Elimination_record, forProjection fterm),-          (_Elimination_union, forCases fterm),-          (_Function_lambda, forLambda fterm),-          (_Function_primitive, forPrimitive fterm),-          (_Term_variable, forVariable fterm)]-      where-        notFound fname = fail $ "unexpected field: " ++ unName fname-        forCases fterm = read <$> Expect.string fterm -- TODO-        forLambda fterm = read <$> Expect.string fterm -- TODO-        forWrapped fterm = unwrap . Name <$> Expect.string fterm-        forOptionalCases fterm = read <$> Expect.string fterm -- TODO-        forPrimitive fterm = primitive . Name <$> Expect.string fterm-        forProjection fterm = read <$> Expect.string fterm -- TODO-        forVariable fterm = var <$> Expect.string fterm--    unionType = do-      domAd <- termAdapter dom-      return $ TypeUnion $ RowType functionProxyName [-        FieldType _Elimination_wrap Types.string,-        FieldType _Elimination_optional Types.string,-        FieldType _Elimination_record Types.string,-        FieldType _Elimination_union Types.string, -- TODO (TypeRecord cases)-        FieldType _Function_lambda Types.string, -- TODO (TypeRecord [FieldType _Lambda_parameter Types.string, FieldType _Lambda_body cod]),-        FieldType _Function_primitive Types.string,-        FieldType _Term_variable Types.string]--lambdaToMonotype :: TypeAdapter-lambdaToMonotype t@(TypeLambda (LambdaType _ body)) = do-  ad <- termAdapter body-  return ad {adapterSource = t}--listToSet :: TypeAdapter-listToSet t@(TypeSet st) = do-    ad <- termAdapter $ Types.list st-    return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder (encode ad) (decode ad)-  where-    encode ad (TermSet s) = coderEncode (adapterCoder ad) $ TermList $ S.toList s-    decode ad term = TermSet . S.fromList . (\(TermList l') -> l') <$> coderDecode (adapterCoder ad) term--optionalToList :: TypeAdapter-optionalToList t@(TypeOptional ot) = do-  ad <- termAdapter ot-  return $ Adapter False t (Types.list $ adapterTarget ad) $ Coder {-    coderEncode = \(TermOptional m) -> Y.maybe-      (pure $ list [])-      (fmap (\ r -> list [r]) . coderEncode (adapterCoder ad)) m,-    coderDecode = \(TermList l) -> optional <$> if L.null l then-      pure Nothing-      else Just <$> coderDecode (adapterCoder ad) (L.head l)}---- TODO: only tested for type mappings; not yet for types+terms-passApplication :: TypeAdapter-passApplication t = do-    reduced <- withGraphContext $ betaReduceType t-    ad <- termAdapter reduced-    return $ Adapter (adapterIsLossy ad) t reduced $ bidirectional $-      \dir term -> encodeDecode dir (adapterCoder ad) term--passFunction :: TypeAdapter-passFunction t@(TypeFunction (FunctionType dom cod)) = do-    domAd <- termAdapter dom-    codAd <- termAdapter cod-    caseAds <- case stripType dom of-      TypeUnion rt -> M.fromList . L.zip (fieldTypeName <$> rowTypeFields rt)-        <$> CM.mapM (\f -> fieldAdapter $ FieldType (fieldTypeName f) (TypeFunction $ FunctionType (fieldTypeType f) cod)) (rowTypeFields rt)-      _ -> pure M.empty-    optionAd <- case stripType dom of-      TypeOptional ot -> Just <$> termAdapter (Types.function ot cod)-      _ -> pure Nothing-    let lossy = adapterIsLossy codAd || or (adapterIsLossy . snd <$> M.toList caseAds)-    let target = Types.function (adapterTarget domAd) (adapterTarget codAd)-    return $ Adapter lossy t target-      $ bidirectional $ \dir term -> case fullyStripTerm term of-        TermFunction f -> TermFunction <$> case f of-          FunctionElimination e -> FunctionElimination <$> case e of-            EliminationOptional (OptionalCases nothing just) -> EliminationOptional <$> (-              OptionalCases-                <$> encodeDecode dir (adapterCoder codAd) nothing-                <*> (encodeDecode dir (adapterCoder $ Y.fromJust optionAd) just))-            EliminationUnion (CaseStatement n def cases) -> do-                rcases <- CM.mapM (\f -> encodeDecode dir (getCoder $ fieldName f) f) cases-                rdef <- case def of-                  Nothing -> pure Nothing-                  Just d -> Just <$> encodeDecode dir (adapterCoder codAd) d-                return $ EliminationUnion $ CaseStatement n rdef rcases-              where-                -- Note: this causes unrecognized cases to simply be passed through;-                --       it is not the job of this adapter to catch validation issues.-                getCoder fname = Y.maybe idCoder adapterCoder $ M.lookup fname caseAds-          FunctionLambda (Lambda var d body) -> FunctionLambda <$> (Lambda var d <$> encodeDecode dir (adapterCoder codAd) body)-          FunctionPrimitive name -> pure $ FunctionPrimitive name---        _ -> unexpected "function term" $ show term-        t -> pure t--passLambda :: TypeAdapter-passLambda t@(TypeLambda (LambdaType (Name v) body)) = do-  ad <- termAdapter body-  return $ Adapter (adapterIsLossy ad) t (Types.lambda v $ adapterTarget ad)-    $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term--passLiteral :: TypeAdapter-passLiteral (TypeLiteral at) = do-  ad <- literalAdapter at-  let step = bidirectional $ \dir term -> do-        l <- Expect.literal term-        literal <$> encodeDecode dir (adapterCoder ad) l-  return $ Adapter (adapterIsLossy ad) (Types.literal $ adapterSource ad) (Types.literal $ adapterTarget ad) step--passList :: TypeAdapter-passList t@(TypeList lt) = do-  ad <- termAdapter lt-  return $ Adapter (adapterIsLossy ad) t (Types.list $ adapterTarget ad)-    $ bidirectional $ \dir (TermList terms) -> list <$> CM.mapM (encodeDecode dir $ adapterCoder ad) terms--passMap :: TypeAdapter-passMap t@(TypeMap (MapType kt vt)) = do-  kad <- termAdapter kt-  vad <- termAdapter vt-  return $ Adapter (adapterIsLossy kad || adapterIsLossy vad)-    t (Types.map (adapterTarget kad) (adapterTarget vad))-    $ bidirectional $ \dir (TermMap m) -> TermMap . M.fromList-      <$> CM.mapM (\(k, v) -> (,) <$> encodeDecode dir (adapterCoder kad) k <*> encodeDecode dir (adapterCoder vad) v)-        (M.toList m)--passOptional :: TypeAdapter-passOptional t@(TypeOptional ot) = do-  ad <- termAdapter ot-  return $ Adapter (adapterIsLossy ad) t (Types.optional $ adapterTarget ad) $-    bidirectional $ \dir term -> case fullyStripTerm term of-      (TermOptional m) -> TermOptional <$> case m of-        Nothing -> pure Nothing-        Just term' -> Just <$> encodeDecode dir (adapterCoder ad) term'-      t -> pure term---      t -> fail $ "expected optional term, found: " ++ show t--passProduct :: TypeAdapter-passProduct t@(TypeProduct types) = do-  ads <- CM.mapM termAdapter types-  let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads-  return $ Adapter lossy t (Types.product (adapterTarget <$> ads))-    $ bidirectional $ \dir (TermProduct tuple) -> TermProduct <$> (CM.zipWithM (\term ad -> encodeDecode dir (adapterCoder ad) term) tuple ads)--passRecord :: TypeAdapter-passRecord t@(TypeRecord rt) = do-  adapters <- CM.mapM fieldAdapter (rowTypeFields rt)-  let lossy = or $ adapterIsLossy <$> adapters-  let sfields' = adapterTarget <$> adapters-  return $ Adapter lossy t (TypeRecord $ rt {rowTypeFields = sfields'}) $ bidirectional-    $ \dir (TermRecord (Record _ dfields)) -> record (rowTypeTypeName rt) <$> CM.zipWithM (encodeDecode dir . adapterCoder) adapters dfields--passSet :: TypeAdapter-passSet t@(TypeSet st) = do-  ad <- termAdapter st-  return $ Adapter (adapterIsLossy ad) t (Types.set $ adapterTarget ad)-    $ bidirectional $ \dir (TermSet terms) -> set . S.fromList-      <$> CM.mapM (encodeDecode dir (adapterCoder ad)) (S.toList terms)--passSum :: TypeAdapter-passSum t@(TypeSum types) = do-  ads <- CM.mapM termAdapter types-  let lossy = L.foldl (\b ad -> b || adapterIsLossy ad) False ads-  return $ Adapter lossy t (Types.sum (adapterTarget <$> ads))-    $ bidirectional $ \dir (TermSum (Sum i n term)) -> TermSum . Sum i n <$> encodeDecode dir (adapterCoder $ ads !! i) term--passUnion :: TypeAdapter-passUnion t@(TypeUnion rt) = do-    adapters <- M.fromList <$> CM.mapM (\f -> pure ((,) (fieldTypeName f)) <*> fieldAdapter f) sfields-    let lossy = or $ adapterIsLossy <$> adapters-    let sfields' = adapterTarget . snd <$> M.toList adapters-    return $ Adapter lossy t (TypeUnion $ rt {rowTypeFields = sfields'})-      $ bidirectional $ \dir term -> do-        dfield <- Expect.injection term-        ad <- getAdapter adapters dfield-        TermUnion . Injection nm <$> encodeDecode dir (adapterCoder ad) dfield-  where-    getAdapter adapters f = Y.maybe (fail $ "no such field: " ++ unName (fieldName f)) pure $ M.lookup (fieldName f) adapters-    sfields = rowTypeFields rt-    nm = rowTypeTypeName rt--passWrapped :: TypeAdapter-passWrapped wt@(TypeWrap (WrappedType tname t)) = do-  adapter <- termAdapter t-  return $ Adapter (adapterIsLossy adapter) wt (Types.wrapWithName tname $ adapterTarget adapter)-    $ bidirectional $ \dir (TermWrap (WrappedTerm _ term)) -> TermWrap . WrappedTerm tname <$> encodeDecode dir (adapterCoder adapter) term--simplifyApplication :: TypeAdapter-simplifyApplication t@(TypeApplication (ApplicationType lhs _)) = do-  ad <- termAdapter lhs-  return $ Adapter False t (adapterTarget ad) $ bidirectional $ \dir term -> encodeDecode dir (adapterCoder ad) term---- Note: those constructors which cannot be mapped meaningfully at this time are simply---       preserved as strings using Haskell's derived show/read format.-termAdapter :: TypeAdapter-termAdapter typ = case typ of-    TypeAnnotated (AnnotatedType typ2 ann) -> do-      ad <- termAdapter typ2-      return ad {adapterTarget = TypeAnnotated $ AnnotatedType (adapterTarget ad) ann}-    _ -> withTrace ("adapter for " ++ describeType typ ) $ case typ of-      -- Account for let-bound variables-      TypeVariable name -> forTypeReference name-      _ -> do-          g <- getState-          chooseAdapter (alts g) (supported g) describeType typ-        where-          alts g t = (\c -> c t) <$>-              if supportedAtTopLevel g t-                then pass t-                else trySubstitution t-            where-              supportedAtTopLevel g t = variantIsSupported g t && languageConstraintsTypes (constraints g) t-              pass t = case typeVariant (stripType t) of-                TypeVariantApplication -> [passApplication]-                TypeVariantFunction ->  [passFunction]-                TypeVariantLambda -> [passLambda]-                TypeVariantList -> [passList]-                TypeVariantLiteral -> [passLiteral]-                TypeVariantMap -> [passMap]-                TypeVariantOptional -> [passOptional, optionalToList]-                TypeVariantProduct -> [passProduct]-                TypeVariantRecord -> [passRecord]-                TypeVariantSet -> [passSet]-                TypeVariantSum -> [passSum]-                TypeVariantUnion -> [passUnion]-                TypeVariantWrap -> [passWrapped]-                _ -> []-              trySubstitution t = case typeVariant t of-                TypeVariantApplication -> [simplifyApplication]-                TypeVariantFunction -> [functionToUnion]-                TypeVariantLambda -> [lambdaToMonotype]-                TypeVariantOptional -> [optionalToList]-                TypeVariantSet ->  [listToSet]-                TypeVariantUnion -> [unionToRecord]-                TypeVariantWrap -> [wrapToUnwrapped]-                _ -> [unsupportedToString]-    where-      constraints = languageConstraints . adapterContextLanguage-      supported = typeIsSupported . constraints-      variantIsSupported g t = S.member (typeVariant t) $ languageConstraintsTypeVariants (constraints g)------ Caution: possibility of an infinite loop if neither unions, optionals, nor lists are supported-unionToRecord :: TypeAdapter-unionToRecord t@(TypeUnion rt) = do-    let target = TypeRecord $ rt {rowTypeFields = makeOptional <$> sfields}-    ad <- termAdapter target-    return $ Adapter (adapterIsLossy ad) t (adapterTarget ad) $ Coder {-      coderEncode = \term' -> do-        (Field fn term) <- Expect.injectionWithName (rowTypeTypeName rt) term'-        coderEncode (adapterCoder ad) $ record nm (toRecordField term fn <$> sfields),-      coderDecode = \term -> do-        TermRecord (Record _ fields) <- coderDecode (adapterCoder ad) term-        inject nm <$> fromRecordFields term (TermRecord (Record nm fields)) (adapterTarget ad) fields}-  where-    nm = rowTypeTypeName rt-    sfields = rowTypeFields rt--    makeOptional (FieldType fn ft) = FieldType fn $ beneathTypeAnnotations Types.optional ft--    toRecordField term fn (FieldType fn' _) = Field fn' $-      TermOptional $ if fn' == fn then Just term else Nothing--    fromRecordFields term term' t' fields = if L.null matches-        then fail $ "cannot convert term back to union: " ++ show term-          ++ " where type = " ++ show t ++ "    and target type = " ++ show t'-        else pure $ L.head matches-      where-        matches = Y.mapMaybe (\(Field fn (TermOptional opt)) -> (Just . Field fn) =<< opt) fields--unsupportedToString :: TypeAdapter-unsupportedToString t = pure $ Adapter False t Types.string $ Coder encode decode-  where-    -- TODO: use JSON for encoding and decoding unsupported terms, rather than Haskell's read/show-    encode term = pure $ string $ "unsupported: " ++ show term-    decode term = do-      s <- Expect.string term-      case TR.readEither s of-        Left msg -> fail $ "could not decode unsupported term: " ++ s-        Right t -> pure t--wrapToUnwrapped :: TypeAdapter-wrapToUnwrapped t@(TypeWrap (WrappedType tname typ)) = do-    ad <- termAdapter typ-    return $ Adapter False t (adapterTarget ad) $ Coder (encode ad) (decode ad)-  where-    encode ad term = Expect.wrap tname term >>= coderEncode (adapterCoder ad)-    decode ad term = do-      decoded <- coderDecode (adapterCoder ad) term-      return $ TermWrap $ WrappedTerm tname decoded--withGraphContext :: Flow (Graph) x -> Flow (AdapterContext) x-withGraphContext f = do-  cx <- getState-  withState (adapterContextGraph cx) f
− src/main/haskell/Hydra/Tools/Accessors.hs 
@@ -1,81 +0,0 @@--- | Utilities for working with term accessors--module Hydra.Tools.Accessors where--import Hydra.Kernel--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---type AccessorPath = [TermAccessor]-data AccessorNode = AccessorNode Name String String deriving Show-data AccessorEdge = AccessorEdge AccessorNode AccessorPath AccessorNode deriving Show-data AccessorGraph = AccessorGraph [AccessorNode] [AccessorEdge] deriving Show--showTermAccessor :: TermAccessor -> Maybe String-showTermAccessor accessor = case accessor of-   TermAccessorAnnotatedSubject -> Nothing-   TermAccessorApplicationFunction -> Just "fun"-   TermAccessorApplicationArgument -> Just "arg"-   TermAccessorLambdaBody -> Just "body"-   TermAccessorListFold -> Nothing-   TermAccessorOptionalCasesNothing -> Just "nothing"-   TermAccessorOptionalCasesJust -> Just "just"-   TermAccessorUnionCasesDefault -> Just "default"-   TermAccessorUnionCasesBranch name -> Just $ "." ++ unName name-   TermAccessorLetEnvironment -> Just "in"-   TermAccessorLetBinding name -> Just $ unName name ++ "="-   TermAccessorListElement i -> idx i-   TermAccessorMapKey i -> idxSuff ".key" i-   TermAccessorMapValue i -> idxSuff ".value" i-   TermAccessorOptionalTerm -> Just "just"-   TermAccessorProductTerm i -> idx i-   TermAccessorRecordField name -> Just $ "." ++ unName name-   TermAccessorSetElement i -> idx i-   TermAccessorSumTerm -> Nothing-   TermAccessorTypeAbstractionBody -> Nothing-   TermAccessorTypeApplicationTerm -> Nothing-   TermAccessorTypedTerm -> Nothing-   TermAccessorInjectionTerm -> Nothing-   TermAccessorWrappedTerm -> Nothing-  where---    idx i = Just $ "[" ++ show i ++ "]" -- TODO: restore this-    idx i = Nothing-    idxSuff suffix i = Y.maybe (Just suffix) Just $ fmap (\s -> s ++ suffix) $ idx i--termToAccessorGraph :: M.Map Namespace String -> Term -> AccessorGraph-termToAccessorGraph namespaces term = AccessorGraph nodesX edgesX-  where-    (nodesX, edgesX, _) = helper M.empty Nothing [] ([], [], S.empty) (dontCareAccessor, term)-    dontCareAccessor = TermAccessorAnnotatedSubject-    helper ids mroot path (nodes, edges, visited) (accessor, term) = case term of-        TermLet (Let bindings env) -> helper ids1 mroot nextPath (nodes2, edges2, visited2) (TermAccessorLetEnvironment, env)-          where-            (nodes2, edges2, visited2) = L.foldl addBinding (nodes1++nodes, edges, visited1) (L.zip nodes1 bindings)-              where-                addBinding (nodes, edges, visited) (root, (LetBinding name term1 _))-                    = helper ids1 (Just root) [] (nodes, edges, visited) (dontCareAccessor, term1)-            (nodes1, visited1, ids1) = L.foldl addBinding ([], visited, ids) (letBindingName <$> bindings)-              where-                addBinding (nodes, visited, ids) name =-                    ((node:nodes), S.insert uniqueLabel visited, M.insert name node ids)-                  where-                    node = AccessorNode name rawLabel uniqueLabel-                    rawLabel = toCompactName namespaces name-                    uniqueLabel = toUniqueLabel visited rawLabel-        TermVariable name -> case mroot of-          Nothing -> (nodes, edges, visited)-          Just root -> case M.lookup name ids of-            Nothing -> (nodes, edges, visited)-            Just node -> (nodes, edge:edges, visited)-              where-                edge = AccessorEdge root (L.reverse nextPath) node-        _ -> L.foldl (helper ids mroot nextPath) (nodes, edges, visited) $ subtermsWithAccessors term-      where-        nextPath = accessor:path--toUniqueLabel :: S.Set String -> String -> String-toUniqueLabel visited l = if S.member l visited then toUniqueLabel visited (l ++ "'") else l
src/main/haskell/Hydra/Tools/Debug.hs view
@@ -8,7 +8,5 @@  instance Exception DebugException -debug = True :: Bool- throwDebugException :: String -> c throwDebugException = throw . DebugException
− src/main/haskell/Hydra/Tools/Formatting.hs 
@@ -1,122 +0,0 @@--- | String formatting utilities--module Hydra.Tools.Formatting where--import Hydra.Basics-import qualified Hydra.Lib.Strings as Strings--import qualified Data.Char as C-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y---data CaseConvention = CaseConventionCamel | CaseConventionPascal | CaseConventionLowerSnake | CaseConventionUpperSnake--convertCase :: CaseConvention -> CaseConvention -> String -> String-convertCase from to original = case to of-    CaseConventionCamel -> decapitalize $ L.concat (capitalize . Strings.toLower <$> parts)-    CaseConventionPascal -> L.concat (capitalize . Strings.toLower <$> parts)-    CaseConventionLowerSnake -> L.intercalate "_" (Strings.toLower <$> parts)-    CaseConventionUpperSnake -> L.intercalate "_" (Strings.toUpper <$> parts)-  where-    parts = case from of-      CaseConventionCamel -> byCaps-      CaseConventionPascal -> byCaps-      CaseConventionLowerSnake -> byUnderscores-      CaseConventionUpperSnake -> byUnderscores-    byUnderscores = Strings.splitOn "_" original-    byCaps = L.foldl helper [""] $ L.reverse $ decapitalize original-      where-        helper (h:r) c = ["" | C.isUpper c] ++ ((c:h):r)--convertCaseCamelToLowerSnake :: String -> String-convertCaseCamelToLowerSnake = convertCase CaseConventionCamel CaseConventionLowerSnake--convertCaseCamelToUpperSnake :: String -> String-convertCaseCamelToUpperSnake = convertCase CaseConventionCamel CaseConventionUpperSnake--convertCasePascalToUpperSnake :: String -> String-convertCasePascalToUpperSnake = convertCase CaseConventionPascal CaseConventionUpperSnake--escapeWithUnderscore :: S.Set String -> String -> String-escapeWithUnderscore reserved s = if S.member s reserved then s ++ "_" else s--indentLines :: String -> String-indentLines s = unlines (indent <$> lines s)-  where-    indent l = "    " ++ l--javaStyleComment :: String -> String-javaStyleComment s = "/**\n" ++ " * " ++ s ++ "\n */"--nonAlnumToUnderscores :: String -> String-nonAlnumToUnderscores = L.reverse . fst . L.foldl replace ([], False)-  where-    replace (s, b) c = if isAlnum c-      then (c:s, False)-      else if b-        then (s, True)-        else ('_':s, True)-    isAlnum c = (c >= 'A' && c <= 'Z')-      || (c >= 'a' && c <= 'z')-      || (c >= '0' && c <= '9')--sanitizeWithUnderscores :: S.Set String -> String -> String-sanitizeWithUnderscores reserved = escapeWithUnderscore reserved . nonAlnumToUnderscores--withCharacterAliases :: String -> String-withCharacterAliases original = L.filter C.isAlphaNum $ L.concat $ alias <$> original-  where-    alias c = Y.maybe [c] capitalize $ M.lookup (C.ord c) aliases--    -- Taken from: https://cs.stanford.edu/people/miles/iso8859.html-    aliases = M.fromList [-      (32, "sp"),-      (33, "excl"),-      (34, "quot"),-      (35, "num"),-      (36, "dollar"),-      (37, "percnt"),-      (38, "amp"),-      (39, "apos"),-      (40, "lpar"),-      (41, "rpar"),-      (42, "ast"),-      (43, "plus"),-      (44, "comma"),-      (45, "minus"),-      (46, "period"),-      (47, "sol"),-      (58, "colon"),-      (59, "semi"),-      (60, "lt"),-      (61, "equals"),-      (62, "gt"),-      (63, "quest"),-      (64, "commat"),-      (91, "lsqb"),-      (92, "bsol"),-      (93, "rsqb"),-      (94, "circ"),-      (95, "lowbar"),-      (96, "grave"),-      (123, "lcub"),-      (124, "verbar"),-      (125, "rcub"),-      (126, "tilde")]---- A simple soft line wrap which is suitable for code comments-wrapLine :: Int -> String -> String-wrapLine maxlen = L.intercalate "\n" . helper []-  where-    helper prev rem = if L.length rem <= maxlen-        then L.reverse (rem:prev)-        else if L.null prefix-        then helper (trunc:prev) $ L.drop maxlen rem-        else helper ((init prefix):prev) $ suffix ++ L.drop maxlen rem-      where-        trunc = L.take maxlen rem-        (prefix, suffix) = case span (\c -> c /= ' ' && c /= '\t') (reverse trunc) of-                                      (restRev, firstRev) -> (reverse firstRev, reverse restRev)
− src/main/haskell/Hydra/Tools/GrammarToModule.hs 
@@ -1,115 +0,0 @@--- | A utility for converting a BNF grammar to a Hydra module--module Hydra.Tools.GrammarToModule where--import Hydra.Kernel-import Hydra.Dsl.Annotations-import Hydra.Dsl.Bootstrap as Bootstrap-import Hydra.Dsl.Types as Types-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Grammar as G--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y--import Hydra.Sources.Core---grammarToModule :: Namespace -> G.Grammar -> Maybe String -> Module-grammarToModule ns (G.Grammar prods) desc = Module ns elements [hydraCoreModule] [hydraCoreModule] desc-  where-    elements = pairToElement <$> L.concat (L.zipWith (makeElements False) (capitalize . fst <$> prodPairs) (snd <$> prodPairs))-      where-        prodPairs = (\(G.Production (G.Symbol s) pat) -> (s, pat)) <$> prods-        pairToElement (lname, typ) = Bootstrap.typeElement (toName lname) typ--    toName local = unqualifyName $ QualifiedName (Just ns) local--    findNames pats = L.reverse $ fst (L.foldl nextName ([], M.empty) pats)-      where-        nextName (names, nameMap) pat = (nn:names, M.insert rn ni nameMap)-          where-            rn = rawName pat-            (nn, ni) = case M.lookup rn nameMap of-              Nothing -> (rn, 1)-              Just i -> (rn ++ show (i+1), i+1)--        rawName pat = case pat of-          G.PatternNil -> "none"-          G.PatternIgnored _ -> "ignored"-          G.PatternLabeled (G.LabeledPattern (G.Label l) _) -> l-          G.PatternConstant (G.Constant c) -> decapitalize $ withCharacterAliases c-          G.PatternRegex _ -> "regex"-          G.PatternNonterminal (G.Symbol s) -> decapitalize s-          G.PatternSequence _ -> "sequence"-          G.PatternAlternatives _ -> "alts"-          G.PatternOption p -> decapitalize (rawName p)-          G.PatternStar p -> "listOf" ++ capitalize (rawName p)-          G.PatternPlus p -> "listOf" ++ capitalize (rawName p)--    isComplex pat = case pat of-      G.PatternLabeled (G.LabeledPattern _ p) -> isComplex p-      G.PatternSequence pats -> isNontrivial True pats-      G.PatternAlternatives pats -> isNontrivial False pats-      _ -> False--    isNontrivial isRecord pats = if L.length minPats == 1-        then case L.head minPats of-          G.PatternLabeled _ -> True-          _ -> False-        else True-      where-        minPats = simplify isRecord pats--    -- Remove trivial patterns from records-    simplify isRecord pats = if isRecord then L.filter (not . isConstant) pats else pats-      where-        isConstant p = case p of-          G.PatternConstant _ -> True-          _ -> False--    makeElements omitTrivial lname pat = forPat pat-      where-        forPat pat = case pat of-          G.PatternNil -> trivial-          G.PatternIgnored _ -> []-          G.PatternLabeled (G.LabeledPattern (G.Label l) p) -> forPat p-          G.PatternConstant _ -> trivial-          G.PatternRegex _ -> [(lname, Types.string)]-          G.PatternNonterminal (G.Symbol other) -> [(lname, TypeVariable $ toName other)]-          G.PatternSequence pats -> forRecordOrUnion True Types.record pats-          G.PatternAlternatives pats -> forRecordOrUnion False Types.union pats-          G.PatternOption p -> mod "Option" Types.optional p-          G.PatternStar p -> mod "Elmt" Types.list p-          G.PatternPlus p -> mod "Elmt" nonemptyList p--        trivial = if omitTrivial then [] else [(lname, Types.unit)]--        forRecordOrUnion isRecord construct pats = if isNontrivial isRecord pats-            then (lname, construct fields):els-            -- Eliminate single-field record and union types, unless the field has a user-defined name-            else forPat $ L.head minPats-          where-            fieldPairs = L.zipWith toField (findNames minPats) minPats-            fields = fst <$> fieldPairs-            els = L.concat (snd <$> fieldPairs)-            minPats = simplify isRecord pats--        toField n p = descend n f2 p-          where-            f2 ((lname, typ):rest) = (FieldType (Name n) typ, rest)--        mod n f p = descend n f2 p-          where-            f2 ((lname, typ):rest) = (lname, f typ):rest--        descend n f p = f $ if isComplex p-            then (lname, TypeVariable (toName $ fst $ L.head cpairs)):cpairs-            else if L.null cpairs-              then [(lname, Types.unit)]-              else (lname, snd (L.head cpairs)):L.tail cpairs-          where-            cpairs = makeElements False (childName lname n) p--    childName lname n = lname ++ "." ++ capitalize n
+ src/main/haskell/Hydra/Tools/Monads.hs view
@@ -0,0 +1,34 @@+-- | Functions and type class implementations for working with Hydra's built-in Flow monad++module Hydra.Tools.Monads where++import Hydra.Compute+import Hydra.Monads hiding (fail, pure)+import qualified Hydra.Mantle as Mantle+import qualified Hydra.Lib.Flows as Flows++import qualified Control.Monad as CM+import qualified System.IO as IO+++fromEither :: Show e => (e -> String) -> Either e a -> Flow c a+fromEither printErr x = case x of+  Left e -> Flows.fail $ printErr e+  Right a -> return a++flowToIo :: s -> Flow s a -> IO.IO a+flowToIo cx f = case mv of+    Just v -> return v+    Nothing -> CM.fail $ traceSummary trace+  where+    FlowState mv _ trace = unFlow f cx emptyTrace++hydraEitherToHaskellEither :: Mantle.Either a b -> Either a b+hydraEitherToHaskellEither e = case e of+   Mantle.EitherLeft l -> Left l+   Mantle.EitherRight r -> Right r++fromMaybe :: String -> Maybe a -> Flow s a+fromMaybe message m = case m of+  Nothing -> Flows.fail message+  Just v -> return v
− src/main/haskell/Hydra/Tools/Serialization.hs 
@@ -1,229 +0,0 @@--- | Utilities for constructing Hydra code trees--module Hydra.Tools.Serialization where--import Hydra.Ast--import qualified Data.List as L-import qualified Data.Maybe as Y---angleBraces :: Brackets-angleBraces = Brackets (sym "<") (sym ">")--angleBracesList ::  BlockStyle -> [Expr] -> Expr-angleBracesList style els = case els of-  [] -> cst "<>"-  _ -> brackets angleBraces style $ commaSep style els--bracketList :: BlockStyle -> [Expr] -> Expr-bracketList style els = case els of-  [] -> cst "[]"-  _ -> brackets squareBrackets style $ commaSep style els--brackets :: Brackets -> BlockStyle -> Expr -> Expr-brackets br style e = ExprBrackets $ BracketExpr br e style--commaSep :: BlockStyle -> [Expr] -> Expr-commaSep = symbolSep ","--curlyBlock :: BlockStyle -> Expr -> Expr-curlyBlock style e = curlyBracesList Nothing style [e]--curlyBraces :: Brackets-curlyBraces = Brackets (sym "{") (sym "}")--curlyBracesList :: Maybe String -> BlockStyle -> [Expr] -> Expr-curlyBracesList msymb style els = case els of-  [] -> cst "{}"-  _ -> brackets curlyBraces style $ symbolSep (Y.fromMaybe "," msymb) style els--cst :: String -> Expr-cst = ExprConst . Symbol--customIndent :: String -> String -> String-customIndent idt s = L.intercalate "\n" $ (idt ++) <$> lines s--customIndentBlock :: String -> [Expr] -> Expr-customIndentBlock idt els = case els of-  [x] -> x---  (head:rest) -> ifx idtOp head $ indentSep idt rest-  (head:rest) -> ifx idtOp head $ newlineSep rest-    where-      idtOp = Op (sym "") (Padding WsSpace $ WsBreakAndIndent idt) (Precedence 0) AssociativityNone--dotSep :: [Expr] -> Expr-dotSep = sep $ Op (sym ".") (Padding WsNone WsNone) (Precedence 0) AssociativityNone--doubleNewlineSep :: [Expr] -> Expr-doubleNewlineSep = sep $ Op (sym "") (Padding WsBreak WsBreak) (Precedence 0) AssociativityNone--doubleSpace :: String-doubleSpace = "  "--fullBlockStyle :: BlockStyle-fullBlockStyle = BlockStyle (Just doubleSpace) True True--halfBlockStyle :: BlockStyle-halfBlockStyle = BlockStyle (Just doubleSpace) True False--ifx :: Op -> Expr -> Expr -> Expr-ifx op lhs rhs = ExprOp $ OpExpr op lhs rhs--indent :: String -> String-indent = customIndent doubleSpace--indentBlock :: [Expr] -> Expr-indentBlock = customIndentBlock doubleSpace--indentLines :: [Expr] -> Expr-indentLines els = ifx topOp (cst "") (newlineSep els)-  where-    topOp = Op (sym "") (Padding WsNone (WsBreakAndIndent doubleSpace)) (Precedence 0) AssociativityNone--indentSubsequentLines :: String -> Expr -> Expr-indentSubsequentLines idt e = ExprIndent $ IndentedExpression (IndentStyleSubsequentLines idt) e--infixWs :: String -> Expr -> Expr -> Expr-infixWs op l r = spaceSep [l, cst op, r]--infixWsList :: String -> [Expr] -> Expr-infixWsList op opers = spaceSep $ L.foldl (\e r -> if L.null e then [r] else r:opExpr:e) [] $ L.reverse opers-  where-    opExpr = cst op--inlineStyle :: BlockStyle-inlineStyle = BlockStyle Nothing False False--newlineSep :: [Expr] -> Expr-newlineSep = sep $ Op (sym "") (Padding WsNone WsBreak) (Precedence 0) AssociativityNone--noPadding :: Padding-noPadding = Padding WsNone WsNone--noSep :: [Expr] -> Expr-noSep = sep $ Op (sym "") (Padding WsNone WsNone) (Precedence 0) AssociativityNone--num :: Int -> Expr-num = cst . show--op :: String -> Int -> Associativity -> Op-op s p = Op (Symbol s) (Padding WsSpace WsSpace) (Precedence p)--orOp :: Bool -> Op-orOp newlines = Op (sym "|") (Padding WsSpace (if newlines then WsBreak else WsSpace)) (Precedence 0) AssociativityNone -- No source--orSep :: BlockStyle -> [Expr] -> Expr-orSep style l = case l of-  [] -> cst ""-  [x] -> x-  (h:r) -> ifx (orOp newlines) h $ orSep style r-  where-    newlines = blockStyleNewlineBeforeContent style--parenList :: Bool -> [Expr] -> Expr-parenList newlines els = case els of-    [] -> cst "()"-    _ -> brackets parentheses style $ commaSep style els-  where-    style = if newlines && L.length els > 1 then halfBlockStyle else inlineStyle--parens :: Expr -> Expr-parens = brackets parentheses inlineStyle--parentheses :: Brackets-parentheses = Brackets (sym "(") (sym ")")--parenthesize :: Expr -> Expr-parenthesize exp = case exp of-  ExprBrackets (BracketExpr br e newlines) -> ExprBrackets (BracketExpr br (parenthesize e) newlines)-  ExprConst _ -> exp-  ExprIndent (IndentedExpression style e) -> ExprIndent (IndentedExpression style (parenthesize e))-  ExprOp (OpExpr op@(Op _ _ prec assoc) lhs rhs) -> ExprOp (OpExpr op lhs2 rhs2)-    where-      lhs' = parenthesize lhs-      rhs' = parenthesize rhs-      lhs2 = case lhs' of-        ExprOp (OpExpr (Op _ _ lprec lassoc) _ _) -> case prec `compare` lprec of-          LT -> lhs'-          GT -> parens lhs'-          EQ -> if assocLeft assoc && assocLeft lassoc-            then lhs'-            else parens lhs'-        _ -> lhs'-      rhs2 = case rhs' of-        ExprOp (OpExpr (Op _ _ rprec rassoc) _ _) -> case prec `compare` rprec of-          LT -> rhs'-          GT -> parens rhs'-          EQ -> if assocRight assoc && assocRight rassoc-            then rhs'-            else parens rhs'-        _ -> rhs'-      assocLeft a = a == AssociativityLeft || a == AssociativityNone || a == AssociativityBoth-      assocRight a = a == AssociativityRight || a == AssociativityNone || a == AssociativityBoth--prefix :: String -> Expr -> Expr-prefix p = ifx preOp (cst "")-  where-    preOp = Op (sym p) (Padding WsNone WsNone) (Precedence 0) AssociativityNone--printExpr :: Expr -> String-printExpr e = case e of-  ExprConst (Symbol s) -> s-  ExprIndent (IndentedExpression style expr) -> L.intercalate "\n" $ case style of-      IndentStyleAllLines idt -> (idt ++) <$> lns-      IndentStyleSubsequentLines idt -> case lns of-        [x] -> [x]-        (head:rest) -> head:((idt ++) <$> rest)-    where-      lns = lines $ printExpr expr-  ExprOp (OpExpr (Op (Symbol sym) (Padding padl padr) _ _) l r) -> lhs ++ pad padl ++ sym ++ pad padr ++ rhs-    where-      lhs = idt padl $ printExpr l-      rhs = idt padr $ printExpr r-      idt ws s = case ws of-        WsBreakAndIndent idt -> customIndent idt s-        _ -> s-      pad ws = case ws of-        WsNone -> ""-        WsSpace -> " "-        WsBreak -> "\n"-        WsBreakAndIndent _ -> "\n"-        WsDoubleBreak -> "\n\n"-  ExprBrackets (BracketExpr (Brackets (Symbol l) (Symbol r)) e style) ->-      l ++ pre ++ ibody ++ suf ++ r-    where-      body = printExpr e-      ibody = case doIndent of-         Nothing -> body-         Just idt -> customIndent idt body-      pre = if nlBefore then "\n" else ""-      suf = if nlAfter then "\n" else ""-      BlockStyle doIndent nlBefore nlAfter = style--sep :: Op -> [Expr] -> Expr-sep op els =  case els of-  [] -> cst ""-  [x] -> x-  (h:r) -> ifx op h $ sep op r--spaceSep :: [Expr] -> Expr-spaceSep = sep $ Op (sym "") (Padding WsSpace WsNone) (Precedence 0) AssociativityNone--squareBrackets :: Brackets-squareBrackets = Brackets (sym "[") (sym "]")--sym :: String -> Symbol-sym = Symbol--symbolSep :: String -> BlockStyle -> [Expr] -> Expr-symbolSep symb style l = case l of-    [] -> cst ""-    [x] -> x-    (h:r) -> ifx commaOp h $ symbolSep symb style r-  where-    break = case L.length $ L.filter id [blockStyleNewlineBeforeContent style, blockStyleNewlineAfterContent style] of-      0 -> WsSpace-      1 -> WsBreak-      2 -> WsDoubleBreak-    commaOp = Op (sym symb) (Padding WsNone break) (Precedence 0) AssociativityNone -- No source
− src/main/haskell/Hydra/Tools/Sorting.hs 
@@ -1,44 +0,0 @@--- | Utilities for sorting--module Hydra.Tools.Sorting (-  topologicalSort,-  topologicalSortComponents,-  initGraph-) where--import qualified Data.List as L-import qualified Data.Bifunctor as BF--import qualified Data.Graph as G----- | Sort a directed acyclic graph (DAG) based on an adjacency list---   Yields a list of nontrivial strongly connected components if the graph has cycles-topologicalSort :: Ord a => [(a, [a])] -> Either [[a]] [a]-topologicalSort pairs = if L.null withCycles-    then Right $ L.concat sccs-    else Left withCycles-  where-    sccs = topologicalSortComponents pairs-    withCycles = L.filter isCycle sccs-    isCycle = not . L.null . L.tail---- | Find the strongly connected components (including cycles and isolated vertices) of a graph, in (reverse) topological order-topologicalSortComponents :: Ord a => [(a, [a])] -> [[a]]-topologicalSortComponents pairs = L.sort <$> (fmap (getKey nodeFromVertex) . treeToList) <$> G.scc g-  where-    (g, nodeFromVertex) = initGraph pairs--treeToList :: G.Tree a -> [a]-treeToList (G.Node root subforest) = root:(L.concat (treeToList <$> subforest))--getKey :: (G.Vertex -> ((), a, [a])) -> G.Vertex -> a-getKey nodeFromVertex v = n-  where-    (_, n, _) = nodeFromVertex v--initGraph :: Ord a => [(a, [a])] -> (G.Graph, G.Vertex -> ((), a, [a]))-initGraph pairs = (g, nodeFromVertex)-  where-    (g, nodeFromVertex, _) = G.graphFromEdges (toEdge <$> pairs)-    toEdge (key, keys) = ((), key, keys)
− src/main/haskell/Hydra/Tools/Templating.hs 
@@ -1,111 +0,0 @@--- | A utility which instantiates a nonrecursive type with default values.--module Hydra.Tools.Templating where--import Hydra.Kernel--import qualified Data.Map as M-import qualified Data.Set as S----- | Create a graph schema from a graph which contains nothing but encoded type definitions.-graphToSchema :: Graph -> Flow Graph (M.Map Name Type)-graphToSchema g = M.fromList <$> (mapM toPair $ M.toList $ graphElements g)-  where-    toPair (name, el) = do-      t <- coreDecodeType $ elementData el-      return (name, t)---- | Given a graph schema and a nonrecursive type, instantiate it with default values.---   If the minimal flag is set, the smallest possible term is produced; otherwise,---   exactly one subterm is produced for constructors which do not otherwise require one, e.g. in lists and optionals.-insantiateTemplate :: Bool -> M.Map Name Type -> Type -> Flow s Term-insantiateTemplate minimal schema t = case t of-    TypeAnnotated (AnnotatedType t _) -> inst t-    TypeApplication _ -> noPoly-    TypeFunction _ -> noPoly-    TypeLambda _ -> noPoly-    TypeList et -> if minimal-      then pure $ TermList []-      else do-        e <- inst et-        return $ TermList [e]-    TypeLiteral lt -> pure $ TermLiteral $ case lt of-      LiteralTypeBinary -> LiteralString ""-      LiteralTypeBoolean -> LiteralBoolean False-      LiteralTypeInteger it -> LiteralInteger $ case it of-        IntegerTypeBigint -> IntegerValueBigint 0-        IntegerTypeInt8 -> IntegerValueInt8 0-        IntegerTypeInt16 -> IntegerValueInt16 0-        IntegerTypeInt32 -> IntegerValueInt32 0-        IntegerTypeInt64 -> IntegerValueInt64 0-        IntegerTypeUint8 -> IntegerValueUint8 0-        IntegerTypeUint16 -> IntegerValueUint16 0-        IntegerTypeUint32 -> IntegerValueUint32 0-        IntegerTypeUint64 -> IntegerValueUint64 0-      LiteralTypeFloat ft -> LiteralFloat $ case ft of-        FloatTypeBigfloat -> FloatValueBigfloat 0-        FloatTypeFloat32 -> FloatValueFloat32 0-        FloatTypeFloat64 -> FloatValueFloat64 0-      LiteralTypeString -> LiteralString ""-    TypeMap (MapType kt vt) -> if minimal-      then return $ TermMap M.empty-      else do-        ke <- inst kt-        ve <- inst vt-        return $ TermMap $ M.singleton ke ve-    TypeOptional ot -> if minimal-      then return $ TermOptional Nothing-      else do-        e <- inst ot-        return $ TermOptional $ Just e-    TypeProduct types -> do-      es <- mapM inst types-      return $ TermProduct es-    TypeRecord (RowType tname fields) -> do-      dfields <- mapM toField fields-      return $ TermRecord $ Record tname dfields-      where-        toField ft = do-          e <- inst $ fieldTypeType ft-          return $ Field (fieldTypeName ft) e-    TypeSet et -> if minimal-        then return $ TermSet S.empty-        else do-          e <- inst et-          return $ TermSet $ S.fromList [e]---     TypeStream et -> ...---     TypeSum types -> ...---     TypeUnion (RowType tname _ fields) -> ...-    TypeVariable tname -> case M.lookup tname schema of-      Just t' -> inst t'-      Nothing -> fail $ "Type variable " ++ show tname ++ " not found in schema"-    TypeWrap (WrappedType tname t') -> do-      e <- inst t'-      return $ TermWrap $ WrappedTerm tname e-  where-    inst = insantiateTemplate minimal schema-    noPoly = fail "Polymorphic and function types are not currently supported"---{----- Example of type-to-term instantiation which creates a YAML-based template out of the OpenCypher feature model.--import Hydra.Ext.Yaml.Model as Yaml-import Hydra.Flows-import Data.Map as M-import Data.Maybe as Y--ff = fromFlowIo bootstrapGraph--schema <- ff $ graphToSchema $ modulesToGraph [openCypherFeaturesModule]--typ <- ff $ inlineType schema $ Y.fromJust $ M.lookup _CypherFeatures schema-term <- ff $ insantiateTemplate False schema typ--encoder <- ff (coderEncode <$> yamlCoder typ)-yaml <- ff $ encoder term-putStrLn $ hydraYamlToString yaml---}
− src/main/haskell/Hydra/Unification.hs 
@@ -1,111 +0,0 @@--- | Hindley-Milner style type unification--module Hydra.Unification (-  solveConstraints-) where--import Hydra.Basics-import Hydra.Strip-import Hydra.Compute-import Hydra.Core-import Hydra.Lexical-import Hydra.Mantle-import Hydra.Printing-import Hydra.Rewriting-import Hydra.Inference.Substitution-import Hydra.Tier1-import Hydra.Dsl.Types as Types-import Hydra.Lib.Io--import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S----- Note: type variables in Hydra are allowed to bind to type expressions which contain the variable;---       i.e. type recursion by name is allowed.-bind :: Name -> Type -> Flow s Subst-bind name typ = do-  if typ == TypeVariable name-  then return M.empty-  else if variableOccursInType name typ---     then fail $ "infinite type for " ++ unName name ++ ": " ++ show typ-    then return M.empty-    else return $ M.singleton name typ--solveConstraints :: [TypeConstraint] -> Flow s Subst-solveConstraints cs = unificationSolver M.empty cs--unificationSolver :: Subst -> [TypeConstraint] -> Flow s Subst-unificationSolver su cs = case cs of-  [] -> return su-  ((TypeConstraint t1 t2 _):rest) -> do-    su1  <- unify t1 t2-    unificationSolver-      (composeSubst su1 su)-      ((\(TypeConstraint t1 t2 ctx) -> (TypeConstraint (substituteInType su1 t1) (substituteInType su1 t2) ctx)) <$> rest)--unify :: Type -> Type -> Flow s Subst-unify ltyp rtyp = do---     withTrace ("unify " ++ show ltyp ++ " with " ++ show rtyp) $-     case (stripType ltyp, stripType rtyp) of-       -- Symmetric patterns-      (TypeApplication (ApplicationType lhs1 rhs1), TypeApplication (ApplicationType lhs2 rhs2)) ->-        unifyMany [lhs1, rhs1] [lhs2, rhs2]-      (TypeFunction (FunctionType dom1 cod1), TypeFunction (FunctionType dom2 cod2)) ->-        unifyMany [dom1, cod1] [dom2, cod2]-      (TypeList lt1, TypeList lt2) -> unify lt1 lt2-      (TypeLiteral lt1, TypeLiteral lt2) -> verify "different literal types" $ lt1 == lt2-      (TypeMap (MapType k1 v1), TypeMap (MapType k2 v2)) -> unifyMany [k1, v1] [k2, v2]-      (TypeOptional ot1, TypeOptional ot2) -> unify ot1 ot2-      (TypeProduct types1, TypeProduct types2) -> unifyMany types1 types2-      (TypeRecord rt1, TypeRecord rt2) -> do-        verify "different record type names" (rowTypeTypeName rt1 == rowTypeTypeName rt2)-        verify "different number of record fields" (L.length (rowTypeFields rt1) == L.length (rowTypeFields rt2))-        unifyMany (fieldTypeType <$> rowTypeFields rt1) (fieldTypeType <$> rowTypeFields rt2)-      (TypeSet st1, TypeSet st2) -> unify st1 st2-      (TypeUnion rt1, TypeUnion rt2) -> verify "different union type names" (rowTypeTypeName rt1 == rowTypeTypeName rt2)-      (TypeLambda (LambdaType (Name v1) body1), TypeLambda (LambdaType (Name v2) body2)) ->-        unifyMany [Types.var v1, body1] [Types.var v2, body2]-      (TypeSum types1, TypeSum types2) -> unifyMany types1 types2-      (TypeWrap n1, TypeWrap n2) -> verify "different wrapper type names" $ n1 == n2--      -- Asymmetric patterns-      (TypeVariable v1, TypeVariable v2) -> bindWeakest v1 v2-      (TypeVariable v, t2) -> bind v t2-      (t1, TypeVariable v) -> bind v t1--      -- TODO; temporary "slop", e.g. (record "RowType" ...) is allowed to unify with (wrap "RowType" @ "a")-      (TypeApplication (ApplicationType lhs rhs), t2) -> unify lhs t2-      (t1, TypeApplication (ApplicationType lhs rhs)) -> unify t1 lhs-      (TypeLambda (LambdaType _ body), t2) -> unify body t2-      (t1, TypeLambda (LambdaType _ body)) -> unify t1 body-      -- TODO; temporary "slop", e.g. (record "RowType" ...) is allowed to unify with (wrap "RowType")-      (TypeWrap _, _) -> return M.empty -- TODO-      (_, TypeWrap name) -> return M.empty -- TODO--      (l, r) -> fail $ "unification of " ++ show (typeVariant l) ++ " with " ++ show (typeVariant r) ++-        ":\n  " ++ showType l ++-        "\n  " ++ showType r-  where-    verify reason b = if b then return M.empty else failUnification reason-    failUnification reason = fail $ "could not unify types (reason: " ++ reason ++ "):\n\t"-      ++ showType (stripType ltyp) ++ "\n\t"-      ++ showType (stripType rtyp) ++ "\n"---     failUnification = fail $ "could not unify type " ++ describeType (stripType ltyp) ++ " with " ++ describeType (stripType rtyp)-    bindWeakest v1 v2 = if isWeak v1-        then bind v1 (TypeVariable v2)-        else bind v2 (TypeVariable v1)-      where-        isWeak v = L.head (unName v) == 't' -- TODO: use a convention like _xxx for temporarily variables, then normalize and replace them--unifyMany :: [Type] -> [Type] -> Flow s Subst-unifyMany [] [] = return M.empty-unifyMany (t1 : ts1) (t2 : ts2) =-  do su1 <- unify t1 t2-     su2 <- unifyMany (substituteInType su1 <$> ts1) (substituteInType su1 <$> ts2)-     return (composeSubst su2 su1)-unifyMany t1 t2 = fail $ "unification mismatch between " ++ show t1 ++ " and " ++ show t2--variableOccursInType :: Name -> Type -> Bool-variableOccursInType a t = S.member a $ freeVariablesInType t
+ src/test/haskell/Hydra/Adapt/LiteralsSpec.hs view
@@ -0,0 +1,138 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.Adapt.LiteralsSpec.spec+-}++module Hydra.Adapt.LiteralsSpec where++import Hydra.Kernel++import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+++testFloatAdapter :: H.SpecWith ()+testFloatAdapter = H.describe "Test floating-point adapter" $ do++  H.it "upgrade float32 to bigfloat, since float32 and float64 are unsupported" $+    QC.property $ \f -> checkFloatAdapter+      [FloatTypeBigfloat]+      FloatTypeFloat32 FloatTypeBigfloat False+      (FloatValueFloat32 f) (FloatValueBigfloat $ realToFrac f)++  H.it "downgrade bigfloat to float64" $+    QC.property $ \d -> checkFloatAdapter+      [FloatTypeFloat32, FloatTypeFloat64]+      FloatTypeBigfloat FloatTypeFloat64 True+      (FloatValueBigfloat d) (FloatValueFloat64 $ realToFrac d)++  H.it "downgrade bigfloat to float32, since float64 is unsupported" $+    QC.property $ \d -> checkFloatAdapter+      [FloatTypeFloat32]+      FloatTypeBigfloat FloatTypeFloat32 True+      (FloatValueBigfloat d) (FloatValueFloat32 $ realToFrac d)++  H.it "bigfloat is supported and remains unchanged" $+    QC.property $ \d -> checkFloatAdapter+      [FloatTypeFloat32, FloatTypeBigfloat]+      FloatTypeBigfloat FloatTypeBigfloat False+      (FloatValueBigfloat d) (FloatValueBigfloat d)++testIntegerAdapter :: H.SpecWith ()+testIntegerAdapter = H.describe "Test integer adapter" $ do++  H.it "upgrade uint8 to uint16, not int16" $+    QC.property $ \b -> checkIntegerAdapter+      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]+      IntegerTypeUint8 IntegerTypeUint16 False+      (IntegerValueUint8 b) (IntegerValueUint16 $ fromIntegral b)++  H.it "upgrade int8 to int16, not uint16" $+    QC.property $ \b -> checkIntegerAdapter+      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]+      IntegerTypeInt8 IntegerTypeInt16 False+      (IntegerValueInt8 b) (IntegerValueInt16 $ fromIntegral b)++  H.it "upgrade uint8 to int16 when uint16 is not supported" $+    QC.property $ \b -> checkIntegerAdapter+      [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]+      IntegerTypeUint8 IntegerTypeInt16 False+      (IntegerValueUint8 b) (IntegerValueInt16 $ fromIntegral b)++  H.it "cross-convert uint32 to int32, even when uint16 is supported" $+    QC.property $ \b -> checkIntegerAdapter+      [IntegerTypeUint16, IntegerTypeInt32]+      IntegerTypeUint32 IntegerTypeInt32 True+      (IntegerValueUint32 b) (IntegerValueInt32 $ fromIntegral b)++  H.it "downgrade bigint to int32, not uint32" $+    QC.property $ \b -> checkIntegerAdapter+      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeInt32, IntegerTypeUint32]+      IntegerTypeBigint IntegerTypeInt32 True+      (IntegerValueBigint b) (IntegerValueInt32 $ fromIntegral b)++  H.it "upgrade uint64 to bigint when supported" $+    QC.property $ \i -> checkIntegerAdapter+      [IntegerTypeInt32, IntegerTypeUint32, IntegerTypeBigint]+      IntegerTypeUint64 IntegerTypeBigint False+      (IntegerValueUint64 i) (IntegerValueBigint $ fromIntegral i)++  H.it "downgrade uint64 to uint32 when bigint is unsupported" $+    QC.property $ \i -> checkIntegerAdapter+      [IntegerTypeInt32, IntegerTypeUint32]+      IntegerTypeUint64 IntegerTypeUint32 True+      (IntegerValueUint64 i) (IntegerValueUint32 $ fromIntegral i)++  H.it "upgrade int64 to bigint when supported" $+    QC.property $ \i -> checkIntegerAdapter+      [IntegerTypeBigint]+      IntegerTypeInt64 IntegerTypeBigint False+      (IntegerValueInt64 i) (IntegerValueBigint $ fromIntegral i)++testLiteralAdapter :: H.SpecWith ()+testLiteralAdapter = H.describe "Test literal adapter" $ do++  H.it "encode binary data as strings" $+    QC.property $ \b -> checkLiteralAdapter+      [LiteralVariantString]+      LiteralTypeBinary LiteralTypeString False+      (LiteralBinary b) (LiteralString b)++  H.it "encode booleans as strings" $+    QC.property $ \b -> checkLiteralAdapter+      [LiteralVariantString]+      LiteralTypeBoolean LiteralTypeString False+      (LiteralBoolean b) (LiteralString $ if b then "true" else "false")++  H.it "encode booleans as integers" $+    QC.property $ \b -> checkLiteralAdapter+      [LiteralVariantInteger]+      LiteralTypeBoolean (LiteralTypeInteger IntegerTypeInt16) False+      (LiteralBoolean b) (LiteralInteger $ IntegerValueInt16 $ if b then 1 else 0)++  H.it "floating-point encoding is delegated to the float adapter" $+    QC.property $ \f -> checkLiteralAdapter+      [LiteralVariantFloat]+      (LiteralTypeFloat FloatTypeBigfloat) (LiteralTypeFloat FloatTypeFloat32) True+      (LiteralFloat $ FloatValueBigfloat f) (LiteralFloat $ FloatValueFloat32 $ realToFrac f)++  H.it "integer encoding is delegated to the integer adapter" $+    QC.property $ \i -> checkLiteralAdapter+      [LiteralVariantInteger]+      (LiteralTypeInteger IntegerTypeBigint) (LiteralTypeInteger IntegerTypeInt32) True+      (LiteralInteger $ IntegerValueBigint i) (LiteralInteger $ IntegerValueInt32 $ fromIntegral i)++  H.it "strings are unchanged" $+    QC.property $ \s -> checkLiteralAdapter+      [LiteralVariantString]+      LiteralTypeString LiteralTypeString False+      (LiteralString s) (LiteralString s)++spec :: H.Spec+spec = do+  testFloatAdapter+  testIntegerAdapter+  testLiteralAdapter
+ src/test/haskell/Hydra/Adapt/TermsSpec.hs view
@@ -0,0 +1,308 @@+module Hydra.Adapt.TermsSpec where++import Hydra.Kernel+import Hydra.Adapt.Terms+import Hydra.Adapt.Utils+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Data.Map as M+import qualified Test.QuickCheck as QC+import qualified Data.Set as S+import qualified Data.Maybe as Y+++constraintsAreAsExpected :: H.SpecWith ()+constraintsAreAsExpected = H.describe "Verify that the language constraints include/exclude the appropriate types" $ do++    H.it "int16, int32, and bigint are supported in the test context" $ do+      typeIsSupported (context [TypeVariantLiteral]) Types.int16 `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral]) Types.int32 `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral]) Types.bigint `H.shouldBe` True++    H.it "int8 and uint32 are unsupported in the test context" $ do+      typeIsSupported (context [TypeVariantLiteral]) Types.int8 `H.shouldBe` False+      typeIsSupported (context [TypeVariantLiteral]) Types.uint32 `H.shouldBe` False++    -- Note: floating-point constraints are untested++    H.it "Records are supported, but unions are not" $ do+      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) testTypeLatLon `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) stringOrIntType `H.shouldBe` False++    H.it "Records are supported if and only if each of their fields are supported" $ do+      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])+        (TypeRecord $ RowType (Name "Example") [Types.field "first" Types.string, Types.field "second" Types.int16])+        `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])+        (TypeRecord $ RowType (Name "Example") [Types.field "first" Types.string, Types.field "second" Types.int8])+        `H.shouldBe` False++    H.it "Lists are supported if the list element type is supported" $ do+      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfStringsType `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfListsOfStringsType `H.shouldBe` True+      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfSetOfStringsType `H.shouldBe` False++  where+    context = languageConstraints . adapterContextLanguage . termTestContext++supportedConstructorsAreUnchanged :: H.SpecWith ()+supportedConstructorsAreUnchanged = H.describe "Verify that supported term constructors are unchanged" $ do++  H.it "Strings (and other supported literal values) pass through without change" $+    QC.property $ \b -> checkDataAdapter+      [TypeVariantLiteral]+      Types.string+      Types.string+      False+      (string b)+      (string b)++  H.it "Lists (when supported) pass through without change" $+    QC.property $ \strings -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantList]+      listOfStringsType+      listOfStringsType+      False+      (list $ string <$> strings)+      (list $ string <$> strings)++  H.it "Maps (when supported) pass through without change" $+    QC.property $ \keyvals -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantMap]+      mapOfStringsToIntsType+      mapOfStringsToIntsType+      False+      (makeMap keyvals)+      (makeMap keyvals)++  H.it "Optionals (when supported) pass through without change" $+    QC.property $ \mi -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantOptional]+      optionalInt8Type+      optionalInt16Type+      False+      (optional $ int8 <$> mi)+      (optional $ int16 . fromIntegral <$> mi)++  H.it "Records (when supported) pass through without change" $+    QC.property $ \a1 a2 -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantRecord]+      (TypeRecord $ RowType testTypeName [Types.field "first" Types.string, Types.field "second" Types.int8])+      (TypeRecord $ RowType testTypeName [Types.field "first" Types.string, Types.field "second" Types.int16])+      False+      (record testTypeName [field "first" $ string a1, field "second" $ int8 a2])+      (record testTypeName [field "first" $ string a1, field "second" $ int16 $ fromIntegral a2])++  H.it "Unions (when supported) pass through without change" $+    QC.property $ \int -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantUnion]+      stringOrIntType+      stringOrIntType+      False+      (variant stringOrIntName (Name "right") $ int32 int)+      (variant stringOrIntName (Name "right") $ int32 int)++  H.it "Sets (when supported) pass through without change" $+    QC.property $ \strings -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantSet]+      setOfStringsType+      setOfStringsType+      False+      (stringSet strings)+      (stringSet strings)++  H.it "Primitive function references (when supported) pass through without change" $+    QC.property $ \name -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantFunction]+      concatType+      concatType+      False+      (primitive name)+      (primitive name)++  H.it "Projections (when supported) pass through without change" $+    QC.property $ \fname -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantFunction, TypeVariantRecord]+      exampleProjectionType+      exampleProjectionType+      False+      (project testTypePersonName fname)+      (project testTypePersonName fname)++unsupportedConstructorsAreModified :: H.SpecWith ()+unsupportedConstructorsAreModified = H.describe "Verify that unsupported term constructors are changed in the expected ways" $ do++  H.it "Sets (when unsupported) become lists" $+    QC.property $ \strings -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantList]+      setOfStringsType+      listOfStringsType+      False+      (stringSet strings)+      (stringList $ S.toList strings)++  H.it "Optionals (when unsupported) become lists" $+    QC.property $ \ms -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantList]+      (Types.optional Types.string)+      (Types.list Types.string)+      False+      (optional $ string <$> ms)+      (list $ Y.maybe [] (\s -> [string s]) ms)++  H.it "Primitive function references (when unsupported) become variant terms" $+    QC.property $ \name -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]+      concatType+      (functionProxyType Types.string)+      False+      (primitive name)+      (inject functionProxyName $ field "primitive" $ string $ unName name) -- Note: the function name is not dereferenced++--  H.it "Projections (when unsupported) become variant terms" $+--    QC.property $ \fname -> checkDataAdapter+--      [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]+--      exampleProjectionType+--      (functionProxyType testTypePerson)+--      False+--      (project testTypePersonName fname)+--      (inject functionProxyName $ field "record" $ string $+--        show (project testTypePersonName fname :: Term)) -- Note: the field name is not dereferenced++--  H.it "Nominal types (when unsupported) are dereferenced" $+--    QC.property $ \s -> checkDataAdapter+--      [TypeVariantLiteral, TypeVariantAnnotated]+--      testTypeStringAlias+--      (TypeAnnotated $ Annotated Types.string $ Kv $+--        M.fromList [(key_description, Terms.string "An alias for the string type")])+--      False+--      (string s)+--      (string s)++  H.it "Unions (when unsupported) become records" $+    QC.property $ \i -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantOptional, TypeVariantRecord]+      eitherStringOrInt8Type+      (TypeRecord $ RowType eitherStringOrInt8TypeName [+        Types.field "left" $ Types.optional Types.string,+        Types.field "right" $ Types.optional Types.int16])+      False+      (inject eitherStringOrInt8TypeName $ field "right" $ int8 i)+      (record eitherStringOrInt8TypeName [+        field "left" $ optional Nothing,+        field "right" $ optional $ Just $ int16 $ fromIntegral i])++termsAreAdaptedRecursively :: H.SpecWith ()+termsAreAdaptedRecursively = H.describe "Verify that the adapter descends into subterms and transforms them appropriately" $ do++  H.it "A list of int8's becomes a list of int32's" $+    QC.property $ \ints -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantList]+      listOfInt8sType+      listOfInt16sType+      False+      (list $ int8 <$> ints)+      (list $ int16 . fromIntegral <$> ints)++  H.it "A list of sets of strings becomes a list of lists of strings" $+    QC.property $ \lists -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantList]+      listOfSetOfStringsType+      listOfListsOfStringsType+      False+      (list $ (\l -> set $ S.fromList $ string <$> l) <$> lists)+      (list $ (\l -> list $ string <$> S.toList (S.fromList l)) <$> lists)++  H.it "A wrapped int64 becomes a wrapped bigint" $+    QC.property $ \i -> checkDataAdapter+      [TypeVariantLiteral, TypeVariantWrap]+      (Types.wrapWithName aliasName Types.int64)+      (Types.wrapWithName aliasName Types.bigint)+      False+      (wrap aliasName $ int64 i)+      (wrap aliasName $ bigint $ fromIntegral i)+  where+    aliasName = Name "MyAlias"++roundTripsPreserveSelectedTypes :: H.SpecWith ()+roundTripsPreserveSelectedTypes = H.describe "Verify that the adapter is information preserving, i.e. that round-trips are no-ops" $ do++  H.it "Check strings (pass-through)" $+    QC.property $ \s -> roundTripIsNoop Types.string (string s)++  H.it "Check lists (pass-through)" $+    QC.property $ \strings -> roundTripIsNoop listOfStringsType (list $ string <$> strings)++  H.it "Check sets (which map to lists)" $+    QC.property $ \strings -> roundTripIsNoop setOfStringsType (stringSet strings)++  H.it "Check primitive function references (which map to variants)" $+    QC.property $ \name -> roundTripIsNoop concatType (primitive name)++--  H.it "Check projection terms (which map to variants)" $+--    QC.property $ \fname -> roundTripIsNoop exampleProjectionType (project testTypePersonName fname)++  H.it "Check newtype terms (which pass through as instances of the aliased type)" $+    QC.property $ \s -> roundTripIsNoop testTypeStringAlias (wrap testTypeStringAliasName $ string s)++--roundTripsPreserveArbitraryTypes :: H.SpecWith ()+--roundTripsPreserveArbitraryTypes = H.describe "Verify that the adapter is information preserving for arbitrary typed terms" $ do+--+--  H.it "Check arbitrary type/term pairs" $+--    QC.property $ \(TypedTerm term typ) -> roundTripIsNoop typ term++fieldAdaptersAreAsExpected :: H.SpecWith ()+fieldAdaptersAreAsExpected = H.describe "Check that field adapters are as expected" $ do++  H.it "An int8 field becomes an int16 field" $+    QC.property $ \i -> checkFieldAdapter+      [TypeVariantLiteral, TypeVariantRecord]+      (Types.field "second" Types.int8)+      (Types.field "second" Types.int16)+      False+      (field "second" $ int8 i)+      (field "second" $ int16 $ fromIntegral i)++roundTripIsNoop :: Type -> Term -> H.Expectation+roundTripIsNoop typ term = shouldSucceedWith+   (step coderEncode term >>= step coderDecode)+   term+  where+    step = adapt typ++    -- Use a YAML-like language (but supporting unions) as the default target language+    testLanguage = Language (LanguageName "hydra.test") $ LanguageConstraints {+      languageConstraintsEliminationVariants = S.empty, -- S.fromList eliminationVariants,+      languageConstraintsLiteralVariants = S.fromList [+        LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],+      languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],+      languageConstraintsFunctionVariants = S.empty,+      languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],+      languageConstraintsTermVariants = S.fromList termVariants,+      languageConstraintsTypeVariants = S.fromList [+        TypeVariantAnnotated, TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantRecord, TypeVariantUnion],+      languageConstraintsTypes = \typ -> case deannotateType typ of+        TypeOptional (TypeOptional _) -> False+        _ -> True }++    -- Note: in a real application, you wouldn't create the adapter just to use it once;+    --       it should be created once, then applied to many terms.+    adapt typ dir term = do+      adapter <- languageAdapter testLanguage typ+      dir (adapterCoder adapter) term++spec :: H.Spec+spec = do+  constraintsAreAsExpected+  supportedConstructorsAreUnchanged+  unsupportedConstructorsAreModified+  termsAreAdaptedRecursively+  roundTripsPreserveSelectedTypes+--  roundTripsPreserveArbitraryTypes -- TODO: restore me+  fieldAdaptersAreAsExpected
src/test/haskell/Hydra/ArbitraryCore.hs view
@@ -1,5 +1,5 @@ -{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for QC.Arbitrary (Term) and QC.Arbitrary (Type)+{-# LANGUAGE FlexibleInstances #-} -- TODO: temporary, for QC.Arbitrary Term and QC.Arbitrary Type module Hydra.ArbitraryCore where  import Hydra.Kernel@@ -72,7 +72,7 @@       IntegerValueUint32 <$> QC.arbitrary,       IntegerValueUint64 <$> QC.arbitrary] -instance QC.Arbitrary (Term) where+instance QC.Arbitrary Term where   arbitrary = (\(TypedTerm term _) -> term) <$> QC.sized arbitraryTypedTerm  instance QC.Arbitrary Name@@ -80,7 +80,7 @@     arbitrary = Name <$> QC.arbitrary     shrink (Name name)= Name <$> QC.shrink name -instance QC.Arbitrary (Type) where+instance QC.Arbitrary Type where   arbitrary = QC.sized arbitraryType   shrink typ = case typ of     TypeLiteral at -> Types.literal <$> case at of@@ -89,7 +89,7 @@       _ -> []     _ -> [] -- TODO -instance QC.Arbitrary (TypedTerm) where+instance QC.Arbitrary TypedTerm where   arbitrary = QC.sized arbitraryTypedTerm   shrink (TypedTerm term typ) = L.concat ((\(t, m) -> TypedTerm <$> m term <*> pure t) <$> shrinkers typ) @@ -101,7 +101,7 @@   LiteralTypeInteger it -> LiteralInteger <$> arbitraryIntegerValue it   LiteralTypeString -> LiteralString <$> QC.arbitrary -arbitraryField :: FieldType -> Int -> QC.Gen (Field)+arbitraryField :: FieldType -> Int -> QC.Gen Field arbitraryField (FieldType fn ft) n = Field fn <$> arbitraryTerm ft n  arbitraryFieldType :: Int -> QC.Gen (FieldType)@@ -114,7 +114,7 @@   FloatTypeFloat64 -> FloatValueFloat64 <$> QC.arbitrary  -- Note: primitive functions and data terms are not currently generated, as they require a context.-arbitraryFunction :: FunctionType -> Int -> QC.Gen (Function)+arbitraryFunction :: FunctionType -> Int -> QC.Gen Function arbitraryFunction (FunctionType dom cod) n = QC.oneof $ defaults ++ domainSpecific   where     n' = decr n@@ -135,10 +135,6 @@           n2 = div n' $ L.length sfields         -- Note: projections now require nominally-typed records --      TypeRecord sfields -> [FunctionProjection <$> (fieldTypeName <$> QC.elements sfields) | not (L.null sfields)]---      TypeOptional ot -> [FunctionOptionalCases <$> (---        OptionalCases <$> arbitraryTerm cod n'---          <*> (TermFunction---          <$> arbitraryFunction (FunctionType ot cod) n'))]       _ -> []  arbitraryIntegerValue :: IntegerType -> QC.Gen IntegerValue@@ -172,7 +168,7 @@   where n' = div n 2  -- Note: variables and function applications are not (currently) generated-arbitraryTerm :: Type -> Int -> QC.Gen (Term)+arbitraryTerm :: Type -> Int -> QC.Gen Term arbitraryTerm typ n = case typ of     TypeLiteral at -> literal <$> arbitraryLiteral at     TypeFunction ft -> TermFunction <$> arbitraryFunction ft n'@@ -193,6 +189,7 @@       let fn = fieldTypeName f       ft <- arbitraryTerm (fieldTypeType f) n'       return $ Field fn ft+    TypeUnit -> pure TermUnit   where     n' = decr n     arbitraryFields sfields = if L.null sfields@@ -202,7 +199,7 @@         n2 = div n' $ L.length sfields  -- Note: nominal types and element types are not currently generated, as instantiating them requires a context-arbitraryType :: Int -> QC.Gen (Type)+arbitraryType :: Int -> QC.Gen Type arbitraryType n = if n == 0 then pure Types.unit else QC.oneof [     TypeLiteral <$> QC.arbitrary,     TypeFunction <$> arbitraryPair FunctionType arbitraryType n',@@ -214,7 +211,7 @@ --    TypeUnion <$> arbitraryList True arbitraryFieldType n'] -- TODO: avoid duplicate field names   where n' = decr n -arbitraryTypedTerm :: Int -> QC.Gen (TypedTerm)+arbitraryTypedTerm :: Int -> QC.Gen TypedTerm arbitraryTypedTerm n = do     typ <- arbitraryType n'     term <- arbitraryTerm typ n'
src/test/haskell/Hydra/CoreCodersSpec.hs view
@@ -3,6 +3,8 @@ import Hydra.Kernel import Hydra.Dsl.Terms as Terms import qualified Hydra.Dsl.Types as Types+import qualified Hydra.Decode.Core as DecodeCore+import qualified Hydra.Encode.Core as EncodeCore  import Hydra.TestData import Hydra.TestUtils@@ -19,22 +21,22 @@      H.it "string literal type" $ do       H.shouldBe-        (strip $ coreEncodeLiteralType LiteralTypeString :: Term)+        (strip $ EncodeCore.literalType LiteralTypeString :: Term)         (strip $ unitVariant _LiteralType _LiteralType_string)      H.it "string type" $ do       H.shouldBe-        (strip $ coreEncodeType Types.string :: Term)+        (strip $ EncodeCore.type_ Types.string :: Term)         (strip $ variant _Type _Type_literal (unitVariant _LiteralType _LiteralType_string))      H.it "int32 type" $ do       H.shouldBe-        (strip $ coreEncodeType Types.int32 :: Term)+        (strip $ EncodeCore.type_ Types.int32 :: Term)         (strip $ variant _Type _Type_literal (variant _LiteralType _LiteralType_integer $ unitVariant _IntegerType _IntegerType_int32))      H.it "record type" $ do       H.shouldBe-        (strip $ coreEncodeType (TypeRecord $ RowType (Name "Example")+        (strip $ EncodeCore.type_ (TypeRecord $ RowType (Name "Example")           [Types.field "something" Types.string, Types.field "nothing" Types.unit]) :: Term)         (strip $ variant _Type _Type_record $           record _RowType [@@ -45,9 +47,7 @@                 Field _FieldType_type $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_string],               record _FieldType [                 Field _FieldType_name $ wrap _Name $ string "nothing",-                Field _FieldType_type $ variant _Type _Type_record $ record _RowType [-                  Field _RowType_typeName $ wrap _Name $ string "hydra/core.Unit",-                  Field _RowType_fields $ list []]]]])+                Field _FieldType_type $ unitVariant _Type _Type_unit]]])  individualDecoderTestCases :: H.SpecWith () individualDecoderTestCases = do@@ -55,19 +55,19 @@      H.it "float32 literal type" $ do       shouldSucceedWith-        (coreDecodeLiteralType+        (DecodeCore.literalType           (variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))         (LiteralTypeFloat FloatTypeFloat32)      H.it "float32 type" $ do       shouldSucceedWith-        (coreDecodeType+        (DecodeCore.type_           (variant _Type _Type_literal $ variant _LiteralType _LiteralType_float $ unitVariant _FloatType _FloatType_float32))         Types.float32      H.it "union type" $ do       shouldSucceedWith-        (coreDecodeType $+        (DecodeCore.type_ $           variant _Type _Type_union $ record _RowType [             Field _RowType_typeName $ wrap _Name $ string (unName testTypeName),             Field _RowType_fields $@@ -89,10 +89,10 @@   H.describe "Decode invalid terms" $ do      H.it "Try to decode a term with wrong fields for Type" $ do-      shouldFail (coreDecodeType $ variant untyped (Name "unknownField") $ list [])+      shouldFail (DecodeCore.type_ $ variant untyped (Name "unknownField") $ list [])      H.it "Try to decode an incomplete representation of a Type" $ do-      shouldFail (coreDecodeType $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer)+      shouldFail (DecodeCore.type_ $ variant _Type _Type_literal $ unitVariant _LiteralType _LiteralType_integer)  metadataIsPreserved :: H.SpecWith () metadataIsPreserved = do@@ -100,13 +100,13 @@      H.it "Basic metadata" $ do       shouldSucceedWith-        (coreDecodeType $ coreEncodeType annotatedStringType)+        (DecodeCore.type_ $ EncodeCore.type_ annotatedStringType)         annotatedStringType   where     annotatedStringType :: Type     annotatedStringType = TypeAnnotated $ AnnotatedType Types.string $ M.fromList [       (key_description, Terms.string "The string literal type"),-      (key_type, coreEncodeType $ TypeVariable _Type)]+      (key_type, EncodeCore.type_ $ TypeVariable _Type)]  testRoundTripsFromType :: H.SpecWith () testRoundTripsFromType = do@@ -115,7 +115,7 @@     H.it "Try random types" $       QC.property $ \typ ->         shouldSucceedWith-          (coreDecodeType $ coreEncodeType typ)+          (DecodeCore.type_ $ EncodeCore.type_ typ)           typ  spec :: H.Spec
src/test/haskell/Hydra/Dsl/TypesSpec.hs view
@@ -39,10 +39,10 @@      H.it "Check n-ary functions" $ do       check-        (functionN ["a", "b"])+        (functionMany ["a", "b"])         (function "a" "b")       check-        (functionN [int32, string, boolean])+        (functionMany [int32, string, boolean])         (function int32 $ function string boolean)  spec :: H.Spec
− src/test/haskell/Hydra/Ext/Json/CoderSpec.hs 
@@ -1,130 +0,0 @@-module Hydra.Ext.Json.CoderSpec where--import Hydra.Kernel-import Hydra.Lib.Literals-import Hydra.Ext.Json.Coder-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Json as Json-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.Tests--import Hydra.TestData-import Hydra.TestUtils--import qualified Data.Bifunctor as BF-import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Test.QuickCheck as QC---literalTypeConstraintsAreRespected :: H.SpecWith ()-literalTypeConstraintsAreRespected = H.describe "Verify that JSON's literal type constraints are respected" $ do--  -- TODO: binary data--  H.it "Check booleans" $-    QC.property $ \b -> checkJsonCoder Types.boolean (Terms.boolean b) (Json.ValueBoolean b)--  H.it "Check 32-bit floats" $-    QC.property $ \f -> checkJsonCoder Types.float32 (Terms.float32 f) (jsonFloat $ realToFrac f)--  H.it "Check 64-bit floats (doubles)" $-    QC.property $ \d -> checkJsonCoder Types.float64 (Terms.float64 d) (jsonFloat $ realToFrac d)--  -- TODO: bigfloat--  H.it "Check 32-bit integers" $-    QC.property $ \i -> checkJsonCoder Types.int32 (Terms.int32 i) (jsonInt i)--  H.it "Check 16-bit unsigned integers" $-    QC.property $ \i -> checkJsonCoder Types.uint16 (Terms.uint16 i) (jsonInt i)--  H.it "Check arbitrary-precision integers" $-    QC.property $ \i -> checkJsonCoder Types.bigint (Terms.bigint i) (jsonInt i)--  H.it "Check strings" $-    QC.property $ \s -> checkJsonCoder Types.string (Terms.string s) (Json.ValueString s)--supportedTypesPassThrough :: H.SpecWith ()-supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do--  H.it "Lists become JSON arrays" $-    QC.property $ \strings -> checkJsonCoder listOfStringsType-      (Terms.list $ Terms.string <$> strings) (Json.ValueArray $ Json.ValueString <$> strings)--  H.it "Maps become JSON objects" $-    QC.property $ \keyvals -> checkJsonCoder mapOfStringsToIntsType-      (makeMap keyvals) (jsonMap $ BF.bimap id jsonInt <$> keyvals)--  H.it "Optionals become JSON null or type-specific values" $-    QC.property $ \ms -> checkJsonCoder optionalStringType-      (Terms.optional $ Terms.string <$> ms) (Y.maybe Json.ValueNull Json.ValueString ms)--  H.it "Records become JSON objects" $-    QC.property $ \lat lon -> checkJsonCoder testTypeLatLon-      (latlonRecord lat lon) (jsonMap [-        ("lat", jsonFloat $ realToFrac lat),-        ("lon", jsonFloat $ realToFrac lon)])--unsupportedTypesAreTransformed :: H.SpecWith ()-unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do--  -- TODO: functions--  H.it "Sets become arrays" $-    QC.property $ \strings -> checkJsonCoder setOfStringsType-      (stringSet strings)-      (Json.ValueArray $ Json.ValueString <$> S.toList strings)--  H.it "Nominal types are dereferenced" $-    QC.property $ \s -> checkJsonCoder testTypeStringAlias-      (Terms.wrap testTypeStringAliasName $ Terms.string s)-      (Json.ValueString s)--  H.it "Unions become JSON objects (as records)" $-    QC.property $ \int -> checkJsonCoder stringOrIntType-      (Terms.inject stringOrIntName $ Field (Name "right") $ Terms.int32 int)-      (jsonMap [("right", jsonInt int)])--wrappedTypesAreSupported :: H.SpecWith ()-wrappedTypesAreSupported = H.describe "Verify that nominal types are supported" $ do-  H.it "Nominal unions become single-attribute objects" $-    QC.property $ \() -> checkJsonCoder (TypeVariable testTypeFoobarValueName)-      (Terms.inject testTypeFoobarValueName $ Terms.field "bool" $ Terms.boolean True)-      (jsonMap [("bool", jsonBool True)])--  H.it "Nominal enums become single-attribute objects with empty-object values, and type annotations are transparent" $-    QC.property $ \() -> checkJsonCoder (TypeVariable testTypeComparisonName)-      (Terms.inject testTypeComparisonName $ Terms.field "equalTo" Terms.unit)-      (jsonMap [("equalTo", jsonMap [])])--spec :: H.Spec-spec = do-  literalTypeConstraintsAreRespected-  supportedTypesPassThrough-  unsupportedTypesAreTransformed-  wrappedTypesAreSupported--checkJsonCoder :: Type -> Term -> Json.Value -> H.Expectation-checkJsonCoder typ term node = case mstep of-    Nothing -> HL.assertFailure (traceSummary trace)-    Just step -> do-      shouldSucceedWith (coderEncode step term) node-      shouldSucceedWith (coderEncode step term >>= coderDecode step) term-  where-    FlowState mstep _ trace = unFlow (jsonCoder typ) testGraph emptyTrace--jsonBool :: Bool -> Json.Value-jsonBool = Json.ValueBoolean--jsonFloat :: Double -> Json.Value-jsonFloat = Json.ValueNumber--jsonInt :: Integral i => i -> Json.Value-jsonInt = Json.ValueNumber . bigintToBigfloat . fromIntegral--jsonMap :: [(String, Json.Value)] -> Json.Value-jsonMap = Json.ValueObject . M.fromList
− src/test/haskell/Hydra/Ext/Json/SerdeSpec.hs 
@@ -1,105 +0,0 @@--- Note: these tests are dependent on Data.Aeson, both because the Serde depends on Data.Aeson---       and because of the particular serialization style.--module Hydra.Ext.Json.SerdeSpec where--import Hydra.Kernel-import Hydra.Dsl.Terms-import Hydra.Ext.Json.Serde-import qualified Hydra.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Data.List as L-import qualified Test.QuickCheck as QC-import qualified Data.Maybe as Y---checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Test literal values" $ do--  H.it "Booleans become 'true' and 'false'" $ do-    QC.property $ \b -> checkSerialization jsonStringCoder-      (TypedTerm (boolean b) $ Types.boolean)-      (if b then "true" else "false")--  H.it "int32's become numbers, and are serialized in the obvious way" $ do-    QC.property $ \i -> checkSerialization jsonStringCoder-      (TypedTerm (int32 i) $ Types.int32)-      (show i)--  H.it "uint8's and other finite integer types become numbers, and are serialized in the obvious way" $ do-    QC.property $ \i -> checkSerialization jsonStringCoder-      (TypedTerm (uint8 i) $ Types.uint8)-      (show i)--  H.it "bigints become numbers" $ do-    QC.property $ \i -> checkSerialization jsonStringCoder-      (TypedTerm (bigint i) $ Types.bigint)-      (show i)--checkOptionals :: H.SpecWith ()-checkOptionals = H.describe "Test and document serialization of optionals" $ do--  H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $-    QC.property $ \mi -> checkSerialization jsonStringCoder-      (TypedTerm-        (optional $ (Just . int32) =<< mi)-        (Types.optional Types.int32))-      (Y.maybe "null" show mi)--  H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $-    QC.property $ \mi -> checkSerialization jsonStringCoder-      (TypedTerm-        (optional $ Just $ optional $ (Just . int32) =<< mi)-        (Types.optional $ Types.optional Types.int32))-      ("[" ++ Y.maybe "null" show mi ++ "]")--  H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $-    QC.property $ \() -> checkSerialization jsonStringCoder-      (TypedTerm-        (optional Nothing)-        (Types.optional $ Types.optional Types.int32))-      "[]"--checkRecordsAndUnions :: H.SpecWith ()-checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do--  H.it "Empty records become empty objects" $-    QC.property $ \() -> checkSerialization jsonStringCoder-      (TypedTerm unit Types.unit)-      "{}"--  H.it "Simple records become simple objects" $-    QC.property $ \() -> checkSerialization jsonStringCoder-      (TypedTerm (latlonRecord 37 (negate 122)) testTypeLatLon)-      "{\"lat\":37,\"lon\":-122}"--  H.it "Optionals are omitted from record objects if 'nothing'" $-    QC.property $ \() -> checkSerialization jsonStringCoder-      (TypedTerm-        (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])-        (TypeRecord $ RowType testTypeName [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))-      "{\"one\":\"test\"}"--  H.it "Simple unions become simple objects, via records" $-    QC.property $ \() -> checkSerialization jsonStringCoder-      (TypedTerm-        (inject testTypeName $ Field (Name "left") $ string "test")-        (TypeUnion $ RowType testTypeName [Types.field "left" Types.string, Types.field "right" Types.int32]))-      "{\"left\":\"test\"}"--jsonByteStringCoderIsInformationPreserving :: H.SpecWith ()-jsonByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized JSON, and back again is a no-op" $ do--  H.it "Generate arbitrary type/term pairs, serialize the terms to JSON, deserialize them, and compare" $-    QC.property (checkSerdeRoundTrip jsonByteStringCoder)--spec :: H.Spec-spec = do-  checkLiterals-  checkOptionals-  checkRecordsAndUnions---  jsonByteStringCoderIsInformationPreserving -- TODO: restore me
− src/test/haskell/Hydra/Ext/Yaml/CoderSpec.hs 
@@ -1,120 +0,0 @@-module Hydra.Ext.Yaml.CoderSpec where--import Hydra.Kernel-import Hydra.Dsl.Terms-import Hydra.Ext.Yaml.Coder-import qualified Hydra.Ext.Org.Yaml.Model as YM-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.Tests--import Hydra.TestData-import Hydra.TestUtils--import qualified Data.Bifunctor as BF-import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Maybe as Y-import qualified Test.QuickCheck as QC---literalTypeConstraintsAreRespected :: H.SpecWith ()-literalTypeConstraintsAreRespected = H.describe "Verify that YAML's literal type constraints are respected" $ do--  -- TODO: binary data--  H.it "Check booleans" $-    QC.property $ \b -> checkYamlCoder Types.boolean (boolean b) (yamlBool b)--  H.it "Check 32-bit floats" $-    QC.property $ \f -> checkYamlCoder Types.float32 (float32 f) (yamlFloat $ realToFrac f)--  H.it "Check 64-bit floats (doubles)" $-    QC.property $ \d -> checkYamlCoder Types.float64 (float64 d) (yamlFloat $ realToFrac d)--  -- TODO: bigfloat--  H.it "Check 32-bit integers" $-    QC.property $ \i -> checkYamlCoder Types.int32 (int32 i) (yamlInt i)--  H.it "Check 16-bit unsigned integers" $-    QC.property $ \i -> checkYamlCoder Types.uint16 (uint16 i) (yamlInt i)--  H.it "Check arbitrary-precision integers" $-    QC.property $ \i -> checkYamlCoder Types.bigint (bigint i) (yamlInt i)--  H.it "Check strings" $-    QC.property $ \s -> checkYamlCoder Types.string (string s) (yamlStr s)--supportedTypesPassThrough :: H.SpecWith ()-supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do--  H.it "Lists become YAML sequences" $-    QC.property $ \strings -> checkYamlCoder listOfStringsType-      (list $ string <$> strings) (YM.NodeSequence $ yamlStr <$> strings)--  H.it "Maps become YAML mappings" $-    QC.property $ \keyvals -> checkYamlCoder mapOfStringsToIntsType-      (makeMap keyvals) (yamlMap $ BF.bimap yamlStr yamlInt <$> keyvals)--  H.it "Optionals become YAML null or type-specific nodes" $-    QC.property $ \ms -> checkYamlCoder optionalStringType-      (optional $ string <$> ms) (YM.NodeScalar $ Y.maybe YM.ScalarNull YM.ScalarStr ms)--  H.it "Records become YAML mappings" $-    QC.property $ \lat lon -> checkYamlCoder testTypeLatLon-      (latlonRecord lat lon) (yamlMap [-        (yamlStr "lat", yamlFloat $ realToFrac lat),-        (yamlStr "lon", yamlFloat $ realToFrac lon)])--unsupportedTypesAreTransformed :: H.SpecWith ()-unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do--  -- TODO: functions--  H.it "Sets become sequences" $-    QC.property $ \strings -> checkYamlCoder setOfStringsType-      (stringSet strings) (YM.NodeSequence $ yamlStr <$> S.toList strings)--  H.it "Nominal types are dereferenced" $-    QC.property $ \s -> checkYamlCoder testTypeStringAlias-      (wrap testTypeStringAliasName $ string s) (yamlStr s)--  H.it "Unions become YAML mappings (as records)" $-    QC.property $ \int -> checkYamlCoder stringOrIntType-      (variant stringOrIntName (Name "right") $ int32 int)-      (yamlMap [(yamlStr "right", yamlInt int)])--spec :: H.Spec-spec = do-  literalTypeConstraintsAreRespected-  supportedTypesPassThrough-  unsupportedTypesAreTransformed--checkYamlCoder :: Type -> Term -> YM.Node -> H.Expectation-checkYamlCoder typ term node = case mstep of-    Nothing -> HL.assertFailure (traceSummary trace)-    Just step -> do-      shouldSucceedWith (coderEncode step term) node-      shouldSucceedWith (coderEncode step term >>= coderDecode step) term-  where-    FlowState mstep _ trace = unFlow (yamlCoder typ) testGraph emptyTrace--yamlBool :: Bool -> YM.Node-yamlBool = YM.NodeScalar . YM.ScalarBool--yamlFloat :: Double -> YM.Node-yamlFloat = YM.NodeScalar . YM.ScalarFloat--yamlInt :: Integral i => i -> YM.Node-yamlInt = YM.NodeScalar . YM.ScalarInt . fromIntegral--yamlMap :: [(YM.Node, YM.Node)] -> YM.Node-yamlMap = YM.NodeMapping . M.fromList--yamlNull :: YM.Node-yamlNull = YM.NodeScalar YM.ScalarNull--yamlStr :: String -> YM.Node-yamlStr = YM.NodeScalar . YM.ScalarStr
− src/test/haskell/Hydra/Ext/Yaml/SerdeSpec.hs 
@@ -1,110 +0,0 @@--- Note: these tests are dependent on HsYaml, both because the Serde depends on HsYaml---       and because of the particular serialization style.--module Hydra.Ext.Yaml.SerdeSpec where--import Hydra.Kernel-import Hydra.Dsl.Terms-import Hydra.Ext.Yaml.Serde-import qualified Hydra.Dsl.Types as Types--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Data.List as L-import qualified Test.QuickCheck as QC-import qualified Data.Maybe as Y---checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Test literal values" $ do--  H.it "Booleans become 'true' and 'false' (not 'y' and 'n')" $ do-    QC.property $ \b -> checkSerialization yamlStringCoder-      (TypedTerm (boolean b) Types.boolean)-      (if b then "true" else "false")--  H.it "int32's become ints, and are serialized in the obvious way" $ do-    QC.property $ \i -> checkSerialization yamlStringCoder-      (TypedTerm (int32 i) Types.int32)-      (show i)--  H.it "uint8's and other finite integer types become ints, and are serialized in the obvious way" $ do-    QC.property $ \i -> checkSerialization yamlStringCoder-      (TypedTerm (uint8 i) Types.uint8)-      (show i)--  H.it "bigints become ints" $ do-    QC.property $ \i -> checkSerialization yamlStringCoder-      (TypedTerm (bigint i) Types.bigint)-      (show i)--  -- TODO: examine quirks around floating-point serialization more closely. These could affect portability of the serialized YAML.--  -- TODO: binary string and character string serialization--checkOptionals :: H.SpecWith ()-checkOptionals = H.describe "Test and document serialization of optionals" $ do--  H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $-    QC.property $ \mi -> checkSerialization yamlStringCoder-      (TypedTerm-        (optional $ (Just . int32) =<< mi)-        (Types.optional Types.int32))-      (Y.maybe "null" show mi)--  H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $-    QC.property $ \mi -> checkSerialization yamlStringCoder-      (TypedTerm-        (optional $ Just $ optional $ (Just . int32) =<< mi)-        (Types.optional $ Types.optional Types.int32))-      ("- " ++ Y.maybe "null" show mi)--  H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $-    QC.property $ \() -> checkSerialization yamlStringCoder-      (TypedTerm-        (optional Nothing)-        (Types.optional $ Types.optional Types.int32))-      "[]"--checkRecordsAndUnions :: H.SpecWith ()-checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do--  H.it "Empty records become empty objects" $-    QC.property $ \() -> checkSerialization yamlStringCoder-      (TypedTerm unit Types.unit)-      "{}"--  H.it "Simple records become simple objects" $-    QC.property $ \() -> checkSerialization yamlStringCoder-      (TypedTerm (latlonRecord 37.0 (negate 122.0)) testTypeLatLon)-      "lat: 37.0\nlon: -122.0"--  H.it "Optionals are omitted from record objects if 'nothing'" $-    QC.property $ \() -> checkSerialization yamlStringCoder-      (TypedTerm-        (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])-        (TypeRecord $ RowType testTypeName [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))-      "one: test"--  H.it "Simple unions become simple objects, via records" $-    QC.property $ \() -> checkSerialization yamlStringCoder-      (TypedTerm-        (inject testTypeName $ Field (Name "left") $ string "test")-        (TypeUnion $ RowType testTypeName [Types.field "left" Types.string, Types.field "right" Types.int32]))-      "left: test\n"--yamlByteStringCoderIsInformationPreserving :: H.SpecWith ()-yamlByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized YAML, and back again is a no-op" $ do--  H.it "Generate arbitrary type/term pairs, serialize the terms to YAML, deserialize them, and compare" $-    QC.property (checkSerdeRoundTrip yamlByteStringCoder)--spec :: H.Spec-spec = do-  checkLiterals-  checkOptionals-  checkRecordsAndUnions---  yamlByteStringCoderIsInformationPreserving -- TODO: restore me
− src/test/haskell/Hydra/FlowsSpec.hs 
@@ -1,53 +0,0 @@-module Hydra.FlowsSpec where--import Hydra.Kernel-import qualified Hydra.Dsl.Terms as Terms-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Test.Hspec as H---checkErrorTrace :: H.SpecWith ()-checkErrorTrace = do-  H.describe "Check error traces resulting from an explicit failure" $ do--    H.it "Error traces are in the right order" $-      H.shouldBe-        (unFlow (withTrace "one" $ withTrace "two" $ if False then pure 42 else fail "oops") () emptyTrace)-        (FlowState Nothing () emptyTrace {traceMessages = ["Error: oops (one > two)"]})--checkMaxTraceDepth :: H.SpecWith ()-checkMaxTraceDepth = do-  H.describe "Check breaking out of flows with an infinite loop" $ do--    H.it "Flows with no trace are OK" $-      H.shouldBe-        (unFlow (testFlow 42 0) () emptyTrace)-        (FlowState (Just 42) () emptyTrace)--    H.it "Flows with a trace just below the maximum depth are OK" $-      H.shouldBe-        (unFlow (testFlow 42 maxTraceDepth) () emptyTrace)-        (FlowState (Just 42) () emptyTrace)--    H.it "Flows fail when their trace reaches the maximum depth" $ do-      H.shouldBe (flowStateValue overflow) Nothing-      H.shouldBe (L.length $ traceMessages $ flowStateTrace overflow) 1-  where-    overflow = unFlow (testFlow 42 (maxTraceDepth+1)) () emptyTrace--testFlow :: x -> Int -> Flow () x-testFlow seed depth = helper depth-  where-    helper d = if d == 0-      then pure seed-      else withTrace ("level " ++ show (depth-d)) $ helper (d-1)--spec :: H.Spec-spec = do-  checkErrorTrace-  checkMaxTraceDepth
− src/test/haskell/Hydra/Inference/AlgebraicTypesSpec.hs 
@@ -1,194 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.AlgebraicTypesSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.Inference.InferenceTestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---checkFolds :: H.SpecWith ()-checkFolds = check "list eliminations (folds)" $ do--    let fun = Terms.fold $ primitive _math_add--    H.it "test #1" $-      expectType-        fun-        (Types.functionN [Types.int32, Types.list Types.int32, Types.int32])-    H.it "test #2" $-      expectType-        (fun @@ int32 0)-        (Types.function (Types.list Types.int32) Types.int32)-    H.it "test #3" $-      expectType-        (fun @@ int32 0 @@ (list (int32 <$> [1, 2, 3, 4, 5])))-        Types.int32--checkLists :: H.SpecWith ()-checkLists = check "list terms" $ do--  H.it "List of strings" $-    expectType-      (list [string "foo", string "bar"])-      (Types.list Types.string)-  H.it "List of lists of strings" $-    expectType-      (list [list [string "foo"], list []])-      (Types.list $ Types.list Types.string)-  H.it "Empty list" $-    expectPolytype-      (list [])-      ["t0"] (Types.list $ Types.var "t0")-  H.it "List containing an empty list" $-    expectPolytype-      (list [list []])-      ["t0"] (Types.list $ Types.list $ Types.var "t0")-  H.it "Lambda producing a polymorphic list" $-    expectPolytype-      (lambda "x" (list [var "x"]))-      ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-  H.it "Lambda producing a list of integers" $-    expectType-      (lambda "x" (list [var "x", int32 42]))-      (Types.function Types.int32 $ Types.list Types.int32)-  H.it "List with repeated variables" $-    expectType-      (lambda "x" (list [var "x", string "foo", var "x"]))-      (Types.function Types.string (Types.list Types.string))--checkMaps :: H.SpecWith ()-checkMaps = check "maps" $ do--    H.it "test #1" $-      expectType-        (mapTerm $ M.fromList [(string "firstName", string "Arthur"), (string "lastName", string "Dent")])-        (Types.map Types.string Types.string)-    H.it "test #2" $-      expectPolytype-        (mapTerm M.empty)-        ["t0", "t1"] (Types.map (Types.var "t0") (Types.var "t1"))-    H.it "test #3" $-      expectPolytype-        (lambda "x" (lambda "y" (mapTerm $ M.fromList-          [(var "x", float64 0.1), (var "y", float64 0.2)])))-        ["t0"] (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.map (Types.var "t0") Types.float64)))--checkOptionals :: H.SpecWith ()-checkOptionals = check "optionals" $ do--  H.it "test #1" $-    expectType-      (optional $ Just $ int32 42)-      (Types.optional Types.int32)-  H.it "test #2" $-    expectPolytype-      (optional Nothing)-      ["t0"] (Types.optional $ Types.var "t0")--checkProducts :: H.SpecWith ()-checkProducts = check "product terms" $ do--  H.it "Empty product" $ do-    expectType-      (Terms.product [])-      (Types.product [])--  H.describe "Non-empty, monotyped products" $ do-    H.it "test #1" $-      expectType-        (Terms.product [string "foo", int32 42])-        (Types.product [Types.string, Types.int32])-    H.it "test #2" $-      expectType-        (Terms.product [string "foo", list [float32 42.0, float32 137.0]])-        (Types.product [Types.string, Types.list Types.float32])-    H.it "test #3" $-      expectType-        (Terms.product [string "foo", int32 42, list [float32 42.0, float32 137.0]])-        (Types.product [Types.string, Types.int32, Types.list Types.float32])--  H.describe "Polytyped products" $ do-    H.it "test #1" $-      expectPolytype-        (Terms.product [list [], string "foo"])-        ["t0"] (Types.product [Types.list $ Types.var "t0", Types.string])-    H.it "test #2" $-      expectPolytype-        (Terms.product [int32 42, "foo", list []])-        ["t0"] (Types.product [Types.int32, Types.string, Types.list $ Types.var "t0"])--  H.describe "Pairs" $ do-    H.it "test #1" $-      expectType-        (pair (int32 42) "foo")-        (Types.pair Types.int32 Types.string)-    H.it "test #2" $-      expectPolytype-        (pair (list []) "foo")-        ["t0"] (Types.pair (Types.list $ Types.var "t0") Types.string)-    H.it "test #3" $-      expectPolytype-        (pair (list []) (list []))-        ["t0", "t1"] (Types.pair (Types.list $ Types.var "t0") (Types.list $ Types.var "t1"))--checkSets :: H.SpecWith ()-checkSets = check "sets" $ do--  H.it "test #1" $-    expectType-      (set $ S.fromList [boolean True])-      (Types.set Types.boolean)-  H.it "test #2" $-    expectPolytype-      (set $ S.fromList [set S.empty])-      ["t0"] (Types.set $ Types.set $ Types.var "t0")--checkSums :: H.SpecWith ()-checkSums = check "sum terms" $ do--  H.describe "Singleton sum terms" $ do-    H.it "test #1" $-      expectType-        (Terms.sum 0 1 $ string "foo")-        (Types.sum [Types.string])-    H.it "test #2" $-      expectPolytype-        (Terms.sum 0 1 $ list [])-        ["t0"] (Types.sum [Types.list $ Types.var "t0"])--  H.describe "Non-singleton sum terms" $ do-    H.it "test #1" $-      expectPolytype-        (Terms.sum 0 2 $ string "foo")-        ["t0"] (Types.sum [Types.string, Types.var "t0"])-    H.it "test #2" $-      expectPolytype-        (Terms.sum 1 2 $ string "foo")-        ["t0"] (Types.sum [Types.var "t0", Types.string])--spec :: H.Spec-spec = do-  checkFolds-  checkLists-  checkMaps-  checkOptionals-  checkProducts-  checkSets-  checkSums-  return ()
− src/test/haskell/Hydra/Inference/AlgorithmWSpec.hs 
@@ -1,1016 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.AlgorithmWSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries---import Hydra.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import qualified Hydra.Inference.AlgorithmWBridge as W-import Hydra.Lib.Io---import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---testHydraContext = W.HydraContext $ graphPrimitives testGraph--inferTypedTerm :: Term -> IO Term-inferTypedTerm = W.inferWithAlgorithmW testHydraContext--inferType :: Term -> IO Type-inferType term = do-  fterm <- inferTypedTerm term-  case fterm of-    TermTyped (TypedTerm _ typ) -> pure typ-    _ -> fail $ "expected a typed term, found: " ++ showTerm fterm--expectType :: Term -> Type -> H.Expectation-expectType term typ = H.shouldReturn (inferType term) typ--expectPolytype :: Term -> [String] -> Type -> H.Expectation-expectPolytype term vars typ = expectType term (Types.lambdas vars typ)--expectFailure :: Term -> H.Expectation-expectFailure term = H.shouldThrow (inferTypedTerm term) H.anyException---- Placeholders for the primitives in @wisnesky's test cases; they are not necessarily the same functions,--- but they have the same types.-primPred = primitive _math_neg-primSucc = primitive _math_neg---- @wisnesky's original Algorithm W test cases, modified so as to normalize type variables-checkAlgorithmW :: H.SpecWith ()-checkAlgorithmW = H.describe "Check System F syntax" $ do-  --Untyped input:-  --	(\x. x)-  --System F type:-  -- 	(v0 -> v0)-  H.it "#0" $ expectType-    (lambda "x" $ var "x")-    (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.var "t0"))--  --Untyped input:-  --	letrecs foo = (\x. x)-  --		in 42-  --System F type:-  -- 	Nat-  H.it "#1" $ expectType-    (int32 32 `with` [-      "foo">: lambda "x" $ var "x"])-    Types.int32--  --Untyped input:-  --	let f = (\x. x) in (f 0)-  --System F type:-  -- 	Nat-  H.it "#2" $ expectType-    ((var "f" @@ int32 0) `with` [-      "f">: lambda "x" $ var "x"])-    Types.int32--  --Untyped input:-  --	let f = ((\x. x) 0) in f-  --System F type:-  -- 	Nat-  H.it "#3" $ expectType-    (var "f" `with` [-      "f">: (lambda "x" $ var "x") @@ int32 0])-    Types.int32--  --Untyped input:-  --	let sng = (\x. (cons x nil)) in sng-  --System F type:-  -- 	(v5 -> (List v5))-  H.it "#4" $ expectType-    (var "sng" `with` [-      "sng">: lambda "x" $ list [var "x"]])-    (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))--  --Untyped input:-  --	let sng = (\x. (cons x nil)) in (pair (sng 0) (sng alice))-  --System F type:-  -- 	((List Nat) * (List String))-  H.it "#5" $ expectType-    (pair (var "sng" @@ int32 0) (var "sng" @@ string "alice") `with` [-      "sng">: lambda "x" $ list [var "x"]])-    (Types.pair (Types.list Types.int32) (Types.list Types.string))--  --Untyped input:-  --	letrecs + = (\x. (\y. (S (+ (P x) y))))-  --		in (+ (S (S 0)) (S 0))-  --System F type:-  -- 	Nat-  H.it "#6" $ expectType-    ((var "+" @@ (primSucc @@ (primSucc @@ int32 0)) @@ (primSucc @@ int32 0)) `with` [-      "+" >: lambda "x" $ lambda "y" (primSucc @@ (var "+" @@ (primPred @@ var "x") @@ var "y"))])-    Types.int32--  --Untyped input:-  --	letrecs f = (\x. (\y. (f 0 x)))-  --		in f-  --System F type:-  -- 	(Nat -> (Nat -> v5))-  H.it "#7" $ expectType-    (var "f" `with` [-      "f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")])-    (Types.lambda "t0" $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 x)))-  --		g = (\u. (\v. (f v 0)))-  --		in (pair f g)-  --System F type:-  -- 	((v12 -> (Nat -> v13)) * (Nat -> (v15 -> v16)))-  H.it "#9" $ expectType-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),-      "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])-    (Types.lambdas ["t0", "t1", "t2", "t3"] $ Types.pair-      (Types.function (Types.var "t0") (Types.function Types.int32 (Types.var "t1")))-      (Types.function Types.int32 (Types.function (Types.var "t2") (Types.var "t3"))))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 0)))-  --		g = (\u. (\v. (f v 0)))-  --		in (pair f g)-  --System F type:-  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))-  H.it "#10" $ expectType-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ int32 0),-      "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])-    (Types.lambdas ["t0", "t1"] $ Types.pair-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t1"))))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 x)))-  --		g = (\u. (\v. (f 0 0)))-  --		in (pair f g)-  --System F type:-  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))-  H.it "#11" $ expectType-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),-      "g">: lambda "u" $ lambda "v" (var "f" @@ int32 0 @@ int32 0)])-    (Types.lambdas ["t0", "t1"] $ Types.pair-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t1"))))--checkEliminations :: H.SpecWith ()-checkEliminations = H.describe "Check a few hand-picked elimination terms" $ do--  H.it "Match statements" $ do-    expectType-      (match testTypeSimpleNumberName Nothing [-        Field (Name "int") $ lambda "x" $ var "x",-        Field (Name "float") $ lambda "x" $ int32 42])-      (funT (TypeVariable testTypeSimpleNumberName) Types.int32)--checkIndividualTerms :: H.SpecWith ()-checkIndividualTerms = H.describe "Check a few hand-picked terms" $ do--  H.describe "Literal values" $ do-    H.it "test #1" $-      expectType-        (int32 42)-        Types.int32-    H.it "test #2" $-      expectType-        (string "foo")-        Types.string-    H.it "test #3" $-      expectType-        (boolean False)-        Types.boolean-    H.it "test #4" $-      expectType-        (float64 42.0)-        Types.float64--  H.it "Let terms" $ do-    expectPolytype-      (letTerm (Name "x") (float32 42.0) (lambda "y" (lambda "z" (var "x"))))-      ["t0", "t1"] (Types.function (Types.var "t0") (Types.function (Types.var "t1") Types.float32))--  H.describe "Optionals" $ do-    H.it "test #1" $-      expectType-        (optional $ Just $ int32 42)-        (Types.optional Types.int32)-    H.it "test #2" $-      expectPolytype-        (optional Nothing)-        ["t0"] (Types.optional $ Types.var "t0")--  H.describe "Records" $ do-    H.it "test #1" $-      expectType-        (record testTypeLatLonName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (TypeVariable testTypeLatLonName)-    H.it "test #2" $-      expectType-        (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (Types.apply (TypeVariable testTypeLatLonPolyName) Types.float32)-    H.it "test #3" $-      expectType-        (lambda "lon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ var "lon"]))-        (Types.function (Types.float32) (Types.apply (TypeVariable testTypeLatLonPolyName) Types.float32))-    H.it "test #4" $-      expectPolytype-        (lambda "latlon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ var "latlon",-          Field (Name "lon") $ var "latlon"]))-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeLatLonPolyName) (Types.var "t0")))--  H.describe "Record instances of simply recursive record types" $ do-    H.it "test #1" $-      expectType-        (record testTypeIntListName [-          Field (Name "head") $ int32 42,-          Field (Name "tail") $ optional $ Just $ record testTypeIntListName [-            Field (Name "head") $ int32 43,-            Field (Name "tail") $ optional Nothing]])-        (TypeVariable testTypeIntListName)-    H.it "test #2" $-      expectType-        ((lambda "x" $ record testTypeIntListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeIntListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (TypeVariable testTypeIntListName)-    H.it "test #3" $-      expectType-        (record testTypeListName [-          Field (Name "head") $ int32 42,-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ int32 43,-            Field (Name "tail") $ optional Nothing]])-        (Types.apply (TypeVariable testTypeListName) Types.int32)-    H.it "test #4" $-      expectType-        ((lambda "x" $ record testTypeListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (Types.apply (TypeVariable testTypeListName) Types.int32)-    H.it "test #5" $-      expectPolytype-        (lambda "x" $ record testTypeListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]])-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeListName) (Types.var "t0")))--  H.describe "Record instances of mutually recursive record types" $ do-    H.it "test #1" $-      expectType-        ((lambda "x" $ record testTypeBuddyListAName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeBuddyListBName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (Types.apply (TypeVariable testTypeBuddyListAName) Types.int32)-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ record testTypeBuddyListAName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeBuddyListBName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]])-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeBuddyListAName) (Types.var "t0")))--  H.it "Unions" $ do-    expectType-      (inject testTypeTimestampName $ Field (Name "unixTimeMillis") $ uint64 1638200308368)-      (TypeVariable testTypeTimestampName)--  H.describe "Sets" $ do-    H.it "test #1" $-      expectType-        (set $ S.fromList [boolean True])-        (Types.set Types.boolean)-    H.it "test #2" $-      expectPolytype-        (set $ S.fromList [set S.empty])-        ["t0"] (Types.set $ Types.set $ Types.var "t0")--  H.describe "Maps" $ do-    H.it "test #1" $-      expectType-        (mapTerm $ M.fromList [(string "firstName", string "Arthur"), (string "lastName", string "Dent")])-        (Types.map Types.string Types.string)-    H.it "test #2" $-      expectPolytype-        (mapTerm M.empty)-        ["t0", "t1"] (Types.map (Types.var "t0") (Types.var "t1"))-    H.it "test #3" $-      expectPolytype-        (lambda "x" (lambda "y" (mapTerm $ M.fromList-          [(var "x", float64 0.1), (var "y", float64 0.2)])))-        ["t0"] (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.map (Types.var "t0") Types.float64)))----    H.it "Check nominal (newtype) terms" $ do---      expectType---        testDataArthur---        (Types.wrap "Person")-    --   expectType-    --     (lambda "x" (record [-    --       Field "firstName" $ var "x",-    --       Field "lastName" $ var "x",-    --       Field "age" $ int32 42]))-    --     (Types.function Types.string testTypePerson)--checkLetTerms :: H.SpecWith ()-checkLetTerms = H.describe "Check a few hand-picked let terms" $ do--  H.it "Empty let" $ do-    expectType-      ((int32 42) `with` [])-      Types.int32--  H.it "Trivial let" $ do-    expectType-      (var "foo" `with` [-        "foo">: int32 42])-      Types.int32--  H.it "Multiple references to a let-bound term" $-    expectType-      (list [var "foo", var "bar", var "foo"] `with` [-        "foo">: int32 42,-        "bar">: int32 137])-      (Types.list Types.int32)--  H.describe "Let-polymorphism" $ do-    H.it "test #1" $-      expectPolytype-        ((lambda "x" $ var "id" @@ (var "id" @@ var "x")) `with` [-          "id">: lambda "x" $ var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #2" $-      expectType-        ((var "id" @@ (list [var "id" @@ int32 42])) `with` [-          "id">: lambda "x" $ var "x"])-        (Types.list Types.int32)-    H.it "test #3" $-      expectPolytype-        ((lambda "x" (var "id" @@ (list [var "id" @@ var "x"])))-          `with` [-            "id">: lambda "x" $ var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectType-        ((pair (var "id" @@ int32 42) (var "id" @@ string "foo"))-          `with` [-            "id">: lambda "x" $ var "x"])-        (Types.pair Types.int32 Types.string)-    H.it "test #5" $-      expectType-        ((pair (var "list" @@ int32 42) (var "list" @@ string "foo"))-          `with` [-            "list">: lambda "x" $ list [var "x"]])-        (Types.pair (Types.list Types.int32) (Types.list Types.string))---    H.it "test #6" $---      expectPolytype---        ((var "f") `with` [---          "sng">: lambda "x" $ list [var "x"],---          "f">: lambda "x" $ lambda "y" $ Terms.primitive _lists_cons---            @@ (pair (var "sng" @@ var "x") (var "sng" @@ var "y"))---            @@ (var "g" @@ var "x" @@ var "y"),---          "g">: lambda "x" $ lambda "y" $ var "f" @@ int32 42 @@ var "y"])---        ["t0"] (Types.list $ Types.pair Types.int32 (Types.var "t0"))--  H.describe "Recursive and mutually recursive let (@wisnesky's test cases)" $ do-    H.it "test #1" $-      expectPolytype-        ((var "f") `with` [-          "f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")])-        ["t0"] (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-    H.it "test #2" $-      expectPolytype-        ((pair (var "f") (var "g")) `with` [-          "f">: var "g",-          "g">: var "f"])-        -- Note: Hydra's original type inference algorithm finds (a, a) rather than (a, b)-        --       GHC finds (a, b), as is the case here-        -- Try: :t (let (f, g) = (g, f) in (f, g))-        ["t0", "t1"] (Types.pair (Types.var "t0") (Types.var "t1"))---    H.it "test #3" $---      expectPolytype---        ((pair (var "f") (var "g")) `with` [---          "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),---          "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])---        ["t0", "t1"] (Types.pair---          (Types.function (Types.var "t0") (Types.function Types.int32 (Types.var "t1")))---          (Types.function Types.int32 (Types.function (Types.var "t0") (Types.var "t1"))))--    -- letrec + = (\x . (\y . (S (+ (P x) y)))) in (+ (S (S 0)) (S 0))---    let s = primitive _math_neg---        p = primitive _math_neg---    H.it "test #4" $---      expectPolytype---        ((var "plus" @@ (s @@ (s @@ int32 0)) @@ (s @@ int32 0)) `with` [---          "plus">: lambda "x" $ lambda "y" (s @@ (var "plus" @@ (p @@ var "x") @@ var "y"))])---        ["t0"] (Types.function Types.int32 $ Types.function (Types.var "t0") Types.int32)----    H.it "test #3" $---      expectType---        (int32 0 `with` [---          "id">: lambda "z" $ var "z",---          "f">: lambda "p0" $ pair (var "id" @@ var "p0") (var "id" @@ var "p0")])---        Types.int32---    letrecs id = (\z. z)---        f = (\p0. (pair (id p0) (id p0)))---        in 0--checkLists :: H.SpecWith ()-checkLists = H.describe "Check a few hand-picked list terms" $ do--  H.it "List of strings" $-    expectType-      (list [string "foo", string "bar"])-      (Types.list Types.string)-  H.it "List of lists of strings" $-    expectType-      (list [list [string "foo"], list []])-      (Types.list $ Types.list Types.string)-  H.it "Empty list" $-    expectPolytype-      (list [])-      ["t0"] (Types.list $ Types.var "t0")-  H.it "List containing an empty list" $-    expectPolytype-      (list [list []])-      ["t0"] (Types.list $ Types.list $ Types.var "t0")-  H.it "Lambda producing a polymorphic list" $-    expectPolytype-      (lambda "x" (list [var "x"]))-      ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-  H.it "Lambda producing a list of integers" $-    expectType-      (lambda "x" (list [var "x", int32 42]))-      (Types.function Types.int32 $ Types.list Types.int32)-  H.it "List with repeated variables" $-    expectType-      (lambda "x" (list [var "x", string "foo", var "x"]))-      (Types.function Types.string (Types.list Types.string))--  H.describe "Lists and lambdas" $ do-    H.it "test #1" $-      expectPolytype-        (lambda "x" $ var "x")-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #3" $-      expectPolytype-        (lambda "x" $ list [var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectPolytype-        (list [lambda "x" $ var "x", lambda "y" $ var "y"])-        ["t0"] (Types.list $ Types.function (Types.var "t0") (Types.var "t0"))--checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Check arbitrary literals" $ do--  H.it "Verify that type inference preserves the literal to literal type mapping" $-    QC.property $ \l -> expectType-      (TermLiteral l)-      (Types.literal $ literalType l)--checkLambdas :: H.SpecWith()-checkLambdas = H.describe "Check lambdas" $ do--  H.describe "Simple lambdas" $ do-    H.it "test #1" $-      expectPolytype-        (lambda "x" $ var "x")-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ int16 137)-        ["t0"] (Types.function (Types.var "t0") Types.int16)--  H.describe "Lambdas and application" $ do-    H.it "test #1" $-      expectType-        (lambda "x" (var "x") @@ string "foo")-        Types.string--checkOtherFunctionTerms :: H.SpecWith ()-checkOtherFunctionTerms = H.describe "Check a few hand-picked function terms" $ do--  H.describe "List eliminations (folds)" $ do-    let fun = Terms.fold $ primitive _math_add-    H.it "test #1" $-      expectType-        fun-        (Types.functionN [Types.int32, Types.list Types.int32, Types.int32])-    H.it "test #2" $-      expectType-        (fun @@ int32 0)-        (Types.function (Types.list Types.int32) Types.int32)-    H.it "test #3" $-      expectType-        (fun @@ int32 0 @@ (list (int32 <$> [1, 2, 3, 4, 5])))-        Types.int32--  H.it "Projections" $ do-    expectType-      (project testTypePersonName (Name "firstName"))-      (Types.function (TypeVariable testTypePersonName) Types.string)--  H.it "Union eliminations (case statements)" $ do-    expectType-      (match testTypeUnionMonomorphicName Nothing [-        Field (Name "bool") (lambda "x" (boolean True)),-        Field (Name "string") (lambda "x" (boolean False)),-        Field (Name "unit") (lambda "x" (boolean False))])-      (Types.function (TypeVariable testTypeUnionMonomorphicName) Types.boolean)--checkPathologicalTerms :: H.SpecWith ()-checkPathologicalTerms = H.describe "Check pathological terms" $ do--  H.describe "Infinite lists" $ do-    H.it "test #1" $-      expectType-        ((var "self") `with` [-          "self">: primitive _lists_cons @@ (int32 42) @@ (var "self")])-        (Types.list Types.int32)-    H.it "test #2" $-      expectPolytype-        (lambda "x" ((var "self") `with` [-          "self">: primitive _lists_cons @@ (var "x") @@ (var "self")]))-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #3" $-      expectPolytype-        ((lambda "x" $ var "self" @@ var "x") `with` [-          "self">: lambda "e" $ primitive _lists_cons @@ (var "e") @@ (var "self" @@ var "e")])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectType-        ((var "build" @@ int32 0) `with` [-          "build">: lambda "x" $ primitive _lists_cons @@ var "x" @@ (var "build" @@-            (primitive _math_add @@ var "x" @@ int32 1))])-        (Types.list Types.int32)--    H.it "Check self-application" $ do-      expectFailure-        (lambda "x" $ var "x" @@ var "x")--checkPolymorphism :: H.SpecWith ()-checkPolymorphism = H.describe "Check polymorphism" $ do--  H.describe "Simple optionals" $ do-    H.it "test #2" $-      expectPolytype-        (optional Nothing)-        ["t0"] (Types.optional (Types.var "t0"))-    H.it "test #3" $-      expectType-        (optional $ Just $ int32 42)-        (Types.optional Types.int32)--  H.describe "Lambdas, lists, and products" $ do-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ pair (var "x") (var "x"))-        ["t0"] (Types.function (Types.var "t0") (Types.pair (Types.var "t0") (Types.var "t0")))-    H.it "test #5" $-      expectPolytype-        (list [lambda "x" $ lambda "y" $ pair (var "y") (var "x")])-        ["t0", "t1"] (Types.list $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.pair (Types.var "t1") (Types.var "t0"))))--  H.describe "Mixed expressions with lambdas, constants, and primitive functions" $ do-    H.it "test #1" $-      expectType-        (lambda "x" $-            (primitive _math_sub @@ (primitive _math_add @@ var "x" @@ var "x") @@ int32 1))-        (Types.function Types.int32 Types.int32)--checkPrimitives :: H.SpecWith ()-checkPrimitives = H.describe "Check a few hand-picked terms with primitive functions" $ do--  H.describe "Monomorphic primitive functions" $ do-    H.it "test #1" $-      expectType-        (primitive $ Name "hydra/lib/strings.length")-        (Types.function Types.string Types.int32)-    H.it "test #2" $-      expectType-        (primitive _math_sub)-        (Types.function Types.int32 (Types.function Types.int32 Types.int32))--  H.describe "Polymorphic primitive functions" $ do-    H.it "test #1" $-      expectPolytype-        (lambda "el" (primitive _lists_length @@ (list [var "el"])))-        ["t0"] (Types.function (Types.var "t0") Types.int32)-    H.it "test #2" $-      expectType-        (lambda "el" (primitive _lists_length @@ (list [int32 42, var "el"])))-        (Types.function Types.int32 Types.int32)-    H.it "test #3" $-      expectPolytype-        (primitive _lists_concat)-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectPolytype-        (lambda "lists" (primitive _lists_concat @@ var "lists"))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #5" $-      expectPolytype-        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)-    H.it "test #6" $-      expectPolytype-        (lambda "list" (primitive _lists_length @@ (primitive _lists_concat @@ list[var "list", list []])))-        ["t0"] (Types.function (Types.list $ Types.var "t0") Types.int32)-    H.it "test #7" $-      expectPolytype-        (lambda "list" (primitive _math_add-          @@ int32 1-          @@ (primitive _lists_length @@ (primitive _lists_concat @@ list[var "list", list []]))))-        ["t0"] (Types.function (Types.list $ Types.var "t0") Types.int32)-    H.it "test #8" $-      expectPolytype-        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)--  H.describe "Primitives and application" $ do-    H.it "test #1" $-      expectType-        (primitive _lists_concat @@ list [list [int32 42], list []])-        (Types.list Types.int32)--  H.describe "Lambdas and primitives" $ do-    H.it "test #1" $-      expectType-        (primitive _math_add)-        (Types.functionN [Types.int32, Types.int32, Types.int32])-    H.it "test #2" $-      expectType-        (lambda "x" (primitive _math_add @@ var "x"))-        (Types.functionN [Types.int32, Types.int32, Types.int32])-    H.it "test #3" $-      expectType-        (lambda "x" (primitive _math_add @@ var "x" @@ var "x"))-        (Types.function Types.int32 Types.int32)---- TODO: restore nullary and unary product test cases-checkProducts :: H.SpecWith ()-checkProducts = H.describe "Check a few hand-picked product terms" $ do--  H.it "Empty product" $ do-    expectType-      (Terms.product [])-      (Types.product [])--  H.it "Unary product" $-    expectType-      (Terms.product [int32 42])-      (Types.product [Types.int32])--  H.describe "Non-empty, monotyped products" $ do-    H.it "test #1" $-      expectType-        (Terms.product [string "foo", int32 42])-        (Types.product [Types.string, Types.int32])-    H.it "test #2" $-      expectType-        (Terms.product [string "foo", list [float32 42.0, float32 137.0]])-        (Types.product [Types.string, Types.list Types.float32])-    H.it "test #3" $-      expectType-        (Terms.product [string "foo", int32 42, list [float32 42.0, float32 137.0]])-        (Types.product [Types.string, Types.int32, Types.list Types.float32])--  H.describe "Polytyped products" $ do-    H.it "test #1" $-      expectPolytype-        (Terms.product [list [], string "foo"])-        ["t0"] (Types.product [Types.list $ Types.var "t0", Types.string])-    H.it "test #2" $-      expectPolytype-        (Terms.product [int32 42, "foo", list []])-        ["t0"] (Types.product [Types.int32, Types.string, Types.list $ Types.var "t0"])--  H.describe "Pairs" $ do-    H.it "test #1" $-      expectType-        (pair (int32 42) "foo")-        (Types.pair Types.int32 Types.string)-    H.it "test #2" $-      expectPolytype-        (pair (list []) "foo")-        ["t0"] (Types.pair (Types.list $ Types.var "t0") Types.string)-    H.it "test #3" $-      expectPolytype-        (pair (list []) (list []))-        ["t0", "t1"] (Types.pair (Types.list $ Types.var "t0") (Types.list $ Types.var "t1"))--  H.describe "Products with polymorphic components" $ do-    H.it "test #1" $-      expectPolytype-        (pair (int32 42) (lambda "x" $ var "x"))-        ["t0"] (Types.pair Types.int32 (Types.function (Types.var "t0") (Types.var "t0")))-    H.it "test #2" $-      expectPolytype-        (pair (lambda "x" $ var "x") (lambda "x" $ var "x"))-        ["t0", "t1"] (Types.pair-          (Types.function (Types.var "t0") (Types.var "t0"))-          (Types.function (Types.var "t1") (Types.var "t1")))-    H.it "test #3" $-      expectPolytype-        (lambda "x" $ pair (var "x") (list [var "x"]))-        ["t0"] (Types.function (Types.var "t0") $ Types.pair (Types.var "t0") (Types.list $ Types.var "t0"))--checkSums :: H.SpecWith ()-checkSums = H.describe "Check a few hand-picked sum terms" $ do--  H.describe "Singleton sum terms" $ do-    H.it "test #1" $-      expectType-        (Terms.sum 0 1 $ string "foo")-        (Types.sum [Types.string])-    H.it "test #2" $-      expectPolytype-        (Terms.sum 0 1 $ list [])-        ["t0"] (Types.sum [Types.list $ Types.var "t0"])--  H.describe "Non-singleton sum terms" $ do-    H.it "test #1" $-      expectPolytype-        (Terms.sum 0 2 $ string "foo")-        ["t0"] (Types.sum [Types.string, Types.var "t0"])-    H.it "test #2" $-      expectPolytype-        (Terms.sum 1 2 $ string "foo")-        ["t0"] (Types.sum [Types.var "t0", Types.string])---- TODO: restore these tests---checkTypeAnnotations :: H.SpecWith ()---checkTypeAnnotations = H.describe "Check that type annotations are added to terms and subterms" $ do------  H.it "Literals" $---    QC.property $ \l -> do---      let term = TermLiteral l---      let term1 = executeFlow (inferTermType term)---      checkType term1 (Types.literal $ literalType l)------  H.it "Lists of literals" $---    QC.property $ \l -> do---      let term = TermList [TermLiteral l]---      let term1 = executeFlow (inferTermType term)---      checkType term1 (Types.list $ Types.literal $ literalType l)---      let (TermAnnotated (Annotated (TermList [term2]) _)) = term1---      checkType term2 (Types.literal $ literalType l)---- TODO: restore these tests---checkSubtermAnnotations :: H.SpecWith ()---checkSubtermAnnotations = H.describe "Check additional subterm annotations" $ do------    H.it "Literals" $---      expectTypeAnnotation pure---        (string "foo")---        (Types.string)------    H.describe "Monotyped lists" $ do---      H.it "test #1" $---        expectTypeAnnotation pure---          (list [string "foo"])---          (Types.list Types.string)---      H.it "test #2" $---        expectTypeAnnotation Expect.listHead---          (list [string "foo"])---          Types.string------    H.describe "Monotyped lists within lambdas" $ do---      H.it "test #1" $---        expectTypeAnnotation pure---          (lambda "x" $ list [var "x", string "foo"])---          (Types.function Types.string (Types.list Types.string))---      H.it "test #2" $---        expectTypeAnnotation (Expect.lambdaBody >=> Expect.listHead)---          (lambda "x" $ list [var "x", string "foo"])---          Types.string------    H.describe "Injections" $ do---      H.it "test #1" $---        expectTypeAnnotation pure---          (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11")---          (TypeVariable testTypeTimestampName)---      H.it "test #2" $---        expectTypeAnnotation pure---          (lambda "ignored" $ (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11"))---          (Types.lambda "t0" $ Types.function (Types.var "t0") (TypeVariable testTypeTimestampName))------    H.it "Projections" $ do---      expectTypeAnnotation pure---        (project testTypePersonName $ Name "firstName")---        (Types.function (TypeVariable testTypePersonName) Types.string)------    H.describe "Case statements" $ do---      H.it "test #1" $---        expectTypeAnnotation pure---          (match testTypeNumberName (Just $ string "it's something else") [---            Field (Name "int") $ constant $ string "it's an integer"])---          (Types.function (TypeVariable testTypeNumberName) Types.string)---      H.describe "test #2" $ do---        let  testCase = match testTypeNumberName Nothing [---                          Field (Name "int") $ constant $ string "it's an integer",---                          Field (Name "float") $ constant $ string "it's a float"]---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.function (TypeVariable testTypeNumberName) Types.string)---        H.it "condition #2" $---          expectTypeAnnotation (Expect.casesCase testTypeNumberName "int" >=> (pure . fieldTerm)) testCase---            (Types.function Types.int32 Types.string)------    H.describe "Optional eliminations" $ do---      H.describe "test #1" $ do---        let testCase = matchOpt---                         (string "nothing")---                         (lambda "ignored" $ string "just")---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.lambda "t0" $ Types.function (Types.optional $ Types.var "t0") Types.string)---        H.it "condition #2" $---          expectTypeAnnotation Expect.optCasesNothing testCase---            Types.string---        H.it "condition #3" $---          expectTypeAnnotation Expect.optCasesJust testCase---            (Types.lambda "t0" $ Types.function (Types.var "t0") Types.string)---      H.describe "test #2" $ do---        let testCase = lambda "getOpt" $ lambda "x" $---                         (matchOpt---                           (string "nothing")---                           (lambda "_" $ string "just")) @@ (var "getOpt" @@ var "x")---        let getOptType = (Types.function (Types.var "t0") (Types.optional $ Types.var "t1"))---        let constStringType = Types.function (Types.var "t0") Types.string---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.lambdas ["t0", "t1"] $ Types.function getOptType constStringType)---        H.it "condition #2" $---          expectTypeAnnotation Expect.lambdaBody testCase---            (Types.lambda "t0" $ constStringType)------    H.describe "Unannotated 'let' terms" $ do---      H.describe "test #1" $ do---        let testCase = lambda "i" $---                         (Terms.primitive _strings_cat @@ list [string "foo", var "i", string "bar"])---                         `with` [---                           "foo">: string "FOO",---                           "bar">: string "BAR"]---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.function Types.string Types.string)---        H.it "condition #2" $---          expectTypeAnnotation Expect.lambdaBody testCase---            Types.string---      H.describe "test #2" $ do---        let testCase = lambda "original" $---                         var "alias" `with` [---                           "alias">: var "original"]---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.var "t0"))---        H.it "condition #2" $---          expectTypeAnnotation Expect.lambdaBody testCase---            (Types.lambda "t0" $ Types.var "t0")---        H.it "condition #3" $---          expectTypeAnnotation (Expect.lambdaBody >=> Expect.letBinding "alias") testCase---            (Types.lambda "t0" $ Types.var "t0")---      H.describe "test #3" $ do---        let testCase = lambda "fun" $ lambda "t" $---                         ((var "funAlias" @@ var "t") `with` [---                           "funAlias">: var "fun"])---        let funType = Types.function (Types.var "t0") (Types.var "t1")---        H.it "condition #1" $---          expectTypeAnnotation pure testCase---            (Types.lambdas ["t0", "t1"] $ Types.function funType funType)---        H.it "condition #2" $---          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody) testCase---            (Types.lambda "t1" $ Types.var "t1")---        H.it "condition #3" $---          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody >=> Expect.letBinding "funAlias") testCase---            (Types.lambdas ["t0", "t1"] funType)---  where---    tmp term = shouldSucceedWith flow ()---      where---        flow = do---          iterm <- inferTermType term---          fail $ "iterm: " ++ show iterm--checkUserProvidedTypes :: H.SpecWith ()-checkUserProvidedTypes = H.describe "Check that user-provided type annotations are respected" $ do--    H.describe "Top-level type annotations" $ do-      H.it "test #1" $-        expectPolytype-          pretypedEmptyList-          ["p"] (Types.list $ Types.var "p")-      H.it "test #2" $-        expectPolytype-          pretypedEmptyMap-          ["k", "v"] (Types.map (Types.var "k") (Types.var "v"))--    H.describe "Type annotations on let-bound terms" $ do-      H.it "test #1" $-        expectPolytype-          (TermLet $ Let [LetBinding (Name "x") pretypedEmptyList Nothing] $ var "x")-          ["p"] (Types.list $ Types.var "p")-      H.it "test #2" $-        expectPolytype-          (TermLet $ Let [LetBinding (Name "y") pretypedEmptyMap Nothing] $ var "y")-          ["k", "v"] (Types.map (Types.var "k") (Types.var "v"))-      H.it "test #3" $-        expectPolytype-          (TermLet $ Let [-            LetBinding (Name "x") pretypedEmptyList Nothing,-            LetBinding (Name "y") pretypedEmptyMap Nothing] $ Terms.pair (var "x") (var "y"))-          ["p", "k", "v"] (Types.pair (Types.list $ Types.var "p") (Types.map (Types.var "k") (Types.var "v")))--    H.describe "Check that type variables in subterm annotations are also preserved" $ do-      H.it "test #1" $-        expectPolytype-          (typed (Types.function (Types.var "a") (Types.var "a")) $ lambda "x" $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-      H.it "test #2" $-        expectPolytype-          (typed (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "a")) $ lambda "x" $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-      H.it "test #3" $-        expectPolytype-          (lambda "x" $ typed (Types.var "a") $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-  where-    pretypedEmptyList = typed (Types.list $ Types.var "p") $ list []-    pretypedEmptyMap = typed (Types.map (Types.var "k") (Types.var "v")) $ TermMap M.empty--checkWrappedTerms :: H.SpecWith ()-checkWrappedTerms = H.describe "Check nominal introductions and eliminations" $ do--  H.describe "Nominal introductions" $ do-    H.it "test #1" $-      expectType-        (wrap testTypeStringAliasName $ string "foo")-        (TypeVariable testTypeStringAliasName)-    H.it "test #2" $-      expectType-        (lambda "v" $ wrap testTypeStringAliasName $ var "v")-        (Types.function Types.string (TypeVariable testTypeStringAliasName))--  H.it "Nominal eliminations" $ do---    expectType---      (unwrap testTypeStringAliasName)---      (Types.function testTypeStringAlias (Ann.doc "An alias for the string type" Types.string))-    expectType-      (unwrap testTypeStringAliasName @@ (wrap testTypeStringAliasName $ string "foo"))-      Types.string--spec :: H.Spec-spec = do-  return ()--  -- TODO: restore the following---   checkAlgorithmW------ --  checkEliminations--- --  checkIndividualTerms---   checkLetTerms---   checkLists---   checkLiterals--- --  checkOtherFunctionTerms---   checkPathologicalTerms--- --  checkPolymorphism---   checkPrimitives---   checkProducts--- --  checkSums--- --  checkWrappedTerms------ --  checkSubtermAnnotations--- --  checkTypeAnnotations------ --  checkUserProvidedTypes -- disabled for now; user-provided type variables are replaced with fresh variables
− src/test/haskell/Hydra/Inference/AltInferenceSpec.hs 
@@ -1,235 +0,0 @@-module Hydra.Inference.AltInferenceSpec where--import Hydra.Kernel-import Hydra.Inference.AltInference-import qualified Hydra.Tier1 as Tier1--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Test.Hspec as H-import qualified Test.HUnit.Lang as HL-import qualified Hydra.Dsl.Types as Types----- @wisnesky's original Algorithm W test cases, modified so as to normalize type variables--- Polymorphic recursion is excluded; see checkPolymorphicRecursion-checkAlgorithmW :: H.SpecWith ()-checkAlgorithmW = H.describe "Check System F syntax" $ do-  --Untyped input:-  --	(\x. x)-  --System F type:-  -- 	(v0 -> v0)-  testCase "0"-    (lambda "x" $ var "x")-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.var "t0"))--  --Untyped input:-  --	letrecs foo = (\x. x)-  --		in 42-  --System F type:-  -- 	Nat-  testCase "1"-    (int32 32 `with` [-      "foo">: lambda "x" $ var "x"])-    (Types.mono Types.int32)--  --Untyped input:-  --	let f = (\x. x) in (f 0)-  --System F type:-  -- 	Nat-  testCase "2"-    ((var "f" @@ int32 0) `with` [-      "f">: lambda "x" $ var "x"])-    (Types.mono Types.int32)--  --Untyped input:-  --	let f = ((\x. x) 0) in f-  --System F type:-  -- 	Nat-  testCase "3"-    (var "f" `with` [-      "f">: (lambda "x" $ var "x") @@ int32 0])-    (Types.mono Types.int32)--  testCase "3.5"-    (lambda "x" $ list [var "x"])-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))--  --Untyped input:-  --	let sng = (\x. (cons x nil)) in sng-  --System F type:-  -- 	(v5 -> (List v5))-  testCase "4"-    (var "sng" `with` [-      "sng">: lambda "x" $ list [var "x"]])-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))--  --Untyped input:-  --	let sng = (\x. (cons x nil)) in (pair (sng 0) (sng alice))-  --System F type:-  -- 	((List Nat) * (List String))-  testCase "5"-    (pair (var "sng" @@ int32 0) (var "sng" @@ string "alice") `with` [-      "sng">: lambda "x" $ list [var "x"]])-    (Types.mono $ Types.pair (Types.list Types.int32) (Types.list Types.string))--  --Untyped input:-  --	letrecs + = (\x. (\y. (S (+ (P x) y))))-  --		in (+ (S (S 0)) (S 0))-  --System F type:-  -- 	Nat-  testCase "6"-    ((var "+" @@ (primSucc @@ (primSucc @@ int32 0)) @@ (primSucc @@ int32 0)) `with` [-      "+">: lambda "x" $ lambda "y" (primSucc @@ (var "+" @@ (primPred @@ var "x") @@ var "y"))])-    (Types.mono Types.int32)--checkApplication :: H.SpecWith ()-checkApplication = H.describe "Check application terms" $ do--  testCase "1"-    ((lambda "x" $ var "x") @@ (int32 42))-    (Types.mono Types.int32)--  testCase "2"-    (lambda "y" ((lambda "x" $ list [var "x"]) @@ (var "y")))-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list $ Types.var "t0"))--checkLambdas :: H.SpecWith ()-checkLambdas = H.describe "Check lambda expressions" $ do--  testCase "1"-     (lambda "x" $ int32 42)-     (Types.poly ["t0"] (Types.function (Types.var "t0") Types.int32))--  testCase "2"-    (lambda "x" $ var "x")-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.var "t0"))--  testCase "3"-    (lambda "x" $ lambda "y" $ var "x")-    (Types.poly ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.var "t0")))--checkLists :: H.SpecWith ()-checkLists = H.describe "Check lists" $ do--  testCase "0"-    (list [])-    (Types.poly ["t0"] (Types.list $ Types.var "t0"))--  testCase "1"-    (list [int32 42])-    (Types.mono (Types.list Types.int32))--  testCase "2"-    (list [int32 42, int32 43])-    (Types.mono (Types.list Types.int32))--  testCase "3"-    (list [list []])-    (Types.poly ["t0"] (Types.list $ Types.list $ Types.var "t0"))--  testCase "4"-    (list [list [], list []])-    (Types.poly ["t0"] (Types.list $ Types.list $ Types.var "t0"))--  testCase "5"-    (list [list [], list [int32 42]])-    (Types.mono (Types.list $ Types.list Types.int32))--checkLambdasAndLists :: H.SpecWith ()-checkLambdasAndLists = H.describe "Check lambdas with lists" $ do--  testCase "0"-    (lambda "x" $ list [var "x"])-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))--  testCase "1"-    (lambda "x" $ list [var "x", var "x"])-    (Types.poly ["t0"] $ Types.function (Types.var "t0") (Types.list (Types.var "t0")))--  testCase "2"-    (lambda "x" $ list [var "x", int32 42])-    (Types.mono $ Types.function Types.int32 (Types.list Types.int32))--  testCase "3"-    (lambda "x" $ lambda "y" $ list [var "x", int32 42, var "y"])-    (Types.mono $ Types.function Types.int32 $ Types.function Types.int32 $ Types.list Types.int32)---- Additional test cases from @wisnesky which involve polymorphic recursion,--- and so are not expected to be supported.-checkPolymorphicRecursion :: H.SpecWith ()-checkPolymorphicRecursion = H.describe "Check selected polymorphic recursion cases" $ do-  --Untyped input:-  --	letrecs f = (\x. (\y. (f 0 x)))-  --		in f-  --System F type:-  -- 	(Nat -> (Nat -> v5))-  testCase "7"-    (var "f" `with` [-      "f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")])-    (Types.poly ["t0"] $ Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 x)))-  --		g = (\u. (\v. (f v 0)))-  --		in (pair f g)-  --System F type:-  -- 	((v12 -> (Nat -> v13)) * (Nat -> (v15 -> v16)))-  testCase "9"-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),-      "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])-    (Types.poly ["t0", "t1", "t2", "t3"] $ Types.pair-      (Types.function (Types.var "t0") (Types.function Types.int32 (Types.var "t1")))-      (Types.function Types.int32 (Types.function (Types.var "t2") (Types.var "t3"))))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 0)))-  --		g = (\u. (\v. (f v 0)))-  --		in (pair f g)-  --System F type:-  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))-  testCase "10"-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ int32 0),-      "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])-    (Types.poly ["t0", "t1"] $ Types.pair-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t1"))))--  --Untyped input:-  --	letrecs f = (\x. (\y. (g 0 x)))-  --		g = (\u. (\v. (f 0 0)))-  --		in (pair f g)-  --System F type:-  -- 	((Nat -> (Nat -> v12)) * (Nat -> (Nat -> v14)))-  testCase "11"-    ((pair (var "f") (var "g")) `with` [-      "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),-      "g">: lambda "u" $ lambda "v" (var "f" @@ int32 0 @@ int32 0)])-    (Types.poly ["t0", "t1"] $ Types.pair-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-      (Types.function Types.int32 (Types.function Types.int32 (Types.var "t1"))))--expectType :: Term -> TypeScheme -> H.Expectation-expectType term expected = shouldSucceedWith (sInferType term) expected--testCase name term typ = H.it ("test #" ++ name) $ expectType term typ--shouldSucceedWith :: (Eq a, Show a) => Flow SInferenceContext a -> a -> H.Expectation-shouldSucceedWith f x = case my of-    Nothing -> HL.assertFailure "Unknown error" -- TODO: get error message from trace-    Just y -> y `H.shouldBe` x-  where-    FlowState my _ trace = unFlow f sInitialContext Tier1.emptyTrace--spec :: H.Spec-spec = do-  checkAlgorithmW-  checkApplication-  checkLambdas-  checkLists-  checkLambdasAndLists---  checkPolymorphicRecursion
− src/test/haskell/Hydra/Inference/FundamentalsSpec.hs 
@@ -1,330 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.FundamentalsSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.Inference.InferenceTestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---checkLambdas :: H.SpecWith ()-checkLambdas = check "lambdas" $ do--    H.it "test #1" $-      expectPolytype-        (lambda "x" $ var "x")-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ int16 137)-        ["t0"] (Types.function (Types.var "t0") Types.int16)--checkLetTerms :: H.SpecWith ()-checkLetTerms = check "let terms" $ do--  H.it "test #0" $ do-    expectPolytype-      (letTerm (Name "x") (float32 42.0) (lambda "y" (lambda "z" (var "x"))))-      ["t0", "t1"] (Types.function (Types.var "t0") (Types.function (Types.var "t1") Types.float32))--  H.it "Empty let" $ do-    expectType-      ((int32 42) `with` [])-      Types.int32--  H.it "Trivial let" $ do-    expectType-      (var "foo" `with` [-        "foo">: int32 42])-      Types.int32--  H.it "Multiple references to a let-bound term" $-    expectType-      (list [var "foo", var "bar", var "foo"] `with` [-        "foo">: int32 42,-        "bar">: int32 137])-      (Types.list Types.int32)--  H.describe "Let-polymorphism" $ do-    H.it "test #1" $-      expectPolytype-        ((lambda "x" $ var "id" @@ (var "id" @@ var "x")) `with` [-          "id">: lambda "x" $ var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #2" $-      expectType-        ((var "id" @@ (list [var "id" @@ int32 42])) `with` [-          "id">: lambda "x" $ var "x"])-        (Types.list Types.int32)-    H.it "test #3" $-      expectPolytype-        ((lambda "x" (var "id" @@ (list [var "id" @@ var "x"])))-          `with` [-            "id">: lambda "x" $ var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectType-        ((pair (var "id" @@ int32 42) (var "id" @@ string "foo"))-          `with` [-            "id">: lambda "x" $ var "x"])-        (Types.pair Types.int32 Types.string)-    H.it "test #5" $-      expectType-        ((pair (var "list" @@ int32 42) (var "list" @@ string "foo"))-          `with` [-            "list">: lambda "x" $ list [var "x"]])-        (Types.pair (Types.list Types.int32) (Types.list Types.string))---    H.it "test #6" $---      expectPolytype---        ((var "f") `with` [---          "singleton">: lambda "x" $ list [var "x"],---          "f">: lambda "x" $ lambda "y" $ Terms.primitive _lists_cons---            @@ (pair (var "singleton" @@ var "x") (var "singleton" @@ var "y"))---            @@ (var "g" @@ var "x" @@ var "y"),---          "g">: lambda "x" $ lambda "y" $ var "f" @@ int32 42 @@ var "y"])---        ["t0"] (Types.list $ Types.pair Types.int32 (Types.var "t0"))--  H.describe "Recursive and mutually recursive let (@wisnesky's test cases)" $ do---    H.it "test #1" $---      expectPolytype---        ((var "f") `with` [---          "f">: lambda "x" $ lambda "y" (var "f" @@ int32 0 @@ var "x")])---        ["t0"] (Types.function Types.int32 (Types.function Types.int32 (Types.var "t0")))-    H.it "test #2" $-      expectPolytype-        ((pair (var "f") (var "g")) `with` [-          "f">: var "g",-          "g">: var "f"])-        -- Note: GHC finds (a, b) rather than (a, a)-        -- Try: :t (let (f, g) = (g, f) in (f, g))-        ["t0"] (Types.pair (Types.var "t0") (Types.var "t0"))---    H.it "test #3" $---      expectPolytype---        ((pair (var "f") (var "g")) `with` [---          "f">: lambda "x" $ lambda "y" (var "g" @@ int32 0 @@ var "x"),---          "g">: lambda "u" $ lambda "v" (var "f" @@ var "v" @@ int32 0)])---        ["t0", "t1"] (Types.pair---          (Types.function (Types.var "v0") (Types.function Types.int32 (Types.var "t1")))---          (Types.function Types.int32 (Types.function (Types.var "v0") (Types.var "t1"))))--    -- letrec + = (\x . (\y . (S (+ (P x) y)))) in (+ (S (S 0)) (S 0))---    let s = primitive _math_neg---        p = primitive _math_neg---    H.it "test #4" $---      expectPolytype---        ((var "plus" @@ (s @@ (s @@ int32 0)) @@ (s @@ int32 0)) `with` [---          "plus">: lambda "x" $ lambda "y" (s @@ (var "plus" @@ (p @@ var "x") @@ var "y"))])---        ["t0"] (Types.function Types.int32 $ Types.function (Types.var "t0") Types.int32)--    H.it "test #3" $-      expectType-        (int32 0 `with` [-          "id">: lambda "z" $ var "z",-          "f">: lambda "p0" $ pair (var "id" @@ var "p0") (var "id" @@ var "p0")])-        Types.int32---    letrecs id = (\z. z)---        f = (\p0. (pair (id p0) (id p0)))---        in 0--checkLiterals :: H.SpecWith ()-checkLiterals = check "literal values" $ do--  check "individual literal terms" $ do-    H.it "test #1" $-      expectType-        (int32 42)-        Types.int32-    H.it "test #2" $-      expectType-        (string "foo")-        Types.string-    H.it "test #3" $-      expectType-        (boolean False)-        Types.boolean-    H.it "test #4" $-      expectType-        (float64 42.0)-        Types.float64--  H.it "randomly-generated literals" $-    QC.property $ \l -> expectType-      (TermLiteral l)-      (Types.literal $ literalType l)--checkPathologicalTerms :: H.SpecWith ()-checkPathologicalTerms = check "pathological terms" $ do--  H.describe "Infinite lists" $ do-    H.it "test #1" $-      expectType-        ((var "self") `with` [-          "self">: primitive _lists_cons @@ (int32 42) @@ (var "self")])-        (Types.list Types.int32)-    H.it "test #2" $-      expectPolytype-        (lambda "x" ((var "self") `with` [-          "self">: primitive _lists_cons @@ (var "x") @@ (var "self")]))-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #3" $-      expectPolytype-        ((lambda "x" $ var "self" @@ var "x") `with` [-          "self">: lambda "e" $ primitive _lists_cons @@ (var "e") @@ (var "self" @@ var "e")])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectType-        ((var "build" @@ int32 0) `with` [-          "build">: lambda "x" $ primitive _lists_cons @@ var "x" @@ (var "build" @@-            (primitive _math_add @@ var "x" @@ int32 1))])-        (Types.list Types.int32)--  -- TODO: this term *should* fail inference, but doesn't---    H.it "Check self-application" $ do---      expectFailure---        (lambda "x" $ var "x" @@ var "x")--checkPolymorphism :: H.SpecWith ()-checkPolymorphism = check "polymorphism" $ do--  H.describe "Simple lists and optionals" $ do-    H.it "test #1" $-      expectPolytype-        (list [])-        ["t0"] (Types.list (Types.var "t0"))-    H.it "test #2" $-      expectPolytype-        (optional Nothing)-        ["t0"] (Types.optional (Types.var "t0"))-    H.it "test #3" $-      expectType-        (optional $ Just $ int32 42)-        (Types.optional Types.int32)--  H.describe "Lambdas, lists, and products" $ do-    H.it "test #1" $-      expectPolytype-        (lambda "x" $ var "x")-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ pair (var "x") (var "x"))-        ["t0"] (Types.function (Types.var "t0") (Types.pair (Types.var "t0") (Types.var "t0")))-    H.it "test #3" $-      expectPolytype-        (lambda "x" $ list [var "x"])-        ["t0"] (Types.function (Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectPolytype-        (list [lambda "x" $ var "x", lambda "y" $ var "y"])-        ["t0"] (Types.list $ Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #5" $-      expectPolytype-        (list [lambda "x" $ lambda "y" $ pair (var "y") (var "x")])-        ["t0", "t1"] (Types.list $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.pair (Types.var "t1") (Types.var "t0"))))--  H.describe "Lambdas and application" $ do-    H.it "test #1" $-      expectType-        (lambda "x" (var "x") @@ string "foo")-        Types.string--  H.describe "Primitives and application" $ do-    H.it "test #1" $-      expectType-        (primitive _lists_concat @@ list [list [int32 42], list []])-        (Types.list Types.int32)--  H.describe "Lambdas and primitives" $ do-    H.it "test #1" $-      expectType-        (primitive _math_add)-        (Types.functionN [Types.int32, Types.int32, Types.int32])-    H.it "test #2" $-      expectType-        (lambda "x" (primitive _math_add @@ var "x"))-        (Types.functionN [Types.int32, Types.int32, Types.int32])-    H.it "test #3" $-      expectType-        (lambda "x" (primitive _math_add @@ var "x" @@ var "x"))-        (Types.function Types.int32 Types.int32)--  H.describe "Mixed expressions with lambdas, constants, and primitive functions" $ do-    H.it "test #1" $-      expectType-        (lambda "x" $-            (primitive _math_sub @@ (primitive _math_add @@ var "x" @@ var "x") @@ int32 1))-        (Types.function Types.int32 Types.int32)--checkPrimitives :: H.SpecWith ()-checkPrimitives = check "terms with primitive functions" $ do--  H.describe "Monomorphic primitive functions" $ do-    H.it "test #1" $-      expectType-        (primitive $ Name "hydra/lib/strings.length")-        (Types.function Types.string Types.int32)-    H.it "test #2" $-      expectType-        (primitive _math_sub)-        (Types.function Types.int32 (Types.function Types.int32 Types.int32))--  H.describe "Polymorphic primitive functions" $ do-    H.it "test #1" $-      expectPolytype-        (lambda "el" (primitive _lists_length @@ (list [var "el"])))-        ["t0"] (Types.function (Types.var "t0") Types.int32)-    H.it "test #2" $-      expectType-        (lambda "el" (primitive _lists_length @@ (list [int32 42, var "el"])))-        (Types.function Types.int32 Types.int32)---    H.it "test #3" $ -- TODO: restore this---      expectPolytype---        (primitive _lists_concat)---        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #4" $-      expectPolytype-        (lambda "lists" (primitive _lists_concat @@ var "lists"))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") (Types.list $ Types.var "t0"))-    H.it "test #5" $-      expectPolytype-        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)-    H.it "test #6" $-      expectPolytype-        (lambda "list" (primitive _lists_length @@ (primitive _lists_concat @@ list[var "list", list []])))-        ["t0"] (Types.function (Types.list $ Types.var "t0") Types.int32)-    H.it "test #7" $-      expectPolytype-        (lambda "list" (primitive _math_add-          @@ int32 1-          @@ (primitive _lists_length @@ (primitive _lists_concat @@ list[var "list", list []]))))-        ["t0"] (Types.function (Types.list $ Types.var "t0") Types.int32)-    H.it "test #8" $-      expectPolytype-        (lambda "lists" (primitive _lists_length @@ (primitive _lists_concat @@ var "lists")))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)--spec :: H.Spec-spec = do-  checkLambdas---   checkLetTerms -- TODO: restore these-  checkLiterals---   checkPathologicalTerms -- TODO: restore these-  checkPolymorphism-  checkPrimitives-  return ()
− src/test/haskell/Hydra/Inference/InferenceSpec.hs 
@@ -1,498 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.InferenceSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---checkType :: Term -> Type -> H.Expectation-checkType term typ = typeAnn term `H.shouldBe` typ-  where-    typeAnn (TermTyped (TypedTerm _ typ)) = typ--expectMonotype :: Term -> Type -> H.Expectation-expectMonotype term = expectPolytype term []--expectPolytype :: Term-> [String] -> Type -> H.Expectation-expectPolytype term vars typ = do-    shouldSucceedWith-      (inferTypeScheme term)-      (TypeScheme (Name <$> vars) typ)--expectTypeAnnotation :: (Term -> Flow (Graph) (Term)) -> Term -> Type -> H.Expectation-expectTypeAnnotation path term etyp = shouldSucceedWith atyp etyp-  where-   atyp = do-     iterm <- inferTermType term-     selected <- path iterm-     case selected of-       TermTyped (TypedTerm _ typ) -> return typ-       _ -> fail $ "no type annotation"--checkApplicationTerms :: H.SpecWith ()-checkApplicationTerms = H.describe "Check a few hand-picked application terms" $ do--    H.it "Check lambda applications" $ do-      expectMonotype-        (apply (lambda "x" (var "x")) (string "foo"))-        Types.string--    H.it "Check mixed expressions with lambdas, constants, and primitive functions" $ do-      expectMonotype-        (lambda "x" $-          apply-            (apply (primitive _math_sub) (apply (apply (primitive _math_add) (var "x")) (var "x")))-            (int32 1))-        (Types.function Types.int32 Types.int32)--checkFunctionTerms :: H.SpecWith ()-checkFunctionTerms = H.describe "Check a few hand-picked function terms" $ do--    H.it "Check lambdas" $ do-      expectPolytype-        (lambda "x" (var "x"))-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-      expectPolytype-        (lambda "x" (int16 137))-        ["t0"] (Types.function (Types.var "t0") Types.int16)--    H.it "Check list eliminations" $ do-      let fun = Terms.fold $ primitive _math_add-      expectMonotype-        fun-        (Types.functionN [Types.int32, Types.list Types.int32, Types.int32])-      expectMonotype-        (apply fun $ int32 0)-        (Types.function (Types.list Types.int32) Types.int32)-      expectMonotype-        (apply (apply fun $ int32 0) (list (int32 <$> [1, 2, 3, 4, 5])))-        Types.int32--    H.it "Check projections" $ do-      expectMonotype-        (project testTypePersonName (Name "firstName"))-        (Types.function testTypePerson Types.string)--    H.it "Check case statements" $ do-      expectMonotype-        (match testTypeFoobarValueName Nothing [-          Field (Name "bool") (lambda "x" (boolean True)),-          Field (Name "string") (lambda "x" (boolean False)),-          Field (Name "unit") (lambda "x" (boolean False))])-        (Types.function testTypeFoobarValue Types.boolean)--checkIndividualTerms :: H.SpecWith ()-checkIndividualTerms = H.describe "Check a few hand-picked terms" $ do--    H.it "Check literal values" $ do-      expectMonotype-        (int32 42)-        Types.int32-      expectMonotype-        (string "foo")-        Types.string-      expectMonotype-        (boolean False)-        Types.boolean-      expectMonotype-        (float64 42.0)-        Types.float64--    H.it "Check let terms" $ do-      expectPolytype-        (letTerm (Name "x") (float32 42.0) (lambda "y" (lambda "z" (var "x"))))-        ["t0", "t1"] (Types.function (Types.var "t0") (Types.function (Types.var "t1") Types.float32))--    H.it "Check optionals" $ do-      expectMonotype-        (optional $ Just $ int32 42)-        (Types.optional Types.int32)-      expectPolytype-        (optional Nothing)-        ["t0"] (Types.optional $ Types.var "t0")--    H.it "Check records" $ do-      expectMonotype-        (record testTypeLatLonName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (TypeRecord $ RowType testTypeLatLonName [-          FieldType (Name "lat") Types.float32,-          FieldType (Name "lon") Types.float32])-      expectMonotype-        (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (TypeRecord $ RowType testTypeLatLonPolyName [-          FieldType (Name "lat") Types.float32,-          FieldType (Name "lon") Types.float32])-      expectMonotype-        (lambda "lon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ var "lon"]))-        (Types.function (Types.float32)-          (TypeRecord $ RowType testTypeLatLonPolyName [-            FieldType (Name "lat") $ Types.float32,-            FieldType (Name "lon") $ Types.float32]))-      expectPolytype-        (lambda "latlon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ var "latlon",-          Field (Name "lon") $ var "latlon"]))-        ["t0"] (Types.function (Types.var "t0")-          (TypeRecord $ RowType testTypeLatLonPolyName [-            FieldType (Name "lat") $ Types.var "t0",-            FieldType (Name "lon") $ Types.var "t0"]))--    H.it "Check unions" $ do-      expectMonotype-        (inject testTypeTimestampName $ Field (Name "unixTimeMillis") $ uint64 1638200308368)-        testTypeTimestamp--    H.it "Check sets" $ do-      expectMonotype-        (set $ S.fromList [boolean True])-        (Types.set Types.boolean)-      expectPolytype-        (set $ S.fromList [set S.empty])-        ["t0"] (Types.set $ Types.set $ Types.var "t0")--    H.it "Check maps" $ do-      expectMonotype-        (mapTerm $ M.fromList [(string "firstName", string "Arthur"), (string "lastName", string "Dent")])-        (Types.map Types.string Types.string)-      expectPolytype-        (mapTerm M.empty)-        ["t0", "t1"] (Types.map (Types.var "t0") (Types.var "t1"))-      expectPolytype-        (lambda "x" (lambda "y" (mapTerm $ M.fromList-          [(var "x", float64 0.1), (var "y", float64 0.2)])))-        ["t0"] (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.map (Types.var "t0") Types.float64)))--    -- -- TODO: add a case for a recursive nominal type -- e.g. MyList := () + (int, Mylist)-    -- H.it "Check nominal (newtype) terms" $ do-    --   expectMonotype-    --     testDataArthur-    --     (Types.wrap "Person")-    --   expectMonotype-    --     (lambda "x" (record [-    --       Field "firstName" $ var "x",-    --       Field "lastName" $ var "x",-    --       Field "age" $ int32 42]))-    --     (Types.function Types.string testTypePerson)--checkLetTerms :: H.SpecWith ()-checkLetTerms = H.describe "Check a few hand-picked let terms" $ do--    H.it "Check empty let" $ do-      expectMonotype-        ((int32 42) `with` [])-        Types.int32--    H.it "Check trivial let" $ do-      expectMonotype-        (var "foo" `with` [-          "foo">: int32 42])-        Types.int32--checkLists :: H.SpecWith ()-checkLists = H.describe "Check a few hand-picked list terms" $ do--    H.it "Check list of strings" $ do-      expectMonotype-        (list [string "foo", string "bar"])-        (Types.list Types.string)-    H.it "Check list of lists of strings" $ do-      expectMonotype-        (list [list [string "foo"], list []])-        (Types.list $ Types.list Types.string)-    H.it "Check empty list" $ do-      expectPolytype-        (list [])-        ["t0"] (Types.list $ Types.var "t0")-    H.it "Check list containing an empty list" $ do-      expectPolytype-        (list [list []])-        ["t0"] (Types.list $ Types.list $ Types.var "t0")-    H.it "Check lambda producing a list of integers" $ do-      expectMonotype-        (lambda "x" (list [var "x", int32 42]))-        (Types.function Types.int32 $ Types.list Types.int32)-    H.it "Check list with bound variables" $ do-      expectMonotype-        (lambda "x" (list [var "x", string "foo", var "x"]))-        (Types.function Types.string (Types.list Types.string))--checkLiterals :: H.SpecWith ()-checkLiterals = H.describe "Check arbitrary literals" $ do--    H.it "Verify that type inference preserves the literal to literal type mapping" $-      QC.property $ \l -> expectMonotype-        (TermLiteral l)-        (Types.literal $ literalType l)--checkWrappedTerms :: H.SpecWith ()-checkWrappedTerms = H.describe "Check nominal introductions and eliminations" $ do--    H.it "Check nominal introductions" $ do-      expectMonotype-        (wrap testTypeStringAliasName $ string "foo")-        testTypeStringAlias-      expectMonotype-        (lambda "v" $ wrap testTypeStringAliasName $ var "v")-        (Types.function Types.string testTypeStringAlias)--    H.it "Check nominal eliminations" $ do---       expectMonotype---         (unwrap testTypeStringAliasName)---         (Types.function testTypeStringAlias (Ann.doc "An alias for the string type" Types.string))-      expectMonotype-        (apply (unwrap testTypeStringAliasName) (wrap testTypeStringAliasName $ string "foo"))-        Types.string--checkPrimitives :: H.SpecWith ()-checkPrimitives = H.describe "Check a few hand-picked terms with primitive functions" $ do--    H.it "Check monomorphic primitive functions" $ do-      expectMonotype-        (primitive $ Name "hydra/lib/strings.length")-        (Types.function Types.string Types.int32)-      expectMonotype-        (primitive _math_sub)-        (Types.function Types.int32 (Types.function Types.int32 Types.int32))--    H.it "Check polymorphic primitive functions" $ do-      expectPolytype-        (lambda "els" (apply (primitive _lists_length) (apply (primitive _lists_concat) $ var "els")))-        ["t0"] (Types.function (Types.list $ Types.list $ Types.var "t0") Types.int32)--checkProducts :: H.SpecWith ()-checkProducts = H.describe "Check a few hand-picked product terms" $ do--    H.it "Check empty product" $ do-      expectMonotype-        (Terms.product [])-        (Types.product [])--    H.it "Check non-empty, monotyped products" $ do-      expectMonotype-        (Terms.product [string "foo", int32 42])-        (Types.product [Types.string, Types.int32])-      expectMonotype-        (Terms.product [string "foo", list [float32 42.0, float32 137.0]])-        (Types.product [Types.string, Types.list Types.float32])--    H.it "Check polytyped products" $ do-      expectPolytype-        (Terms.product [list [], string "foo"])-        ["t0"] (Types.product [Types.list $ Types.var "t0", Types.string])--checkSums :: H.SpecWith ()-checkSums = H.describe "Check a few hand-picked sum terms" $ do--    H.it "Check singleton sum terms" $ do-      expectMonotype-        (Terms.sum 0 1 $ string "foo")-        (Types.sum [Types.string])-      expectPolytype-        (Terms.sum 0 1 $ list [])-        ["t0"] (Types.sum [Types.list $ Types.var "t0"])--    H.it "Check non-singleton sum terms" $ do-      expectPolytype-        (Terms.sum 0 2 $ string "foo")-        ["t0"] (Types.sum [Types.string, Types.var "t0"])-      expectPolytype-        (Terms.sum 1 2 $ string "foo")-        ["t0"] (Types.sum [Types.var "t0", Types.string])--checkTypeAnnotations :: H.SpecWith ()-checkTypeAnnotations = H.describe "Check that type annotations are added to terms and subterms" $ do--    H.it "Check literals" $-      QC.property $ \l -> do-        let term = TermLiteral l-        let term1 = fromFlow (TermLiteral $ LiteralString "no term") testGraph (fst <$> inferTypeAndConstraints term)-        checkType term1 (Types.literal $ literalType l)--    H.it "Check lists of literals" $-      QC.property $ \l -> do-        let term = TermList [TermLiteral l]-        let term1 = fromFlow (TermLiteral $ LiteralString "no term") testGraph (fst <$> inferTypeAndConstraints term)-        checkType term1 (Types.list $ Types.literal $ literalType l)-        let (TermTyped (TypedTerm (TermList [term2]) _)) = term1-        checkType term2 (Types.literal $ literalType l)--checkSubtermAnnotations :: H.SpecWith ()-checkSubtermAnnotations = H.describe "Check additional subterm annotations" $ do--    H.it "Check literals" $-      expectTypeAnnotation pure-        (string "foo")-        (Types.string)--    H.describe "Check monotyped lists" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (list [string "foo"])-          (Types.list Types.string)-      H.it "test #2" $-        expectTypeAnnotation Expect.listHead-          (list [string "foo"])-          Types.string--    H.describe "Check monotyped lists within lambdas" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (lambda "x" $ list [var "x", string "foo"])-          (Types.function Types.string (Types.list Types.string))-      H.it "test #2" $-        expectTypeAnnotation (Expect.lambdaBody >=> Expect.listHead)-          (lambda "x" $ list [var "x", string "foo"])-          Types.string--    H.describe "Check injections" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11")-          testTypeTimestamp-      H.it "test #2" $-        expectTypeAnnotation pure-          (lambda "ignored" $ (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11"))-          (Types.function (Types.var "t0") testTypeTimestamp)--    H.it "Check projections" $ do-      expectTypeAnnotation pure-        (project testTypePersonName $ Name "firstName")-        (Types.function testTypePerson Types.string)--    H.describe "Check case statements" $ do-      H.it "test #1" $ do-        expectTypeAnnotation pure-          (match testTypeNumberName (Just $ string "it's something else") [-            Field (Name "int") $ constant $ string "it's an integer"])-          (Types.function testTypeNumber Types.string)-      H.describe "test #2" $ do-        let  testCase = match testTypeNumberName Nothing [-                          Field (Name "int") $ constant $ string "it's an integer",-                          Field (Name "float") $ constant $ string "it's a float"]-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function testTypeNumber Types.string)-        H.it "case #2" $-          expectTypeAnnotation (Expect.casesCase testTypeNumberName "int" >=> (pure . fieldTerm)) testCase-            (Types.function Types.int32 Types.string)--    H.describe "Check optional eliminations" $ do-      H.describe "test #1" $ do-        let testCase = matchOpt-                         (string "nothing")-                         (lambda "ignored" $ string "just")-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function (Types.optional $ Types.var "t2") Types.string)-        H.it "case #2" $-          expectTypeAnnotation Expect.optCasesNothing testCase-            Types.string-        H.it "case #3" $-          expectTypeAnnotation Expect.optCasesJust testCase-            (Types.function (Types.var "t2") Types.string)-      H.describe "test #2" $ do-        let testCase = lambda "getOpt" $ lambda "x" $-                         (matchOpt-                           (string "nothing")-                           (lambda "t2" $ string "just")) @@ (var "getOpt" @@ var "x")-        let getOptType = (Types.function (Types.var "t1") (Types.optional $ Types.var "t4"))-        let constStringType = Types.function (Types.var "t1") Types.string-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function getOptType constStringType)-        H.it "case #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            constStringType--    H.describe "Check unannotated 'let' terms" $ do-      H.describe "test #1" $ do-        let testCase = lambda "i" $-                         (Terms.primitive _strings_cat @@ list [string "foo", var "i", string "bar"])-                         `with` [-                           "foo">: string "FOO",-                           "bar">: string "BAR"]-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function Types.string Types.string)-        H.it "case #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            Types.string-      H.describe "test #2" $ do-        let testCase = lambda "original" $-                         var "alias" `with` [-                           "alias">: var "original"]-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function (Types.var "t0") (Types.var "t0"))-        H.it "case #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            (Types.var "t0")-        H.it "case #3" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.letBinding "alias") testCase-            (Types.var "t0")-      H.describe "test #3" $ do-        let testCase = lambda "fun" $ lambda "t" $-                         ((var "funAlias" @@ var "t") `with` [-                           "funAlias">: var "fun"])-        let funType = Types.function (Types.var "t1") (Types.var "t2")-        H.it "case #1" $-          expectTypeAnnotation pure testCase-            (Types.function funType funType)-        H.it "case #2" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody) testCase-            (Types.var "t2")-        H.it "case #3" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody >=> Expect.letBinding "funAlias") testCase-            funType----     H.describe "Check 'let' terms with type annotations on bindings" $--  where-    tmp term = shouldSucceedWith flow ()-      where-        flow = do-          iterm <- inferTermType term-          fail $ "iterm: " ++ show iterm----checkTypedTerms :: H.SpecWith ()---checkTypedTerms = H.describe "Check that term/type pairs are consistent with type inference" $ do------    H.it "Check arbitrary typed terms" $---      QC.property $ \(TypedTerm term typ) -> expectMonotype term typ--spec :: H.Spec-spec = do-  checkApplicationTerms-  checkFunctionTerms-  checkIndividualTerms-  checkLetTerms-  checkLists-  checkLiterals-  checkWrappedTerms-  checkPrimitives-  checkProducts-  checkSums-  checkTypeAnnotations-  checkSubtermAnnotations---  checkTypedTerms
− src/test/haskell/Hydra/Inference/InferenceTestUtils.hs 
@@ -1,45 +0,0 @@-module Hydra.Inference.InferenceTestUtils where--import Hydra.Kernel-import qualified Hydra.Dsl.Types as Types-import Hydra.TestUtils-import Hydra.Inference.Inference-import Hydra.Inference.Rules--import qualified Test.Hspec as H---checkType :: Term -> Type -> H.Expectation-checkType term typ = expectTypeAnnotation pure term typ--executeFlow = fromFlow (TermLiteral $ LiteralString "no term") testGraph--expectFailure :: Term -> H.Expectation-expectFailure term = do-  shouldFail (inferredTypeOf term)--expectType :: Term -> Type -> H.Expectation-expectType term typ = do-  shouldSucceedWith-    (inferredTypeOf term)-    typ--expectPolytype :: Term -> [String] -> Type -> H.Expectation-expectPolytype term vars typ = do-  shouldSucceedWith-    (inferTypeScheme term)-    (Types.poly vars typ)--expectRawType :: Term -> Type -> H.Expectation-expectRawType term typ = do-  shouldSucceedWith-    (inferredType <$> withInferenceContext (infer term))-    typ--expectTypeAnnotation :: (Term -> Flow Graph Term) -> Term -> Type -> H.Expectation-expectTypeAnnotation path term etyp = shouldSucceedWith atyp etyp-  where-   atyp = do-     iterm <- inferTermType term-     selected <- path iterm-     requireTermType selected
− src/test/haskell/Hydra/Inference/NominalTypesSpec.hs 
@@ -1,234 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.NominalTypesSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.TestUtils-import Hydra.Inference.InferenceTestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---checkCaseStatements :: H.SpecWith ()-checkCaseStatements = check "case statements (variant eliminations)" $ do--  H.it "test #1" $ do-    expectType-      (match testTypeSimpleNumberName Nothing [-        Field (Name "int") $ lambda "x" $ var "x",-        Field (Name "float") $ lambda "x" $ int32 42])-      (funT (TypeVariable testTypeSimpleNumberName) Types.int32)--  H.it "test #2" $ do-    expectType-      (match testTypeUnionMonomorphicName Nothing [-        Field (Name "bool") (lambda "x" (boolean True)),-        Field (Name "string") (lambda "x" (boolean False)),-        Field (Name "unit") (lambda "x" (boolean False))])-      (Types.function (TypeVariable testTypeUnionMonomorphicName) Types.boolean)--checkProjections :: H.SpecWith ()-checkProjections = check "projections (record eliminations)" $ do--  H.it "Projections" $ do-    expectType-      (project testTypePersonName (Name "firstName"))-      (Types.function (TypeVariable testTypePersonName) Types.string)--checkRecords :: H.SpecWith ()-checkRecords = check "records" $ do--  H.describe "Simple records" $ do-    H.it "test #1" $-      expectType-        (record testTypeLatLonName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (TypeVariable testTypeLatLonName)-    H.it "test #2" $-      expectType-        (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ float32 $ negate 122.4194])-        (Types.apply (TypeVariable testTypeLatLonPolyName) Types.float32)-    H.it "test #3" $-      expectType-        (lambda "lon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ float32 37.7749,-          Field (Name "lon") $ var "lon"]))-        (Types.function (Types.float32) (Types.apply (TypeVariable testTypeLatLonPolyName) Types.float32))-    H.it "test #4" $-      expectPolytype-        (lambda "latlon" (record testTypeLatLonPolyName [-          Field (Name "lat") $ var "latlon",-          Field (Name "lon") $ var "latlon"]))-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeLatLonPolyName) (Types.var "t0")))-    H.it "test #5" $-      expectType-        testDataArthur-        (TypeVariable testTypePersonName)--  H.describe "Record instances of simply recursive record types" $ do-    H.it "test #1" $-      expectType-        (record testTypeIntListName [-          Field (Name "head") $ int32 42,-          Field (Name "tail") $ optional $ Just $ record testTypeIntListName [-            Field (Name "head") $ int32 43,-            Field (Name "tail") $ optional Nothing]])-        (TypeVariable testTypeIntListName)-    H.it "test #2" $-      expectType-        ((lambda "x" $ record testTypeIntListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeIntListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (TypeVariable testTypeIntListName)-    H.it "test #3" $-      expectType-        (record testTypeListName [-          Field (Name "head") $ int32 42,-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ int32 43,-            Field (Name "tail") $ optional Nothing]])-        (Types.apply (TypeVariable testTypeListName) Types.int32)-    H.it "test #4" $-      expectType-        ((lambda "x" $ record testTypeListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (Types.apply (TypeVariable testTypeListName) Types.int32)-    H.it "test #5" $-      expectPolytype-        (lambda "x" $ record testTypeListName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeListName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]])-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeListName) (Types.var "t0")))--  H.describe "Record instances of mutually recursive record types" $ do-    H.it "test #1" $-      expectType-        ((lambda "x" $ record testTypeBuddyListAName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeBuddyListBName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]]) @@ int32 42)-        (Types.apply (TypeVariable testTypeBuddyListAName) Types.int32)-    H.it "test #2" $-      expectPolytype-        (lambda "x" $ record testTypeBuddyListAName [-          Field (Name "head") $ var "x",-          Field (Name "tail") $ optional $ Just $ record testTypeBuddyListBName [-            Field (Name "head") $ var "x",-            Field (Name "tail") $ optional Nothing]])-        ["t0"] (Types.function (Types.var "t0") (Types.apply (TypeVariable testTypeBuddyListAName) (Types.var "t0")))--checkTypeDefinitions :: H.SpecWith ()-checkTypeDefinitions = check "type definition terms" $ do--  unit <- pure $ string "ignored"-  H.describe "Approximation of Hydra type definitions" $ do-    H.it "test #1.a" $-      expectType-        (variant testTypeHydraTypeName (Name "literal")-          $ variant testTypeHydraLiteralTypeName (Name "boolean") unit)-        (TypeVariable testTypeHydraTypeName)-    H.it "test #1.b" $-      expectFailure-        (variant testTypeHydraTypeName (Name "literal")-          $ variant testTypeHydraLiteralTypeName (Name "boolean") $ int32 42)-    H.it "test #2.a" $-      expectType-        ((variant testTypeHydraTypeName (Name "list") $ var "otherType") `with` [-          "otherType">: variant testTypeHydraTypeName (Name "literal")-            $ variant testTypeHydraLiteralTypeName (Name "boolean") unit])-        (TypeVariable testTypeHydraTypeName)-    H.it "test #2.b" $-      expectFailure-        ((variant testTypeHydraTypeName (Name "list") $ var "otherType") `with` [-          "otherType">: variant testTypeHydraTypeName (Name "literal")-            $ variant testTypeHydraLiteralTypeName (Name "boolean") $ int32 42])--checkVariants :: H.SpecWith ()-checkVariants = check "variant terms" $ do--  H.describe "Variants" $ do-    H.it "test #1" $-      expectType-        (inject testTypeTimestampName $ Field (Name "unixTimeMillis") $ uint64 1638200308368)-        (TypeVariable testTypeTimestampName)-    H.it "test #2" $-      expectType-        (inject testTypeUnionMonomorphicName $ Field (Name "string") $ string "bar")-        (TypeVariable testTypeUnionMonomorphicName)-    H.it "test #3" $-      expectFailure-        (inject testTypeUnionMonomorphicName $ Field (Name "string") $ int32 42)--  H.describe "Polymorphic and recursive variants" $ do-    H.it "test #1" $-      expectType-        (variant testTypeUnionPolymorphicRecursiveName (Name "bool") $ boolean True)-        (Types.lambda "t0" $ Types.apply (TypeVariable testTypeUnionPolymorphicRecursiveName) (Types.var "t0"))-    H.it "test #2" $-      expectType-        (variant testTypeUnionPolymorphicRecursiveName (Name "value") $ string "foo")-        (Types.apply (TypeVariable testTypeUnionPolymorphicRecursiveName) Types.string)-    H.it "test #3" $-      expectType-        ((variant testTypeUnionPolymorphicRecursiveName (Name "other") $ var "other") `with` [-          "other">: variant testTypeUnionPolymorphicRecursiveName (Name "value") $ int32 42])-        (Types.apply (TypeVariable testTypeUnionPolymorphicRecursiveName) Types.int32)--checkWrappers :: H.SpecWith ()-checkWrappers = check "wrapper introductions and eliminations" $ do--  H.describe "Wrapper introductions" $ do-    H.it "test #1" $-      expectType-        (wrap testTypeStringAliasName $ string "foo")-        (TypeVariable testTypeStringAliasName)-    H.it "test #2" $-      expectType-        (lambda "v" $ wrap testTypeStringAliasName $ var "v")-        (Types.function Types.string (TypeVariable testTypeStringAliasName))--  H.describe "Wrapper eliminations" $ do-    H.it "test #1" $-      expectType-        (unwrap testTypeStringAliasName)-        (Types.function (TypeVariable testTypeStringAliasName) Types.string)-    H.it "test #2" $-      expectType-        (unwrap testTypeStringAliasName @@ (wrap testTypeStringAliasName $ string "foo"))-        Types.string--spec :: H.Spec-spec = do--- TODO: restore all of the below---   checkCaseStatements---   checkProjections---   checkRecords---   checkTypeDefinitions---   checkVariants---   checkWrappers-  return ()
− src/test/haskell/Hydra/Inference/SubstitutionSpec.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.SubstitutionSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.Inference.Substitution-import Hydra.Inference.Rules--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad---checkInstantiation :: H.SpecWith ()-checkInstantiation = H.describe "Check type instantiation" $ do--  H.describe "Lambdas" $ do-    H.it "test #1" $ shouldSucceedWith-      (withInferenceContext $ instantiate $ Types.scheme ["x"] $ Types.var "x")-      (Types.scheme ["t0"] $ Types.var "t0")-    H.it "test #2" $ shouldSucceedWith-      (withInferenceContext $ instantiate $ Types.scheme ["x"] $ Types.list $ Types.var "x")-      (Types.scheme ["t0"] $ Types.list $ Types.var "t0")--spec :: H.Spec-spec = do-  checkInstantiation
− src/test/haskell/Hydra/Inference/TypeAnnotationsSpec.hs 
@@ -1,325 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Hydra.Inference.TypeAnnotationsSpec where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Inference.Inference-import Hydra.TestUtils-import Hydra.TestData-import qualified Hydra.Dsl.Expect as Expect-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Annotations as Ann-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.ShorthandTypes-import Hydra.Inference.InferenceTestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad----- Check inference without unification or top-level normalization-checkRawInference :: H.SpecWith ()-checkRawInference = check "raw inference" $ do-  H.describe "Lambdas" $ do-    H.describe "test #1" $ do-      H.it "Raw" $-        expectRawType-          (lambda "x" $ var "x")-          (Types.lambda "tv_0" $ Types.function (Types.var "tv_0") (Types.var "tv_0"))-      H.it "Unified and normalized" $-        expectType-          (lambda "x" $ var "x")-          (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.var "t0"))-    H.describe "test #2" $ do-      H.it "Raw" $-        expectRawType-          ((var "id" @@ (list [var "id" @@ int32 42])) `with` [-            "id">: lambda "x" $ var "x"])-          (Types.var "tv_6")-      H.it "Unified and normalized" $-        expectType-          ((var "id" @@ (list [var "id" @@ int32 42])) `with` [-            "id">: lambda "x" $ var "x"])-          (Types.list Types.int32)--checkTypeAnnotations :: H.SpecWith ()-checkTypeAnnotations = check "type annotations on terms and subterms" $ do--  H.it "Literals" $-    QC.property $ \l -> do-      let term = TermLiteral l-      let term1 = executeFlow (inferTermType term)-      checkType term1 (Types.literal $ literalType l)--  H.it "Lists of literals" $-    QC.property $ \l -> do-      let term = TermList [TermLiteral l]-      let term1 = executeFlow (inferTermType term)-      checkType term1 (Types.list $ Types.literal $ literalType l)-      let (TermTyped (TypedTerm (TermList [term2]) _)) = term1-      checkType term2 (Types.literal $ literalType l)--checkSubtermAnnotations :: H.SpecWith ()-checkSubtermAnnotations = check "additional subterm annotations" $ do--    H.it "Literals" $-      expectTypeAnnotation pure-        (string "foo")-        (Types.string)--    H.describe "Monotyped lists" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (list [string "foo"])-          (Types.list Types.string)-      H.it "test #2" $-        expectTypeAnnotation Expect.listHead-          (list [string "foo"])-          Types.string--    H.describe "Monotyped lists within lambdas" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (lambda "x" $ list [var "x", string "foo"])-          (Types.function Types.string (Types.list Types.string))-      H.it "test #2" $-        expectTypeAnnotation (Expect.lambdaBody >=> Expect.listHead)-          (lambda "x" $ list [var "x", string "foo"])-          Types.string--    H.describe "Injections" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11")-          (TypeVariable testTypeTimestampName)-      H.it "test #2" $-        expectTypeAnnotation pure-          (lambda "ignored" $ (inject testTypeTimestampName $ Field (Name "date") $ string "2023-05-11"))-          (Types.lambda "t0" $ Types.function (Types.var "t0") (TypeVariable testTypeTimestampName))--    H.it "Projections" $ do-      expectTypeAnnotation pure-        (project testTypePersonName $ Name "firstName")-        (Types.function (TypeVariable testTypePersonName) Types.string)--    H.describe "Case statements" $ do-      H.it "test #1" $-        expectTypeAnnotation pure-          (match testTypeNumberName (Just $ string "it's something else") [-            Field (Name "int") $ constant $ string "it's an integer"])-          (Types.function (TypeVariable testTypeNumberName) Types.string)-      H.describe "test #2" $ do-        let  testCase = match testTypeNumberName Nothing [-                          Field (Name "int") $ constant $ string "it's an integer",-                          Field (Name "float") $ constant $ string "it's a float"]-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.function (TypeVariable testTypeNumberName) Types.string)-        H.it "condition #2" $-          expectTypeAnnotation (Expect.casesCase testTypeNumberName "int" >=> (pure . fieldTerm)) testCase-            (Types.function Types.int32 Types.string)--    H.describe "Optional eliminations" $ do-      H.describe "test #1" $ do-        let testCase = matchOpt-                         (string "nothing")-                         (lambda "ignored" $ string "just")-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.lambda "t0" $ Types.function (Types.optional $ Types.var "t0") Types.string)-        H.it "condition #2" $-          expectTypeAnnotation Expect.optCasesNothing testCase-            Types.string-        H.it "condition #3" $-          expectTypeAnnotation Expect.optCasesJust testCase-            (Types.lambda "t0" $ Types.function (Types.var "t0") Types.string)-      H.describe "test #2" $ do-        let testCase = lambda "getOpt" $ lambda "x" $-                         (matchOpt-                           (string "nothing")-                           (lambda "_" $ string "just")) @@ (var "getOpt" @@ var "x")-        let getOptType = (Types.function (Types.var "t0") (Types.optional $ Types.var "t1"))-        let constStringType = Types.function (Types.var "t0") Types.string-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.lambdas ["t0", "t1"] $ Types.function getOptType constStringType)-        H.it "condition #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            (Types.lambda "t0" $ constStringType)--    H.describe "Unannotated 'let' terms" $ do-      H.describe "test #1" $ do-        let testCase = lambda "i" $-                         (Terms.primitive _strings_cat @@ list [string "foo", var "i", string "bar"])-                         `with` [-                           "foo">: string "FOO",-                           "bar">: string "BAR"]-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.function Types.string Types.string)-        H.it "condition #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            Types.string-      H.describe "test #2" $ do-        let testCase = lambda "original" $-                         var "alias" `with` [-                           "alias">: var "original"]-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.var "t0"))-        H.it "condition #2" $-          expectTypeAnnotation Expect.lambdaBody testCase-            (Types.lambda "t0" $ Types.var "t0")-        H.it "condition #3" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.letBinding "alias") testCase-            (Types.lambda "t0" $ Types.var "t0")-      H.describe "test #3" $ do-        let testCase = lambda "fun" $ lambda "t" $-                         ((var "funAlias" @@ var "t") `with` [-                           "funAlias">: var "fun"])-        let funType = Types.function (Types.var "t0") (Types.var "t1")-        H.it "condition #1" $-          expectTypeAnnotation pure testCase-            (Types.lambdas ["t0", "t1"] $ Types.function funType funType)-        H.it "condition #2" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody) testCase-            (Types.lambda "t1" $ Types.var "t1")-        H.it "condition #3" $-          expectTypeAnnotation (Expect.lambdaBody >=> Expect.lambdaBody >=> Expect.letBinding "funAlias") testCase-            (Types.lambdas ["t0", "t1"] funType)-  where-    tmp term = shouldSucceedWith flow ()-      where-        flow = do-          iterm <- inferTermType term-          fail $ "iterm: " ++ show iterm--checkTyped :: H.SpecWith ()-checkTyped = check "type-annotated terms" $ do--  H.describe "Monomorphic typed terms" $ do-    H.it "test #1" $-      expectType-        (typed Types.string $ string "foo")-        Types.string-    H.it "test #2" $-      expectType-        (pair (typed Types.string $ string "foo") (int32 42))-        (Types.pair Types.string Types.int32)--  H.describe "Polymorphic typed terms" $ do-     H.it "test #1" $-        expectPolytype-          (typed (Types.lambda "t0" $ Types.function (Types.var "t0") (Types.var "t0")) $ lambda "x" $ var "x")-          ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-     H.it "test #2" $-        expectPolytype-          (typed (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "a")) $ lambda "x" $ var "x")-          ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))--  -- TODO: restore these---   H.describe "Check that incorrectly typed terms fail" $ do---     H.it "test #1" $---       expectFailure $ typed---         (Types.int32)---         (string "foo")---     H.it "test #2" $---       expectFailure $ typed---         (Types.pair Types.string Types.int32)---         (string "foo")---     H.it "test #3" $---       expectFailure $ typed---         (Types.pair Types.string Types.int32)---         (pair (string "foo") (string "bar"))---     H.it "test #4" $---       expectFailure $ typed---         (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "a"))---         (var "x")--  H.describe "Borderline cases for which type inference arguably should fail, but does not" $ do---     H.it "test #5" $---       expectType---         (typed---           (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "a"))---           (lambda "x" $ int32 42))---         (Types.function Types.int32 Types.int32)-    H.it "test #6" $-      expectPolytype-        (typed-          (Types.lambda "a" $ Types.var "a")-          (lambda "x" $ var "x"))-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))-    H.it "test #7" $-      expectPolytype-        (typed-          (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "b"))-          (lambda "x" $ var "x"))-        ["t0"] (Types.function (Types.var "t0") (Types.var "t0"))----checkTypedTerms :: H.SpecWith ()---checkTypedTerms = H.describe "Check that term/type pairs are consistent with type inference" $ do------    H.it "Arbitrary typed terms" $---      QC.property $ \(TypedTerm typ term) -> expectType term typ--checkUserProvidedTypes :: H.SpecWith ()-checkUserProvidedTypes = check "user-provided type annotations" $ do--    H.describe "Top-level type annotations" $ do-      H.it "test #1" $-        expectPolytype-          pretypedEmptyList-          ["p"] (Types.list $ Types.var "p")-      H.it "test #2" $-        expectPolytype-          pretypedEmptyMap-          ["k", "v"] (Types.map (Types.var "k") (Types.var "v"))--    H.describe "Type annotations on let-bound terms" $ do-      H.it "test #1" $-        expectPolytype-          (TermLet $ Let [LetBinding (Name "x") pretypedEmptyList Nothing] $ var "x")-          ["p"] (Types.list $ Types.var "p")-      H.it "test #2" $-        expectPolytype-          (TermLet $ Let [LetBinding (Name "y") pretypedEmptyMap Nothing] $ var "y")-          ["k", "v"] (Types.map (Types.var "k") (Types.var "v"))-      H.it "test #3" $-        expectPolytype-          (TermLet $ Let [-            LetBinding (Name "x") pretypedEmptyList Nothing,-            LetBinding (Name "y") pretypedEmptyMap Nothing] $ Terms.pair (var "x") (var "y"))-          ["p", "k", "v"] (Types.pair (Types.list $ Types.var "p") (Types.map (Types.var "k") (Types.var "v")))--    H.describe "Check that type variables in subterm annotations are also preserved" $ do-      H.it "test #1" $-        expectPolytype-          (typed (Types.function (Types.var "a") (Types.var "a")) $ lambda "x" $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-      H.it "test #2" $-        expectPolytype-          (typed (Types.lambda "a" $ Types.function (Types.var "a") (Types.var "a")) $ lambda "x" $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-      H.it "test #3" $-        expectPolytype-          (lambda "x" $ typed (Types.var "a") $ var "x")-          ["a"] (Types.function (Types.var "a") (Types.var "a"))-  where-    pretypedEmptyList = typed (Types.list $ Types.var "p") $ list []-    pretypedEmptyMap = typed (Types.map (Types.var "k") (Types.var "v")) $ TermMap M.empty--spec :: H.Spec-spec = do---   checkRawInference -- TODO: restore these---   checkSubtermAnnotations -- TODO: restore these-  checkTypeAnnotations---  checkTyped -- TODO: restore these----  checkTypedTerms -- (excluded for now)---  checkUserProvidedTypes -- disabled for now; user-provided type variables are replaced with fresh variables-  return ()
+ src/test/haskell/Hydra/InferenceSpec.hs view
@@ -0,0 +1,1699 @@+-- Additional inference tests, adding to those in the generated test suite++{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.InferenceSpec.spec+-}++module Hydra.InferenceSpec where++import Hydra.Kernel+import Hydra.TestUtils+import Hydra.Staging.TestGraph+import Hydra.Tools.Monads+import qualified Hydra.Lib.Flows as Flows+import           Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.Char as C+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+++spec :: H.Spec+spec = do+  checkTypeOf+  checkFailTypeOfOnUntypedTerms++----------------------------------------++checkFailTypeOfOnUntypedTerms :: H.SpecWith ()+checkFailTypeOfOnUntypedTerms = H.describe "Fail on untyped (pre-inference) terms" $ do+  H.describe "Untyped lambdas" $ do+    withDefaults typeOfShouldFail "untyped var in record"+      (lambda "x" (record testTypeLatLonName [+        field "lat" (float32 19.5429),+        field "lon" (var "x")]))++----------------------------------------++checkTypeOf :: H.SpecWith ()+checkTypeOf = H.describe "typeOf" $ do+  checkTypeOfAnnotatedTerms+  checkTypeOfApplications+  checkTypeOfFunctions+  checkTypeOfLetTerms+  checkTypeOfLists+  checkTypeOfLiterals+  checkTypeOfMaps+  checkTypeOfOptionals+  checkTypeOfProducts+  checkTypeOfRecords+  checkTypeOfSets+  checkTypeOfSums+  checkTypeOfUnions+  checkTypeOfUnit+  checkTypeOfVariables+  checkTypeOfWrappedTerms++checkTypeOfAnnotatedTerms :: H.SpecWith ()+checkTypeOfAnnotatedTerms = H.describe "Annotated terms" $ do+  H.describe "Top-level annotations" $ do+    expectTypeOf "annotated literal"+      (annotated (int32 42) M.empty)+      Types.int32+    expectTypeOf "annotated list"+      (annotated (list [string "a", string "b"]) M.empty)+      (Types.list Types.string)+    expectTypeOf "annotated record"+      (annotated (record testTypePersonName [+        field "firstName" (string "John"),+        field "lastName" (string "Doe"),+        field "age" (int32 25)]) M.empty)+      (Types.var "Person")+    expectTypeOf "annotated lambda"+      (annotated (lambda "x" $ var "x") M.empty)+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))++  H.describe "Nested annotations" $ do+    expectTypeOf "annotation within annotation"+      (annotated (annotated (int32 100) M.empty) M.empty)+      Types.int32+    expectTypeOf "annotated terms in tuple"+      (tuple [annotated (int32 1) M.empty,+              annotated (string "hello") M.empty])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "annotated term in function application"+      (annotated (lambda "x" $ var "x") M.empty @@ annotated (int32 42) M.empty)+      Types.int32++  H.describe "Annotations in complex contexts" $ do+    expectTypeOf "annotated let binding"+      (lets ["x">: annotated (int32 5) M.empty,+             "y">: annotated (string "world") M.empty] $+            annotated (tuple [var "x", var "y"]) M.empty)+      (Types.product [Types.int32, Types.string])+    expectTypeOf "annotated record fields"+      (record testTypePersonName [+        field "firstName" (annotated (string "Alice") M.empty),+        field "lastName" (annotated (string "Smith") M.empty),+        field "age" (annotated (int32 30) M.empty)])+      (Types.var "Person")+    expectTypeOf "annotated function in application"+      (lets ["add">: annotated (primitive _math_add) M.empty] $+            var "add" @@ annotated (int32 10) M.empty @@ annotated (int32 20) M.empty)+      Types.int32++checkTypeOfApplications :: H.SpecWith ()+checkTypeOfApplications = H.describe "Applications" $ do+  H.describe "Simple function applications" $ do+    expectTypeOf "identity application"+      (lambda "x" (var "x") @@ int32 42)+      Types.int32+    expectTypeOf "primitive application"+      (primitive _math_add @@ int32 10 @@ int32 20)+      Types.int32+    expectTypeOf "string concatenation"+      (primitive _strings_cat2 @@ string "hello" @@ string "world")+      Types.string++  H.describe "Partial applications" $ do+    expectTypeOf "partially applied add"+      (primitive _math_add @@ int32 5)+      (Types.function Types.int32 Types.int32)+    expectTypeOf "partially applied string cat"+      (primitive _strings_cat2 @@ string "prefix")+      (Types.function Types.string Types.string)++  H.describe "Higher-order applications" $ do+    expectTypeOf "apply function to function"+      (lets ["apply">: lambda "f" $ lambda "x" $ var "f" @@ var "x",+             "double">: lambda "n" $ primitive _math_mul @@ var "n" @@ int32 2] $+            var "apply" @@ var "double" @@ int32 5)+      Types.int32+    expectTypeOf "function composition"+      (lets ["compose">: lambda "f" $ lambda "g" $ lambda "x" $ var "f" @@ (var "g" @@ var "x"),+             "add1">: lambda "n" $ primitive _math_add @@ var "n" @@ int32 1,+             "mul2">: lambda "n" $ primitive _math_mul @@ var "n" @@ int32 2] $+            var "compose" @@ var "add1" @@ var "mul2" @@ int32 3)+      Types.int32++  H.describe "Polymorphic applications" $ do+    expectTypeOf "polymorphic identity"+      (lets ["id">: lambda "x" $ var "x"] $+            tuple [var "id" @@ int32 42, var "id" @@ string "hello"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "polymorphic const"+      (lets ["const">: lambdas ["x", "y"] $ var "x"] $+             var "const" @@ string "keep" @@ int32 999)+      Types.string+    expectTypeOf "polymorphic flip"+      (lets ["flip">: lambda "f" $ lambda "x" $ lambda "y" $ var "f" @@ var "y" @@ var "x"] $+            var "flip" @@ primitive _strings_cat2 @@ string "world" @@ string "hello")+      Types.string++  H.describe "Applications in complex contexts" $ do+    expectTypeOf "application in tuple"+      (tuple [primitive _math_add @@ int32 1 @@ int32 2,+              primitive _strings_cat2 @@ string "a" @@ string "b"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "application in record"+      (record testTypePersonName [+        field "firstName" (primitive _strings_cat2 @@ string "John" @@ string "ny"),+        field "lastName" (string "Doe"),+        field "age" (primitive _math_add @@ int32 20 @@ int32 5)])+      (Types.var "Person")+    expectTypeOf "application in let binding"+      (lets ["result">: primitive _math_mul @@ int32 6 @@ int32 7] $+            var "result")+      Types.int32+    expectTypeOf "nested applications"+      (primitive _math_add @@ (primitive _math_mul @@ int32 3 @@ int32 4) @@ (primitive _math_add @@ int32 1 @@ int32 2))+      Types.int32++  H.describe "Applications with complex arguments" $ do+    expectTypeOf "application with record argument"+      (lets ["getName">: lambda "person" $ project testTypePersonName (Name "firstName") @@ var "person"] $+            var "getName" @@ record testTypePersonName [+              field "firstName" (string "Alice"),+              field "lastName" (string "Smith"),+              field "age" (int32 25)])+      Types.string+    expectTypeOf "application with list argument"+      (lets ["head">: lambda "xs" $ primitive _lists_head @@ var "xs"] $+            var "head" @@ list [string "first", string "second"])+      Types.string++checkTypeOfEliminations :: H.SpecWith ()+checkTypeOfEliminations = H.describe "Eliminations" $ do+  checkTypeOfProductEliminations+  checkTypeOfRecordEliminations+  checkTypeOfUnionEliminations+  checkTypeOfWrapEliminations++checkTypeOfFunctions :: H.SpecWith ()+checkTypeOfFunctions = H.describe "Functions" $ do+  checkTypeOfEliminations+  checkTypeOfLambdas+  checkTypeOfPrimitives++checkTypeOfLambdas :: H.SpecWith ()+checkTypeOfLambdas = H.describe "Lambdas" $ do+  H.describe "Simple lambdas" $ do+    expectTypeOf "identity function"+      (lambda "x" $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "constant function"+      (lambda "x" $ int32 42)+      (Types.forAll "t0" $ Types.function (Types.var "t0") Types.int32)++  H.describe "Multi-parameter lambdas" $ do+    expectTypeOf "two parameters"+      (lambda "x" $ lambda "y" $ var "x")+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.var "t0")))+    expectTypeOf "three parameters"+      (lambda "x" $ lambda "y" $ lambda "z" $ var "y")+      (Types.forAlls ["t0", "t1", "t2"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.function (Types.var "t2") (Types.var "t1"))))+    expectTypeOf "parameter reuse"+      (lambda "x" $ lambda "y" $ tuple [var "x", var "x", var "y"])+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.product [Types.var "t0", Types.var "t0", Types.var "t1"])))++  H.describe "Lambdas with operations" $ do+    expectTypeOf "lambda with primitive"+      (lambda "x" $ primitive _math_add @@ var "x" @@ int32 1)+      (Types.function Types.int32 Types.int32)+    expectTypeOf "lambda with application"+      (lambda "f" $ lambda "x" $ var "f" @@ var "x")+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.function (Types.var "t0") (Types.var "t1")) (Types.function (Types.var "t0") (Types.var "t1")))+    expectTypeOf "lambda with construction"+      (lambda "x" $ lambda "y" $ tuple [var "x", var "y"])+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.product [Types.var "t0", Types.var "t1"])))++  H.describe "Nested lambdas" $ do+    expectTypeOf "lambda returning lambda"+      (lambda "x" $ lambda "y" $ lambda "z" $ var "x")+      (Types.forAlls ["t0", "t1", "t2"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.function (Types.var "t2") (Types.var "t0"))))+    expectTypeOf "lambda with let binding"+      (lambda "x" $ lets ["y">: var "x"] $ var "y")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "lambda with inner lambda"+      (lambda "outer" $ lets ["inner">: lambda "x" $ var "x"] $ var "inner" @@ var "outer")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))++  H.describe "Lambdas in complex contexts" $ do+    expectTypeOf "lambda in tuple"+      (tuple [lambda "x" $ var "x", int32 42])+      (Types.forAll "t0" $ Types.product [Types.function (Types.var "t0") (Types.var "t0"), Types.int32])+    expectTypeOf "lambda in list"+      (list [lambda "x" $ primitive _math_add @@ var "x" @@ int32 1,+             lambda "y" $ primitive _math_mul @@ var "y" @@ int32 2])+      (Types.list $ Types.function Types.int32 Types.int32)+    expectTypeOf "lambda in record"+      (lambda "name" $ record testTypePersonName [+        field "firstName" (var "name"),+        field "lastName" (string "Doe"),+        field "age" (int32 30)])+      (Types.function Types.string (Types.var "Person"))++  H.describe "Higher-order lambdas" $ do+    expectTypeOf "function composition"+      (lambda "f" $ lambda "g" $ lambda "x" $ var "f" @@ (var "g" @@ var "x"))+      (Types.forAlls ["t0", "t1", "t2"] $ Types.function+        (Types.function (Types.var "t0") (Types.var "t1"))+        (Types.function+          (Types.function (Types.var "t2") (Types.var "t0"))+          (Types.function (Types.var "t2") (Types.var "t1"))))+    expectTypeOf "function application"+      (lambda "f" $ lambda "x" $ var "f" @@ var "x")+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.function (Types.var "t0") (Types.var "t1")) (Types.function (Types.var "t0") (Types.var "t1")))+    expectTypeOf "curried function"+      (lambda "x" $ lambda "y" $ lambda "z" $ primitive _logic_ifElse @@ var "x" @@ var "y" @@ var "z")+      (Types.forAll "t0" $ Types.function Types.boolean (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.var "t0"))))++checkTypeOfLetTerms :: H.SpecWith ()+checkTypeOfLetTerms = H.describe "Let terms" $ do+  H.describe "Simple let bindings" $ do+    expectTypeOf "single binding"+      (lets ["x">: int32 42] $+            var "x")+      Types.int32+    expectTypeOf "multiple bindings"+      (lets ["x">: int32 42,+             "y">: string "hello"] $+            tuple [var "x", var "y"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "binding shadowing"+      (lets ["x">: int32 1] $+       lets ["x">: string "shadow"] $+            var "x")+      Types.string++  H.describe "Recursive bindings" $ do+    expectTypeOf "simple arithmetic recursion"+      (lets ["double">: lambda "n" $ primitive _math_add @@ var "n" @@ var "n"] $+            var "double" @@ int32 5)+      Types.int32++  H.describe "Mutual recursion" $ do+    expectTypeOf "mutually recursive data"+      (lets ["listA">: record testTypeBuddyListAName [+               field "head" (int32 1),+               field "tail" (just $ var "listB")],+             "listB">: record testTypeBuddyListBName [+               field "head" (int32 2),+               field "tail" (nothing)]] $+            var "listA")+      (Types.apply (Types.var "BuddyListA") Types.int32)+    expectTypeOf "(monomorphic) mutually recursive functions"+      (lets ["f">: lambda "x" $ var "g" @@ var "x",+             "g">: lambda "y" $ primitive _math_add @@ var "y" @@ int32 1] $+            var "f" @@ int32 5)+      Types.int32++  H.describe "Nested let terms" $ do+    expectTypeOf "monomorphic nesting"+      (lets ["x">: int32 1] $+       lets ["y">: primitive _math_add @@ var "x" @@ int32 2] $+       lets ["z">: primitive _math_mul @@ var "y" @@ int32 3] $+            var "z")+      Types.int32+    expectTypeOf "polymorphic nesting"+      (lets ["id">: lambda "x" $ var "x"] $+       lets ["apply">: lambda "f" $ lambda "x" $ var "f" @@ var "x"] $+            var "apply" @@ var "id" @@ string "test")+      Types.string+    expectTypeOf "variable capture avoidance"+      (lets ["x">: int32 1] $+            lambda "x" $ lets ["y">: var "x"] $+                              var "y")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))++  H.describe "Let with complex expressions" $ do+    expectTypeOf "let in record"+      (record testTypePersonName [+        field "firstName" (lets ["first">: string "John",+                                "middle">: string "Q"] $+                               primitive _strings_cat2 @@ var "first" @@ var "middle"),+        field "lastName" (string "Doe"),+        field "age" (int32 30)])+      (Types.var "Person")+    expectTypeOf "let in function application"+      (lets ["x">: int32 5,+             "y">: int32 3] $+            primitive _math_add @@ var "x" @@ var "y")+      Types.int32+    expectTypeOf "polymorphic let binding"+      (lets ["id">: lambda "x" $ var "x"] $+            tuple [var "id" @@ int32 42, var "id" @@ string "hello"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "composition"+      (lets ["compose">: lambda "f" $ lambda "g" $ lambda "x" $ var "f" @@ (var "g" @@ var "x"),+             "add1">: lambda "n" $ primitive _math_add @@ var "n" @@ int32 1,+             "double">: lambda "n" $ primitive _math_mul @@ var "n" @@ int32 2] $+            (var "compose" @@ var "add1" @@ var "double") @@ int32 5)+      Types.int32++checkTypeOfLists :: H.SpecWith ()+checkTypeOfLists = H.describe "Lists" $ do+  H.describe "Lists of literals" $ do+    expectTypeOf "int list"+      (list [int32 1, int32 2])+      (Types.list Types.int32)+    expectTypeOf "string list"+      (list [string "hello", string "world"])+      (Types.list Types.string)+    expectTypeOf "single element list"+      (list [bigint 42])+      (Types.list Types.bigint)+    expectTypeOf "mixed numeric types"+      (list [float32 1.0, float32 2.5, float32 3.14])+      (Types.list Types.float32)+  H.describe "Empty lists" $ do+    expectTypeOf "empty list"+      (list [])+      (Types.forAll "t0" $ Types.list $ Types.var "t0")+    expectTypeOf "pair of empty lists"+      (pair (list []) (list []))+      (Types.forAlls ["t0", "t1"] $ Types.pair (Types.list $ Types.var "t0") (Types.list $ Types.var "t1"))+    expectTypeOf "empty list in tuple"+      (tuple [list [], string "context"])+      (Types.forAll "t0" $ Types.product [Types.list $ Types.var "t0", Types.string])+  H.describe "Polymorphic lists" $ do+    expectTypeOf "list from lambda"+      (lambda "x" $ list [var "x"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.list $ Types.var "t0"))+    expectTypeOf "list with repeated var"+      (lambda "x" $ list [var "x", var "x"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.list $ Types.var "t0"))+    expectTypeOf "list from two lambdas"+      (lambda "x" $ lambda "y" $ list [var "x", var "y"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.list $ Types.var "t0")))+  H.describe "Nested lists" $ do+    expectTypeOf "list of lists"+      (list [list [int32 1], list [int32 2, int32 3]])+      (Types.list $ Types.list Types.int32)+    expectTypeOf "empty nested lists"+      (list [list [], list []])+      (Types.forAll "t0" $ Types.list $ Types.list $ Types.var "t0")+    expectTypeOf "nested polymorphic"+      (lambda "x" $ list [list [var "x"]])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.list $ Types.list $ Types.var "t0"))+  H.describe "Lists in complex contexts" $ do+    expectTypeOf "multiple lists in tuple"+      (tuple [+        list [int32 1, int32 2],+        list [string "a", string "b"]])+      (Types.product [Types.list Types.int32, Types.list Types.string])++checkTypeOfLiterals :: H.SpecWith ()+checkTypeOfLiterals = H.describe "Literals" $ do+  H.describe "Boolean literals" $ do+    expectTypeOf "true"+      (boolean True)+      Types.boolean+    expectTypeOf "false"+      (boolean False)+      Types.boolean++  H.describe "String literals" $ do+    expectTypeOf "simple string"+      (string "hello")+      Types.string+    expectTypeOf "empty string"+      (string "")+      Types.string+    expectTypeOf "unicode string"+      (string "café")+      Types.string++  H.describe "Integer literals" $ do+    expectTypeOf "bigint"+      (bigint 42)+      Types.bigint+    expectTypeOf "int8"+      (int8 127)+      Types.int8+    expectTypeOf "int16"+      (int16 32767)+      Types.int16+    expectTypeOf "int32"+      (int32 2147483647)+      Types.int32+    expectTypeOf "int64"+      (int64 9223372036854775807)+      Types.int64+    expectTypeOf "uint8"+      (uint8 255)+      Types.uint8+    expectTypeOf "uint16"+      (uint16 65535)+      Types.uint16+    expectTypeOf "uint32"+      (uint32 4294967295)+      Types.uint32+    expectTypeOf "uint64"+      (uint64 18446744073709551615)+      Types.uint64++  H.describe "Float literals" $ do+    expectTypeOf "bigfloat"+      (bigfloat 3.14159)+      Types.bigfloat+    expectTypeOf "float32"+      (float32 2.71828)+      Types.float32+    expectTypeOf "float64"+      (float64 1.41421)+      Types.float64++  H.describe "Binary literals" $ do+    expectTypeOf "binary"+      (binary "SGVsbG8gV29ybGQ=")  -- "Hello World" in base64+      Types.binary++  H.describe "Literals in complex contexts" $ do+    expectTypeOf "literals in tuple"+      (tuple [boolean True, string "test", int32 42, float32 3.14])+      (Types.product [Types.boolean, Types.string, Types.int32, Types.float32])+    expectTypeOf "literals in list"+      (list [string "one", string "two", string "three"])+      (Types.list Types.string)+    expectTypeOf "literals in record"+      (record testTypePersonName [+        field "firstName" (string "Alice"),+        field "lastName" (string "Smith"),+        field "age" (int32 30)])+      (Types.var "Person")+    expectTypeOf "literals in let binding"+      (lets ["x">: int32 100,+             "y">: string "hello",+             "z">: boolean True] $+            tuple [var "x", var "y", var "z"])+      (Types.product [Types.int32, Types.string, Types.boolean])++checkTypeOfMaps :: H.SpecWith ()+checkTypeOfMaps = H.describe "Maps" $ do+  H.describe "Monomorphic maps" $ do+    expectTypeOf "empty map"+      (Terms.map M.empty)+      (Types.forAlls ["t0", "t1"] $ Types.map (Types.var "t0") (Types.var "t1"))+    expectTypeOf "int to string map"+      (Terms.map $ M.fromList [(int32 1, string "one"),+                               (int32 2, string "two")])+      (Types.map Types.int32 Types.string)+    expectTypeOf "string to int map"+      (Terms.map $ M.fromList [(string "a", int32 1),+                               (string "b", int32 2)])+      (Types.map Types.string Types.int32)+    expectTypeOf "single entry map"+      (Terms.map $ M.singleton (bigint 42) (boolean True))+      (Types.map Types.bigint Types.boolean)++  H.describe "Polymorphic maps" $ do+    expectTypeOf "map from lambda keys"+      (lambda "k" $ Terms.map $ M.singleton (var "k") (string "value"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.map (Types.var "t0") Types.string))+    expectTypeOf "map from lambda values"+      (lambda "v" $ Terms.map $ M.singleton (string "key") (var "v"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.map Types.string (Types.var "t0")))+    expectTypeOf "map from lambda both"+      (lambda "k" $ lambda "v" $ Terms.map $ M.singleton (var "k") (var "v"))+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.map (Types.var "t0") (Types.var "t1"))))+    expectTypeOf "map with repeated variables"+      (lambda "x" $ Terms.map $ M.singleton (var "x") (var "x"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.map (Types.var "t0") (Types.var "t0")))++  H.describe "Maps in complex contexts" $ do+    expectTypeOf "map in tuple"+      (tuple [Terms.map $ M.singleton (int32 1) (string "one"),+              string "context"])+      (Types.product [Types.map Types.int32 Types.string, Types.string])+    expectTypeOf "nested maps"+      (Terms.map $ M.singleton (string "outer") (Terms.map $ M.singleton (int32 1) (boolean True)))+      (Types.map Types.string (Types.map Types.int32 Types.boolean))+    expectTypeOf "map in let binding"+      (lets ["lookup">: Terms.map $ M.fromList [(string "key1", int32 100),+                                                (string "key2", int32 200)]] $+            var "lookup")+      (Types.map Types.string Types.int32)++  H.describe "Maps with complex types" $ do+    expectTypeOf "map of records"+      (Terms.map $ M.singleton (string "person1")+                     (record testTypePersonName [+                       field "firstName" (string "Alice"),+                       field "lastName" (string "Smith"),+                       field "age" (int32 25)]))+      (Types.map Types.string (Types.var "Person"))+    expectTypeOf "map of lists"+      (Terms.map $ M.fromList [(int32 1, list [string "a", string "b"]),+                               (int32 2, list [string "c", string "d"])])+      (Types.map Types.int32 (Types.list Types.string))+    expectTypeOf "map of tuples"+      (Terms.map $ M.singleton (string "coords") (tuple [int32 10, int32 20]))+      (Types.map Types.string (Types.product [Types.int32, Types.int32]))++checkTypeOfOptionals :: H.SpecWith ()+checkTypeOfOptionals = H.describe "Optionals" $ do+  H.describe "Monomorphic optionals" $ do+    expectTypeOf "nothing"+      (nothing)+      (Types.forAll "t0" $ Types.optional $ Types.var "t0")+    expectTypeOf "just int"+      (just $ int32 42)+      (Types.optional Types.int32)+    expectTypeOf "just string"+      (just $ string "hello")+      (Types.optional Types.string)+    expectTypeOf "just boolean"+      (just $ boolean True)+      (Types.optional Types.boolean)++  H.describe "Polymorphic optionals" $ do+    expectTypeOf "optional from lambda"+      (lambda "x" $ just $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.optional $ Types.var "t0"))+    expectTypeOf "nothing from lambda"+      (lambda "x" $ nothing)+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.optional $ Types.var "t1"))+    expectTypeOf "conditional optional"+      (lambda "x" $ lambda "flag" $+        primitive _logic_ifElse @@ var "flag" @@+          (just $ var "x") @@+          (nothing))+      (Types.forAlls ["t0"] $ Types.function (Types.var "t0") (Types.function Types.boolean (Types.optional $ Types.var "t0")))++  H.describe "Optionals in complex contexts" $ do+    expectTypeOf "optional in tuple"+      (tuple [just $ int32 100, string "context"])+      (Types.product [Types.optional Types.int32, Types.string])+    expectTypeOf "optional in record"+      (record testTypeBuddyListAName [+        field "head" (string "first"),+        field "tail" (just $ record testTypeBuddyListBName [+          field "head" (string "second"),+          field "tail" (nothing)])])+      (Types.apply (Types.var "BuddyListA") Types.string)+    expectTypeOf "optional in let binding"+      (lets ["maybeValue">: just $ int32 42] $+            var "maybeValue")+      (Types.optional Types.int32)++  H.describe "Nested optionals" $ do+    expectTypeOf "optional of optional"+      (just $ just $ string "nested")+      (Types.optional $ Types.optional Types.string)+    expectTypeOf "optional of list"+      (just $ list [int32 1, int32 2, int32 3])+      (Types.optional $ Types.list Types.int32)+    expectTypeOf "list of optionals"+      (list [just $ string "a", nothing, just $ string "b"])+      (Types.list $ Types.optional Types.string)++  H.describe "Optionals with complex types" $ do+    expectTypeOf "optional record"+      (just $ record testTypePersonName [+        field "firstName" (string "Alice"),+        field "lastName" (string "Smith"),+        field "age" (int32 30)])+      (Types.optional $ Types.var "Person")+    expectTypeOf "optional tuple"+      (just $ tuple [int32 10, string "test"])+      (Types.optional $ Types.product [Types.int32, Types.string])+    expectTypeOf "optional map"+      (just $ Terms.map $ M.singleton (string "key") (int32 42))+      (Types.optional $ Types.map Types.string Types.int32)++checkTypeOfPrimitives :: H.SpecWith ()+checkTypeOfPrimitives = H.describe "Primitives" $ do+  H.describe "Nullary primitives" $ do+    expectTypeOf "empty map"+      (primitive _maps_empty)+      (Types.forAlls ["t0", "t1"] $ Types.map (Types.var "t0") (Types.var "t1"))+    expectTypeOf "empty set"+      (primitive _sets_empty)+      (Types.forAll "t0" $ Types.set $ Types.var "t0")++  H.describe "Unary primitives" $ do+    expectTypeOf "lists head"+      (primitive _lists_head)+      (Types.forAll "t0" $ Types.function (Types.list $ Types.var "t0") (Types.var "t0"))+    expectTypeOf "math neg"+      (primitive _math_neg)+      (Types.function Types.int32 Types.int32)+    expectTypeOf "logic not"+      (primitive _logic_not)+      (Types.function Types.boolean Types.boolean)++  H.describe "Binary primitives" $ do+    expectTypeOf "math add"+      (primitive _math_add)+      (Types.function Types.int32 (Types.function Types.int32 Types.int32))+    expectTypeOf "lists cons"+      (primitive _lists_cons)+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.function (Types.list $ Types.var "t0") (Types.list $ Types.var "t0")))+    expectTypeOf "maps insert"+      (primitive _maps_insert)+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.var "t0")+        (Types.function (Types.var "t1") (Types.function (Types.map (Types.var "t0") (Types.var "t1")) (Types.map (Types.var "t0") (Types.var "t1")))))++  H.describe "Ternary primitives" $ do+    expectTypeOf "logic ifElse"+      (primitive _logic_ifElse)+      (Types.forAll "t0" $ Types.function Types.boolean (Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.var "t0"))))+    expectTypeOf "lists foldl"+      (primitive _lists_foldl)+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.var "t0")))+        (Types.function (Types.var "t0") (Types.function (Types.list $ Types.var "t1") (Types.var "t0"))))++  H.describe "Monomorphic vs polymorphic" $ do+    expectTypeOf "monomorphic math"+      (primitive _math_add)+      (Types.function Types.int32 (Types.function Types.int32 Types.int32))+    expectTypeOf "polymorphic identity"+      (primitive _equality_identity)+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "polymorphic map"+      (primitive _lists_map)+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.function (Types.var "t0") (Types.var "t1"))+        (Types.function (Types.list $ Types.var "t0") (Types.list $ Types.var "t1")))++  H.describe "Higher-order primitives" $ do+    expectTypeOf "lists map function"+      (primitive _lists_map @@ (lambda "x" $ primitive _math_add @@ var "x" @@ int32 1))+      (Types.function (Types.list Types.int32) (Types.list Types.int32))+    expectTypeOf "lists filter"+      (primitive _lists_filter)+      (Types.forAll "t0" $ Types.function (Types.function (Types.var "t0") Types.boolean) (Types.function (Types.list $ Types.var "t0") (Types.list $ Types.var "t0")))+    expectTypeOf "optionals maybe"+      (primitive _optionals_maybe)+      (Types.forAlls ["t0", "t1"] $+        Types.function (Types.var "t0") (Types.function (Types.function (Types.var "t1") (Types.var "t0")) (Types.function (Types.optional $ Types.var "t1") (Types.var "t0"))))++  H.describe "Primitives in complex contexts" $ do+    expectTypeOf "primitive composition"+      (lets ["double">: lambda "x" $ primitive _math_mul @@ var "x" @@ int32 2,+             "increment">: lambda "x" $ primitive _math_add @@ var "x" @@ int32 1] $+            primitive _lists_map @@ var "double" @@ (primitive _lists_map @@ var "increment" @@ list [int32 1, int32 2, int32 3]))+      (Types.list Types.int32)+    expectTypeOf "nested higher-order"+      (primitive _lists_map @@ (primitive _lists_map @@ (primitive _math_add @@ int32 1)) @@+       list [list [int32 1, int32 2], list [int32 3, int32 4]])+      (Types.list $ Types.list Types.int32)++checkTypeOfProducts :: H.SpecWith ()+checkTypeOfProducts = H.describe "Products" $ do+  H.describe "Monomorphic products" $ do+    expectTypeOf "empty tuple"+      (tuple [])+      (Types.product [])+    expectTypeOf "singleton tuple"+      (tuple [int32 42])+      (Types.product [Types.int32])+    expectTypeOf "pair tuple"+      (tuple [int32 42, string "foo"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "triple tuple"+      (tuple [int32 1, int32 2, int32 3])+      (Types.product [Types.int32, Types.int32, Types.int32])+    expectTypeOf "mixed types"+      (tuple [unit, string "test", bigint 100])+      (Types.product [Types.unit, Types.string, Types.bigint])+  H.describe "Polymorphic products" $ do+    expectTypeOf "lambda with var"+      (lambda "x" $ tuple [var "x", string "foo"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.product [Types.var "t0", Types.string]))+    expectTypeOf "two variables"+      (lambda "x" $ lambda "y" $ tuple [var "x", var "y"])+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.product [Types.var "t0", Types.var "t1"])))+    expectTypeOf "repeated variable"+      (lambda "x" $ tuple [var "x", var "x"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.product [Types.var "t0", Types.var "t0"]))+  H.describe "Nested products" $ do+    expectTypeOf "tuple in tuple"+      (tuple [tuple [int32 1], string "foo"])+      (Types.product [Types.product [Types.int32], Types.string])+    expectTypeOf "nested polymorphic"+      (lambda "x" $ tuple [tuple [var "x"], tuple [string "test"]])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.product [Types.product [Types.var "t0"], Types.product [Types.string]]))++checkTypeOfProductEliminations :: H.SpecWith ()+checkTypeOfProductEliminations = H.describe "Product eliminations" $ do++  H.describe "Simple tuple projections" $ do+    expectTypeOf "projection from pair"+      (untuple 2 0 @@ pair (int32 42) (string "hello"))+      Types.int32+    expectTypeOf "second projection from pair"+      (untuple 2 1 @@ pair (int32 42) (string "hello"))+      Types.string+    expectTypeOf "projection from triple"+      (untuple 3 1 @@ triple (int32 1) (string "middle") (boolean True))+      Types.string+    expectTypeOf "first element of triple"+      (untuple 3 0 @@ triple (boolean False) (int32 100) (string "last"))+      Types.boolean+    expectTypeOf "last element of triple"+      (untuple 3 2 @@ triple (boolean False) (int32 100) (string "last"))+      Types.string++  H.describe "Polymorphic tuple projections" $ do+    expectTypeOf "projection function"+      (untuple 2 0)+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.product [Types.var "t0", Types.var "t1"])+        (Types.var "t0"))+    expectTypeOf "second projection function"+      (untuple 2 1)+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.product [Types.var "t0", Types.var "t1"])+        (Types.var "t1"))+    expectTypeOf "triple projection function"+      (untuple 3 1)+      (Types.forAlls ["t0", "t1", "t2"] $ Types.function+        (Types.product [Types.var "t0", Types.var "t1", Types.var "t2"])+        (Types.var "t1"))+    expectTypeOf "projection from lambda"+      (lambda "pair" $ untuple 2 0 @@ var "pair")+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.product [Types.var "t0", Types.var "t1"])+        (Types.var "t0"))++  H.describe "Projections with variables" $ do+    expectTypeOf "projection with variable tuple"+      (lambda "x" $ lambda "y" $ untuple 2 0 @@ pair (var "x") (var "y"))+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0")+        (Types.function (Types.var "t1") (Types.var "t0")))+    expectTypeOf "projection preserves polymorphism"+      (lambda "pair" $ pair (untuple 2 0 @@ var "pair") (untuple 2 1 @@ var "pair"))+      (Types.forAlls ["t0", "t1"] $ Types.function+        (Types.product [Types.var "t0", Types.var "t1"])+        (Types.product [Types.var "t0", Types.var "t1"]))+    expectTypeOf "nested projection"+      (lambda "nested" $ untuple 2 0 @@ (untuple 2 1 @@ var "nested"))+      (Types.forAlls ["t0", "t1", "t2"] $ Types.function+        (Types.product [Types.var "t0", Types.product [Types.var "t1", Types.var "t2"]])+        (Types.var "t1"))++  H.describe "Projections in complex contexts" $ do+    expectTypeOf "projection in let binding"+      (lets ["pair">: pair (int32 10) (string "test")] $+            untuple 2 0 @@ var "pair")+      Types.int32+    expectTypeOf "projection in tuple"+      (pair (untuple 2 0 @@ pair (int32 1) (string "a"))+            (untuple 2 1 @@ pair (int32 2) (string "b")))+      (Types.product [Types.int32, Types.string])+    expectTypeOf "projection in list"+      (list [untuple 2 0 @@ pair (int32 1) (string "a"),+             untuple 2 0 @@ pair (int32 2) (string "b")])+      (Types.list Types.int32)++  H.describe "Projections with mixed types" $ do+    expectTypeOf "projection from mixed tuple"+      (untuple 4 2 @@ tuple4 (int32 1) (string "test") (boolean True) (float32 3.14))+      Types.boolean+    expectTypeOf "projection chain"+      (lets ["quadruple">: tuple4 (int32 1) (string "test") (boolean True) (float32 3.14)] $+            tuple4 (untuple 4 0 @@ var "quadruple")+                   (untuple 4 1 @@ var "quadruple")+                   (untuple 4 2 @@ var "quadruple")+                   (untuple 4 3 @@ var "quadruple"))+      (Types.product [Types.int32, Types.string, Types.boolean, Types.float32])+    expectTypeOf "projection with function result"+      (untuple 2 1 @@ pair (int32 42) (lambda "x" $ var "x"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))++  H.describe "Projections with primitive functions" $ do++    expectTypeOf "lists.map with untuple"+      (primitive _lists_map @@ (untuple 2 0))+      (Types.forAlls ["t0", "t1"] $+        Types.function (Types.list (Types.product [Types.var "t0", Types.var "t1"])) (Types.list (Types.var "t0")))++checkTypeOfRecords :: H.SpecWith ()+checkTypeOfRecords = H.describe "Records" $ do+  H.describe "Monomorphic records" $ do+    expectTypeOf "latlon record"+      (record testTypeLatLonName [+        field "lat" (float32 19.5429),+        field "lon" (float32 (0-155.6659))])+      (Types.var "LatLon")+    expectTypeOf "latlon with variable"+      (lambda "x" $ record testTypeLatLonName [+        field "lat" (float32 19.5429),+        field "lon" (var "x")])+      (Types.function Types.float32 (Types.var "LatLon"))+    expectTypeOf "person record"+      (record testTypePersonName [+        field "firstName" (string "Alice"),+        field "lastName" (string "Smith"),+        field "age" (int32 30)])+      (Types.var "Person")+    expectTypeOf "empty record"+      (record testTypeUnitName [])+      (Types.var "Unit")+    expectTypeOf "person with variables"+      (lambda "name" $ lambda "age" $ record testTypePersonName [+        field "firstName" (var "name"),+        field "lastName" (string "Doe"),+        field "age" (var "age")])+      (Types.function Types.string (Types.function Types.int32 (Types.var "Person")))++  H.describe "Polymorphic records" $ do+    expectTypeOf "latlon poly float"+      (record testTypeLatLonPolyName [+        field "lat" (float32 19.5429),+        field "lon" (float32 (0-155.6659))])+      (Types.apply (Types.var "LatLonPoly") Types.float32)+    expectTypeOf "latlon poly int64"+      (record testTypeLatLonPolyName [+        field "lat" (int64 195429),+        field "lon" (int64 (0-1556659))])+      (Types.apply (Types.var "LatLonPoly") Types.int64)+    expectTypeOf "latlon poly variable"+      (lambda "x" $ record testTypeLatLonPolyName [+        field "lat" (var "x"),+        field "lon" (var "x")])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.apply (Types.var "LatLonPoly") (Types.var "t0")))+    expectTypeOf "buddylist string"+      (record testTypeBuddyListAName [+        field "head" (string "first"),+        field "tail" (nothing)])+      (Types.apply (Types.var "BuddyListA") Types.string)+    expectTypeOf "buddylist variable"+      (lambda "x" $ record testTypeBuddyListAName [+        field "head" (var "x"),+        field "tail" (nothing)])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.apply (Types.var "BuddyListA") (Types.var "t0")))++  H.describe "Records in complex contexts" $ do+    expectTypeOf "records in tuple"+      (tuple [+        record testTypePersonName [+          field "firstName" (string "Bob"),+          field "lastName" (string "Jones"),+          field "age" (int32 25)],+        record testTypeLatLonName [+          field "lat" (float32 1.0),+          field "lon" (float32 2.0)]])+      (Types.product [Types.var "Person", Types.var "LatLon"])+    expectTypeOf "poly records in tuple"+      (tuple [+        record testTypeLatLonPolyName [+          field "lat" (int32 1),+          field "lon" (int32 2)],+        record testTypeBuddyListAName [+          field "head" (string "test"),+          field "tail" (nothing)]])+      (Types.product [+        Types.apply (Types.var "LatLonPoly") Types.int32,+        Types.apply (Types.var "BuddyListA") Types.string])+    expectTypeOf "recursive record"+      (record testTypeIntListName [+        field "head" (int32 42),+        field "tail" (just $+          record testTypeIntListName [+            field "head" (int32 43),+            field "tail" (nothing)])])+      (Types.var "IntList")++checkTypeOfRecordEliminations :: H.SpecWith ()+checkTypeOfRecordEliminations = H.describe "Record eliminations" $ do+  H.describe "Simple record projections" $ do+    expectTypeOf "project firstName from Person"+      (project testTypePersonName (Name "firstName"))+      (Types.function (Types.var "Person") Types.string)++    expectTypeOf "project lastName from Person"+      (project testTypePersonName (Name "lastName"))+      (Types.function (Types.var "Person") Types.string)++    expectTypeOf "project age from Person"+      (project testTypePersonName (Name "age"))+      (Types.function (Types.var "Person") Types.int32)++    expectTypeOf "project lat from LatLon"+      (project testTypeLatLonName (Name "lat"))+      (Types.function (Types.var "LatLon") Types.float32)++    expectTypeOf "project lon from LatLon"+      (project testTypeLatLonName (Name "lon"))+      (Types.function (Types.var "LatLon") Types.float32)++  H.describe "Record projections applied to records" $ do+    expectTypeOf "project firstName applied to person record"+      (project testTypePersonName (Name "firstName") @@+       record testTypePersonName [+         field "firstName" (string "Alice"),+         field "lastName" (string "Smith"),+         field "age" (int32 30)])+      Types.string++    expectTypeOf "project age applied to person record"+      (project testTypePersonName (Name "age") @@+       record testTypePersonName [+         field "firstName" (string "Bob"),+         field "lastName" (string "Jones"),+         field "age" (int32 25)])+      Types.int32++    expectTypeOf "project lat applied to LatLon record"+      (project testTypeLatLonName (Name "lat") @@+       record testTypeLatLonName [+         field "lat" (float32 40.7128),+         field "lon" (float32 (-74.0060))])+      Types.float32++  H.describe "Polymorphic record projections" $ do+    expectTypeOf "project lat from polymorphic LatLonPoly"+      (project testTypeLatLonPolyName (Name "lat"))+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "LatLonPoly") (Types.var "t0")) (Types.var "t0"))++    expectTypeOf "project lon from polymorphic LatLonPoly"+      (project testTypeLatLonPolyName (Name "lon"))+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "LatLonPoly") (Types.var "t0")) (Types.var "t0"))++    expectTypeOf "project head from BuddyListA"+      (project testTypeBuddyListAName (Name "head"))+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "BuddyListA") (Types.var "t0")) (Types.var "t0"))++    expectTypeOf "project tail from BuddyListA"+      (project testTypeBuddyListAName (Name "tail"))+      (Types.forAll "t0" $ Types.function+        (Types.apply (Types.var "BuddyListA") (Types.var "t0"))+        (Types.optional (Types.apply (Types.var "BuddyListB") (Types.var "t0"))))++  H.describe "Polymorphic record projections applied" $ do+    expectTypeOf "project lat from LatLonPoly with int32"+      (project testTypeLatLonPolyName (Name "lat") @@+       record testTypeLatLonPolyName [+         field "lat" (int32 40),+         field "lon" (int32 (-74))])+      Types.int32++    expectTypeOf "project lon from LatLonPoly with float64"+      (project testTypeLatLonPolyName (Name "lon") @@+       record testTypeLatLonPolyName [+         field "lat" (float64 40.7128),+         field "lon" (float64 (-74.0060))])+      Types.float64++    expectTypeOf "project head from BuddyListA with string"+      (project testTypeBuddyListAName (Name "head") @@+       record testTypeBuddyListAName [+         field "head" (string "Alice"),+         field "tail" (nothing)])+      Types.string++  H.describe "Record projections with variables" $ do+    expectTypeOf "project from lambda parameter"+      (lambda "person" $ project testTypePersonName (Name "firstName") @@ var "person")+      (Types.function (Types.var "Person") Types.string)++    expectTypeOf "project from polymorphic lambda parameter"+      (lambda "coords" $ project testTypeLatLonPolyName (Name "lat") @@ var "coords")+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "LatLonPoly") (Types.var "t0")) (Types.var "t0"))++    expectTypeOf "multiple projections from same record"+      (lambda "person" $+       tuple [project testTypePersonName (Name "firstName") @@ var "person",+              project testTypePersonName (Name "lastName") @@ var "person"])+      (Types.function (Types.var "Person") (Types.product [Types.string, Types.string]))++  H.describe "Record projections in complex contexts" $ do+    expectTypeOf "projection in let binding"+      (lets ["person">: record testTypePersonName [+               field "firstName" (string "Charlie"),+               field "lastName" (string "Brown"),+               field "age" (int32 35)],+             "getName">: project testTypePersonName (Name "firstName")] $+            var "getName" @@ var "person")+      Types.string++    expectTypeOf "projection in tuple"+      (tuple [project testTypePersonName (Name "firstName"),+              project testTypePersonName (Name "age")])+      (Types.product [Types.function (Types.var "Person") Types.string,+                      Types.function (Types.var "Person") Types.int32])++    expectTypeOf "projection in list"+      (list [project testTypePersonName (Name "firstName"),+             project testTypePersonName (Name "lastName")])+      (Types.list (Types.function (Types.var "Person") Types.string))++  H.describe "Higher-order record projections" $ do+    expectTypeOf "map projection over list of records"+      (primitive _lists_map @@ (project testTypePersonName (Name "firstName")) @@+       list [record testTypePersonName [+               field "firstName" (string "Alice"),+               field "lastName" (string "Smith"),+               field "age" (int32 30)],+             record testTypePersonName [+               field "firstName" (string "Bob"),+               field "lastName" (string "Jones"),+               field "age" (int32 25)]])+      (Types.list Types.string)++    expectTypeOf "map polymorphic projection"+      (primitive _lists_map @@ (project testTypeLatLonPolyName (Name "lat")) @@+       list [record testTypeLatLonPolyName [+               field "lat" (int32 40),+               field "lon" (int32 (-74))],+             record testTypeLatLonPolyName [+               field "lat" (int32 34),+               field "lon" (int32 (-118))]])+      (Types.list Types.int32)++    expectTypeOf "filter using projection"+      (primitive _lists_filter @@+       (lambda "person" $+        primitive _equality_gt @@+        (project testTypePersonName (Name "age") @@ var "person") @@+        int32 30) @@+       list [record testTypePersonName [+               field "firstName" (string "Alice"),+               field "lastName" (string "Smith"),+               field "age" (int32 35)],+             record testTypePersonName [+               field "firstName" (string "Bob"),+               field "lastName" (string "Jones"),+               field "age" (int32 25)]])+      (Types.list (Types.var "Person"))++  H.describe "Recursive record projections" $ do+    expectTypeOf "project head from IntList"+      (project testTypeIntListName (Name "head"))+      (Types.function (Types.var "IntList") Types.int32)++    expectTypeOf "project tail from IntList"+      (project testTypeIntListName (Name "tail"))+      (Types.function (Types.var "IntList") (Types.optional (Types.var "IntList")))++    expectTypeOf "project head applied to IntList"+      (project testTypeIntListName (Name "head") @@+       record testTypeIntListName [+         field "head" (int32 42),+         field "tail" (nothing)])+      Types.int32++    expectTypeOf "nested projection from recursive record"+      (lambda "intList" $+       primitive _optionals_maybe @@+       int32 0 @@+       (project testTypeIntListName (Name "head")) @@+       (project testTypeIntListName (Name "tail") @@ var "intList"))+      (Types.function (Types.var "IntList") Types.int32)++  H.describe "Record projections with mutual recursion" $ do+    expectTypeOf "project head from BuddyListA"+      (project testTypeBuddyListAName (Name "head"))+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "BuddyListA") (Types.var "t0")) (Types.var "t0"))++    expectTypeOf "project tail from BuddyListB"+      (project testTypeBuddyListBName (Name "tail"))+      (Types.forAll "t0" $ Types.function+        (Types.apply (Types.var "BuddyListB") (Types.var "t0"))+        (Types.optional (Types.apply (Types.var "BuddyListA") (Types.var "t0"))))++    expectTypeOf "chained projections across mutual recursion"+      (lambda "listA" $+        primitive _optionals_maybe+          @@ nothing+          @@ (lambda "listB" $+            primitive _optionals_maybe+              @@ nothing+              @@ (project testTypeBuddyListAName (Name "tail"))+              @@ (project testTypeBuddyListBName (Name "tail") @@ var "listB"))+          @@ (project testTypeBuddyListAName (Name "tail") @@ var "listA"))+      (Types.forAll "t0" $ Types.function+        (Types.apply (Types.var "BuddyListA") (Types.var "t0"))+        (Types.optional (Types.apply (Types.var "BuddyListB") (Types.var "t0"))))++  H.describe "Record projection composition" $ do+    expectTypeOf "compose projections"+      (lambda "person" $+       primitive _strings_cat2 @@+       (project testTypePersonName (Name "firstName") @@ var "person") @@+       (project testTypePersonName (Name "lastName") @@ var "person"))+      (Types.function (Types.var "Person") Types.string)++    expectTypeOf "projection with arithmetic"+      (lambda "person" $+       primitive _math_add @@+       (project testTypePersonName (Name "age") @@ var "person") @@+       int32 1)+      (Types.function (Types.var "Person") Types.int32)++    expectTypeOf "record construction using string projection"+     (lambda "person" $+      record testTypePersonName [+        field "firstName" (project testTypePersonName (Name "firstName") @@ var "person"),+        field "lastName" (project testTypePersonName (Name "lastName") @@ var "person"),+        field "age" (int32 0)])+     (Types.function (Types.var "Person") (Types.var "Person"))++checkTypeOfSets :: H.SpecWith ()+checkTypeOfSets = H.describe "Sets" $ do+  H.describe "Monomorphic sets" $ do+    expectTypeOf "empty set"+      (Terms.set S.empty)+      (Types.forAll "t0" $ Types.set $ Types.var "t0")+    expectTypeOf "int set"+      (Terms.set $ S.fromList [int32 1, int32 2, int32 3])+      (Types.set Types.int32)+    expectTypeOf "string set"+      (Terms.set $ S.fromList [string "apple", string "banana", string "cherry"])+      (Types.set Types.string)+    expectTypeOf "single element set"+      (Terms.set $ S.singleton $ boolean True)+      (Types.set Types.boolean)++  H.describe "Polymorphic sets" $ do+    expectTypeOf "set from lambda"+      (lambda "x" $ Terms.set $ S.singleton $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.set $ Types.var "t0"))+    expectTypeOf "set with repeated variable"+      (lambda "x" $ Terms.set $ S.fromList [var "x", var "x"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.set $ Types.var "t0"))+    expectTypeOf "set from two variables"+      (lambda "x" $ lambda "y" $ Terms.set $ S.fromList [var "x", var "y"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.function (Types.var "t0") (Types.set $ Types.var "t0")))++  H.describe "Sets in complex contexts" $ do+    expectTypeOf "set in tuple"+      (tuple [Terms.set $ S.fromList [int32 1, int32 2], string "context"])+      (Types.product [Types.set Types.int32, Types.string])+    expectTypeOf "set in let binding"+      (lets ["numbers">: Terms.set $ S.fromList [int32 10, int32 20, int32 30]] $+            var "numbers")+      (Types.set Types.int32)++  H.describe "Nested sets" $ do+    expectTypeOf "set of lists"+      (Terms.set $ S.fromList [+        list [string "a", string "b"],+        list [string "c", string "d"]])+      (Types.set $ Types.list Types.string)+    expectTypeOf "set of tuples"+      (Terms.set $ S.fromList [+        tuple [int32 1, int32 2],+        tuple [int32 3, int32 4]])+      (Types.set $ Types.product [Types.int32, Types.int32])+    expectTypeOf "set of sets"+      (Terms.set $ S.singleton $ Terms.set $ S.fromList [string "nested"])+      (Types.set $ Types.set Types.string)++  H.describe "Sets with complex types" $ do+    expectTypeOf "set of records"+      (Terms.set $ S.singleton $ record testTypePersonName [+        field "firstName" (string "Alice"),+        field "lastName" (string "Smith"),+        field "age" (int32 30)])+      (Types.set $ Types.var "Person")+    expectTypeOf "set of optionals"+      (Terms.set $ S.fromList [+        just $ int32 42,+        nothing])+      (Types.set $ Types.optional Types.int32)+    expectTypeOf "set of maps"+      (Terms.set $ S.singleton $ Terms.map $ M.singleton (string "key") (int32 42))+      (Types.set $ Types.map Types.string Types.int32)++checkTypeOfSums :: H.SpecWith ()+checkTypeOfSums = H.describe "Sums" $ do+  -- TODO: we probably will not bother to test sum terms; see https://github.com/CategoricalData/hydra/issues/134+  return ()++checkTypeOfUnions :: H.SpecWith ()+checkTypeOfUnions = H.describe "Unions" $ do+  H.describe "Simple union injections" $ do+    expectTypeOf "inject into Comparison lessThan variant"+      (unitVariant testTypeComparisonName (Name "lessThan"))+      (Types.var "Comparison")+    expectTypeOf "inject into Comparison equalTo variant"+      (unitVariant testTypeComparisonName (Name "equalTo"))+      (Types.var "Comparison")+    expectTypeOf "inject into Comparison greaterThan variant"+      (unitVariant testTypeComparisonName (Name "greaterThan"))+      (Types.var "Comparison")++  H.describe "Union injections with data" $ do+    expectTypeOf "inject into Number int variant"+      (variant testTypeNumberName (Name "int") (int32 42))+      (Types.var "Number")+    expectTypeOf "inject into Number float variant"+      (variant testTypeNumberName (Name "float") (float32 3.14))+      (Types.var "Number")+    expectTypeOf "inject into Timestamp unixTimeMillis variant"+      (variant testTypeTimestampName (Name "unixTimeMillis") (uint64 1609459200000))+      (Types.var "Timestamp")+    expectTypeOf "inject into Timestamp date variant"+      (variant testTypeTimestampName (Name "date") (string "2021-01-01"))+      (Types.var "Timestamp")++  H.describe "Polymorphic union injections" $ do+    expectTypeOf "inject person into PersonOrSomething"+      (variant testTypePersonOrSomethingName (Name "person")+        (record testTypePersonName [+          field "firstName" (string "Alice"),+          field "lastName" (string "Smith"),+          field "age" (int32 30)]))+      (Types.forAll "t0" $ Types.apply (Types.var "PersonOrSomething") (Types.var "t0"))+    expectTypeOf "inject string into PersonOrSomething other variant"+      (variant testTypePersonOrSomethingName (Name "other") (string "something else"))+      (Types.apply (Types.var "PersonOrSomething") Types.string)+    expectTypeOf "inject int into PersonOrSomething other variant"+      (variant testTypePersonOrSomethingName (Name "other") (int32 42))+      (Types.apply (Types.var "PersonOrSomething") Types.int32)++  H.describe "Polymorphic recursive union injections" $ do+    expectTypeOf "inject boolean into UnionPolymorphicRecursive"+      (variant testTypeUnionPolymorphicRecursiveName (Name "bool") (boolean True))+      (Types.forAll "t0" $ Types.apply (Types.var "UnionPolymorphicRecursive") (Types.var "t0"))+    expectTypeOf "inject string value into UnionPolymorphicRecursive"+      (variant testTypeUnionPolymorphicRecursiveName (Name "value") (string "test"))+      (Types.apply (Types.var "UnionPolymorphicRecursive") Types.string)+    expectTypeOf "inject int value into UnionPolymorphicRecursive"+      (variant testTypeUnionPolymorphicRecursiveName (Name "value") (int32 123))+      (Types.apply (Types.var "UnionPolymorphicRecursive") Types.int32)++  H.describe "Polymorphic unions from lambda" $ do+    expectTypeOf "lambda creating PersonOrSomething other variant"+      (lambda "x" $ variant testTypePersonOrSomethingName (Name "other") (var "x"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.apply (Types.var "PersonOrSomething") (Types.var "t0")))+    expectTypeOf "lambda creating UnionPolymorphicRecursive value variant"+      (lambda "x" $ variant testTypeUnionPolymorphicRecursiveName (Name "value") (var "x"))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.apply (Types.var "UnionPolymorphicRecursive") (Types.var "t0")))++  H.describe "Unions in complex contexts" $ do+    expectTypeOf "union in tuple"+      (tuple [variant testTypeNumberName (Name "int") (int32 42),+              string "context"])+      (Types.product [Types.var "Number", Types.string])+    expectTypeOf "union in list"+      (list [variant testTypeNumberName (Name "int") (int32 1),+             variant testTypeNumberName (Name "float") (float32 2.5)])+      (Types.list $ Types.var "Number")+    expectTypeOf "polymorphic union in let binding"+      (lets ["value">: variant testTypePersonOrSomethingName (Name "other") (string "test")] $+            var "value")+      (Types.apply (Types.var "PersonOrSomething") Types.string)++checkTypeOfUnionEliminations :: H.SpecWith ()+checkTypeOfUnionEliminations = H.describe "Union eliminations" $ do+  H.describe "Simple unit variant eliminations" $ do+    expectTypeOf "match Comparison with all cases"+      (match testTypeComparisonName Nothing [+        "lessThan">: lambda "x" (string "less"),+        "equalTo">: lambda "x" (string "equal"),+        "greaterThan">: lambda "x" (string "greater")])+      (Types.function (Types.var "Comparison") Types.string)++    expectTypeOf "match Comparison returning int32"+      (match testTypeComparisonName Nothing [+        "lessThan">: lambda "x" (int32 (-1)),+        "equalTo">: lambda "x" (int32 0),+        "greaterThan">: lambda "x" (int32 1)])+      (Types.function (Types.var "Comparison") Types.int32)++    expectTypeOf "match applied to Comparison variant"+      (match testTypeComparisonName Nothing [+        "lessThan">: lambda "x" (string "less"),+        "equalTo">: lambda "x" (string "equal"),+        "greaterThan">: lambda "x" (string "greater")] @@+       unitVariant testTypeComparisonName (Name "equalTo"))+      Types.string++  H.describe "Union eliminations with data" $ do+    expectTypeOf "match Number extracting int values"+      (match testTypeNumberName Nothing [+        "int">: lambda "i" (var "i"),+        "float">: lambda "f" (int32 0)])+      (Types.function (Types.var "Number") Types.int32)++    expectTypeOf "match Number converting to string"+      (match testTypeNumberName Nothing [+        "int">: lambda "i" (primitive _literals_showInt32 @@ var "i"),+        "float">: lambda "f" (primitive _literals_showFloat32 @@ var "f")])+      (Types.function (Types.var "Number") Types.string)++    expectTypeOf "match Number applied to int variant"+      (match testTypeNumberName Nothing [+        "int">: lambda "i" (primitive _math_add @@ var "i" @@ int32 10),+        "float">: lambda "f" (int32 0)] @@+       variant testTypeNumberName (Name "int") (int32 42))+      Types.int32++    expectTypeOf "match Timestamp with mixed data types"+      (match testTypeTimestampName Nothing [+        "unixTimeMillis">: lambda "millis" (primitive _literals_showUint64 @@ var "millis"),+        "date">: lambda "dateStr" (var "dateStr")])+      (Types.function (Types.var "Timestamp") Types.string)++  H.describe "Polymorphic union eliminations" $ do+    expectTypeOf "match PersonOrSomething with string"+      (match testTypePersonOrSomethingName Nothing [+        "person">: lambda "p" (project testTypePersonName (Name "firstName") @@ var "p"),+        "other">: lambda "x" (var "x")])+      (Types.function (Types.apply (Types.var "PersonOrSomething") (Types.string)) (Types.string))++    expectTypeOf "match PersonOrSomething instantiated with string"+      (match testTypePersonOrSomethingName Nothing [+        "person">: lambda "p" (project testTypePersonName (Name "firstName") @@ var "p"),+        "other">: lambda "x" (var "x")] @@+       variant testTypePersonOrSomethingName (Name "other") (string "test"))+      Types.string++  H.describe "Union eliminations with defaults" $ do+    expectTypeOf "match Comparison with default case"+      (match testTypeComparisonName (Just (string "unknown")) [+        "lessThan">: lambda "x" (string "less"),+        "equalTo">: lambda "x" (string "equal")])+      (Types.function (Types.var "Comparison") Types.string)++    expectTypeOf "match Number with default case"+      (match testTypeNumberName (Just (int32 (-1))) [+        "int">: lambda "i" (var "i")])+      (Types.function (Types.var "Number") Types.int32)++    expectTypeOf "match UnionMonomorphic with default"+      (match testTypeUnionMonomorphicName (Just (string "fallback")) [+        "bool">: lambda "b" (primitive _literals_showBoolean @@ var "b"),+        "string">: lambda "s" (var "s")])+      (Types.function (Types.var "UnionMonomorphic") Types.string)++  H.describe "Nested union eliminations" $ do+    expectTypeOf "nested match statements"+      (match testTypePersonOrSomethingName Nothing [+        "person">: lambda "p" (project testTypePersonName (Name "firstName") @@ var "p"),+        "other">: lambda "x" (+          match testTypeNumberName Nothing [+            "int">: lambda "i" (primitive _literals_showInt32 @@ var "i"),+            "float">: lambda "f" (primitive _literals_showFloat32 @@ var "f")] @@+          var "x")])+      (Types.function (Types.apply (Types.var "PersonOrSomething") (Types.var "Number")) Types.string)++    expectTypeOf "match in tuple"+      (tuple [+        match testTypeComparisonName Nothing [+          "lessThan">: lambda "x" (int32 1),+          "equalTo">: lambda "x" (int32 0),+          "greaterThan">: lambda "x" (int32 (-1))],+        string "context"])+      (Types.product [Types.function (Types.var "Comparison") Types.int32, Types.string])++  H.describe "Union eliminations in complex contexts" $ do+    expectTypeOf "match in let binding"+      (lets ["matcher">: match testTypeComparisonName Nothing [+               "lessThan">: lambda "x" (string "less"),+               "equalTo">: lambda "x" (string "equal"),+               "greaterThan">: lambda "x" (string "greater")]] $+            var "matcher")+      (Types.function (Types.var "Comparison") Types.string)++    expectTypeOf "match in record"+      (record testTypePersonName [+        field "firstName" (match testTypePersonOrSomethingName Nothing [+          "person">: lambda "p" (project testTypePersonName (Name "firstName") @@ var "p"),+          "other">: lambda "x" (var "x")] @@+         variant testTypePersonOrSomethingName (Name "other") (string "John")),+        field "lastName" (string "Doe"),+        field "age" (int32 30)])+      (Types.var "Person")++    expectTypeOf "match with polymorphic result in list"+      (list [+        match testTypePersonOrSomethingName Nothing [+          "person">: lambda "p" (project testTypePersonName (Name "age") @@ var "p"),+          "other">: lambda "x" (var "x")] @@+        variant testTypePersonOrSomethingName (Name "other") (int32 25),+        int32 30])+      (Types.list Types.int32)++  H.describe "Higher-order union eliminations" $ do+    expectTypeOf "map match over list"+      (primitive _lists_map @@+       (match testTypeComparisonName Nothing [+         "lessThan">: lambda "x" (string "less"),+         "equalTo">: lambda "x" (string "equal"),+         "greaterThan">: lambda "x" (string "greater")]) @@+       list [unitVariant testTypeComparisonName (Name "lessThan"),+             unitVariant testTypeComparisonName (Name "equalTo")])+      (Types.list Types.string)++    expectTypeOf "compose match with other functions"+      (lambda "comp" $+       primitive _strings_length @@+       (match testTypeComparisonName Nothing [+         "lessThan">: lambda "x" (string "less"),+         "equalTo">: lambda "x" (string "equal"),+         "greaterThan">: lambda "x" (string "greater")] @@+        var "comp"))+      (Types.function (Types.var "Comparison") Types.int32)++    expectTypeOf "match in lambda body"+      (lambda "unionValue" $+       match testTypeNumberName Nothing [+         "int">: lambda "i" (primitive _math_add @@ var "i" @@ int32 1),+         "float">: lambda "f" (int32 0)] @@+       var "unionValue")+      (Types.function (Types.var "Number") Types.int32)++  H.describe "Recursive union eliminations" $ do+    expectTypeOf "match HydraType recursively"+      (match testTypeHydraTypeName Nothing [+        "literal">: lambda "lit" (+          match testTypeHydraLiteralTypeName Nothing [+            "boolean">: lambda "b" (primitive _literals_showBoolean @@ var "b"),+            "string">: lambda "s" (var "s")] @@+          var "lit"),+        "list">: lambda "nested" (string "list")])+      (Types.function (Types.var "HydraType") Types.string)++checkTypeOfUnit :: H.SpecWith ()+checkTypeOfUnit = H.describe "Unit" $ do+  H.describe "Unit term" $ do+    expectTypeOf "unit literal"+      unit+      Types.unit+  H.describe "Unit term in polymorphic context" $ do+    expectTypeOf "unit from lambda"+      (lambda "x" unit)+      (Types.forAll "t0" $ Types.function (Types.var "t0") Types.unit)+    expectTypeOf "unit in tuple"+      (tuple [unit, string "foo"])+      (Types.product [Types.unit, Types.string])++checkTypeOfVariables :: H.SpecWith ()+checkTypeOfVariables = H.describe "Variables" $ do+  H.describe "Simple variable lookup" $ do+    expectTypeOf "int variable"+      (lambda "x" $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "variable in let binding"+      (lets ["x">: int32 42] $ var "x")+      Types.int32+    expectTypeOf "multiple variables"+      (lets ["x">: string "hello",+             "y">: int32 42] $+            tuple [var "x", var "y"])+      (Types.product [Types.string, Types.int32])++  H.describe "Variable scoping" $ do+    expectTypeOf "lambda parameter"+      (lambda "x" $ lambda "y" $ var "x")+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.var "t0")))+    expectTypeOf "let binding scope"+      (lets ["x">: int32 1] $+       lets ["y">: string "hello"] $+            var "x")+      Types.int32+    expectTypeOf "variable shadowing"+      (lets ["x">: int32 1] $+       lambda "x" $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "nested scoping"+      (lambda "x" $+       lets ["y">: var "x"] $+            lambda "z" $+            tuple [var "x", var "y", var "z"])+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.product [Types.var "t0", Types.var "t0", Types.var "t1"])))++  H.describe "Polymorphic variables" $ do+    expectTypeOf "polymorphic function"+      (lets ["id">: lambda "x" $ var "x"] $+            var "id")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.var "t0"))+    expectTypeOf "polymorphic application"+      (lets ["id">: lambda "x" $ var "x"] $+            tuple [var "id" @@ int32 42, var "id" @@ string "test"])+      (Types.product [Types.int32, Types.string])+    expectTypeOf "higher order polymorphic"+      (lets ["apply">: lambda "f" $ lambda "x" $ var "f" @@ var "x"] $+            var "apply")+      (Types.forAlls ["t0", "t1"] $+        Types.function (Types.function (Types.var "t0") (Types.var "t1")) (Types.function (Types.var "t0") (Types.var "t1")))++  H.describe "Variables in complex contexts" $ do+    expectTypeOf "variable in record"+      (lambda "name" $+       record testTypePersonName [+         field "firstName" (var "name"),+         field "lastName" (string "Doe"),+         field "age" (int32 25)])+      (Types.function Types.string (Types.var "Person"))+    expectTypeOf "variable in list"+      (lambda "x" $ list [var "x", var "x"])+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.list $ Types.var "t0"))+    expectTypeOf "variable in map"+      (lambda "key" $ lambda "value" $+       Terms.map $ M.singleton (var "key") (var "value"))+      (Types.forAlls ["t0", "t1"] $ Types.function (Types.var "t0") (Types.function (Types.var "t1") (Types.map (Types.var "t0") (Types.var "t1"))))+    expectTypeOf "variable in optional"+      (lambda "x" $ just $ var "x")+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.optional $ Types.var "t0"))++  H.describe "Recursive variables" $ do+    expectTypeOf "simple recursion"+      (lets ["f">: lambda "x" $ primitive _math_add @@ var "x" @@ int32 1] $+            var "f")+      (Types.function Types.int32 Types.int32)+    expectTypeOf "mutual recursion"+      (lets ["f">: lambda "x" $ var "g" @@ var "x",+             "g">: lambda "y" $ primitive _math_add @@ var "y" @@ int32 1] $+            var "f")+      (Types.function Types.int32 Types.int32)++checkTypeOfWrappedTerms :: H.SpecWith ()+checkTypeOfWrappedTerms = H.describe "Wrapped terms" $ do+  H.describe "Monomorphic wrapped terms" $ do+    expectTypeOf "string alias"+      (wrap testTypeStringAliasName (string "hello"))+      (Types.var "StringTypeAlias")+    expectTypeOf "wrapped integer"+      (wrap testTypeStringAliasName (string "wrapped"))+      (Types.var "StringTypeAlias")+    expectTypeOf "wrapped in tuple"+      (tuple [wrap testTypeStringAliasName (string "first"),+              string "second"])+      (Types.product [Types.var "StringTypeAlias", Types.string])++  H.describe "Polymorphic wrapped terms" $ do+    expectTypeOf "polymorphic wrapper with int"+      (wrap testTypePolymorphicWrapperName (list [int32 1, int32 2]))+      (Types.apply (Types.var "PolymorphicWrapper") Types.int32)+    expectTypeOf "polymorphic wrapper with string"+      (wrap testTypePolymorphicWrapperName (list [string "a", string "b"]))+      (Types.apply (Types.var "PolymorphicWrapper") Types.string)+    expectTypeOf "polymorphic wrapper from lambda"+      (lambda "x" $ wrap testTypePolymorphicWrapperName (list [var "x"]))+      (Types.forAll "t0" $ Types.function (Types.var "t0") (Types.apply (Types.var "PolymorphicWrapper") (Types.var "t0")))++  H.describe "Wrapped terms in complex contexts" $ do+    expectTypeOf "wrapped in record"+      (record testTypePersonName [+        field "firstName" (string "John"),+        field "lastName" (string "Doe"),+        field "age" (int32 30)])+      (Types.var "Person")+    expectTypeOf "wrapped in let binding"+      (lets ["alias">: wrap testTypeStringAliasName (string "test")] $+            var "alias")+      (Types.var "StringTypeAlias")+    expectTypeOf "wrapped in list"+      (list [wrap testTypeStringAliasName (string "first"),+             wrap testTypeStringAliasName (string "second")])+      (Types.list $ Types.var "StringTypeAlias")++  H.describe "Nested wrapped terms" $ do+    expectTypeOf "wrapped tuple"+      (wrap testTypePolymorphicWrapperName (list [tuple [int32 1, string "a"]]))+      (Types.apply (Types.var "PolymorphicWrapper") (Types.product [Types.int32, Types.string]))+    expectTypeOf "wrapped optional"+      (wrap testTypePolymorphicWrapperName (list [just $ int32 42]))+      (Types.apply (Types.var "PolymorphicWrapper") (Types.optional Types.int32))+    expectTypeOf "wrapped map"+      (wrap testTypePolymorphicWrapperName (list [Terms.map $ M.singleton (string "key") (int32 42)]))+      (Types.apply (Types.var "PolymorphicWrapper") (Types.map Types.string Types.int32))++  H.describe "Multiple wrapping levels" $ do+    expectTypeOf "wrapped in optional"+      (just $ wrap testTypeStringAliasName (string "wrapped"))+      (Types.optional $ Types.var "StringTypeAlias")+    expectTypeOf "list of wrapped polymorphic"+      (list [wrap testTypePolymorphicWrapperName (list [int32 1]),+             wrap testTypePolymorphicWrapperName (list [int32 2])])+      (Types.list $ Types.apply (Types.var "PolymorphicWrapper") Types.int32)++checkTypeOfWrapEliminations :: H.SpecWith ()+checkTypeOfWrapEliminations = H.describe "Wrap eliminations" $ do+  H.describe "Monomorphic unwrapping" $ do+    expectTypeOf "unwrap string alias"+      (unwrap testTypeStringAliasName)+      (Types.function (Types.var "StringTypeAlias") Types.string)++  H.describe "Polymorphic unwrapping" $ do+    expectTypeOf "unwrap polymorphic wrapper"+      (unwrap testTypePolymorphicWrapperName)+      (Types.forAll "t0" $ Types.function (Types.apply (Types.var "PolymorphicWrapper") (Types.var "t0")) (Types.list $ Types.var "t0"))++  H.describe "Unwrap eliminations in applications" $ do+    expectTypeOf "unwrap applied to wrapped term"+      (unwrap testTypeStringAliasName @@ wrap testTypeStringAliasName (string "hello"))+      Types.string+    expectTypeOf "unwrap polymorphic applied"+      (unwrap testTypePolymorphicWrapperName @@ wrap testTypePolymorphicWrapperName (list [int32 1, int32 2]))+      (Types.list Types.int32)++  H.describe "Unwrap in complex contexts" $ do+    expectTypeOf "unwrap in let binding"+      (lets ["unwrapper">: unwrap testTypeStringAliasName,+             "wrapped">: wrap testTypeStringAliasName (string "test")] $+            var "unwrapper" @@ var "wrapped")+      Types.string+    expectTypeOf "unwrap in tuple"+      (tuple [unwrap testTypeStringAliasName, string "context"])+      (Types.product [Types.function (Types.var "StringTypeAlias") Types.string, Types.string])+    expectTypeOf "unwrap in lambda"+      (lambda "wrapped" $ unwrap testTypeStringAliasName @@ var "wrapped")+      (Types.function (Types.var "StringTypeAlias") Types.string)++  H.describe "Chained unwrapping" $ do+    expectTypeOf "unwrap then process"+      (lambda "wrapped" $+       primitive _strings_cat2 @@ (unwrap testTypeStringAliasName @@ var "wrapped") @@ string " suffix")+      (Types.function (Types.var "StringTypeAlias") Types.string)+    expectTypeOf "unwrap polymorphic then map"+      (lambda "wrappedList" $+       primitive _lists_map @@ (primitive _math_add @@ int32 1) @@ (unwrap testTypePolymorphicWrapperName @@ var "wrappedList"))+      (Types.function (Types.apply (Types.var "PolymorphicWrapper") Types.int32) (Types.list Types.int32))++  H.describe "Multiple unwrap operations" $ do+    expectTypeOf "unwrap different types"+      (lambda "stringWrapped" $ lambda "listWrapped" $+       tuple [unwrap testTypeStringAliasName @@ var "stringWrapped",+              unwrap testTypePolymorphicWrapperName @@ var "listWrapped"])+      (Types.forAll "t0" $ Types.function (Types.var "StringTypeAlias")+        (Types.function (Types.apply (Types.var "PolymorphicWrapper") (Types.var "t0"))+          (Types.product [Types.string, Types.list $ Types.var "t0"])))++----------------------------------------++expectTypeOf :: String -> Term -> Type -> H.SpecWith ()+expectTypeOf desc term typ = H.it desc $ withDefaults expectTypeOfResult desc term typ++typeOfShouldFail :: String -> M.Map Name Type -> Term -> H.SpecWith ()+typeOfShouldFail desc types term = H.it desc $ shouldFail $ do+  cx <- graphToInferenceContext testGraph+  typeOfInternal cx S.empty types [] term++withDefaults :: (String -> M.Map Name Type -> Term -> x) -> String -> Term -> x+withDefaults f desc = f desc M.empty
− src/test/haskell/Hydra/LiteralAdaptersSpec.hs 
@@ -1,126 +0,0 @@-module Hydra.LiteralAdaptersSpec where--import Hydra.Kernel--import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC---testFloatAdapter :: H.SpecWith ()-testFloatAdapter = H.describe "Test floating-point adapter" $ do--  H.it "upgrade float32 to bigfloat, since float32 and float64 are unsupported" $-    QC.property $ \f -> checkFloatAdapter-      [FloatTypeBigfloat]-      FloatTypeFloat32 FloatTypeBigfloat False-      (FloatValueFloat32 f) (FloatValueBigfloat $ realToFrac f)--  H.it "downgrade bigfloat to float64" $-    QC.property $ \d -> checkFloatAdapter-      [FloatTypeFloat32, FloatTypeFloat64]-      FloatTypeBigfloat FloatTypeFloat64 True-      (FloatValueBigfloat d) (FloatValueFloat64 $ realToFrac d)--  H.it "downgrade bigfloat to float32, since float64 is unsupported" $-    QC.property $ \d -> checkFloatAdapter-      [FloatTypeFloat32]-      FloatTypeBigfloat FloatTypeFloat32 True-      (FloatValueBigfloat d) (FloatValueFloat32 $ realToFrac d)--  H.it "bigfloat is supported and remains unchanged" $-    QC.property $ \d -> checkFloatAdapter-      [FloatTypeFloat32, FloatTypeBigfloat]-      FloatTypeBigfloat FloatTypeBigfloat False-      (FloatValueBigfloat d) (FloatValueBigfloat d)--testIntegerAdapter :: H.SpecWith ()-testIntegerAdapter = H.describe "Test integer adapter" $ do--  H.it "upgrade uint8 to uint16, not int16" $-    QC.property $ \b -> checkIntegerAdapter-      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]-      IntegerTypeUint8 IntegerTypeUint16 False-      (IntegerValueUint8 b) (IntegerValueUint16 $ fromIntegral b)--  H.it "upgrade int8 to int16, not uint16" $-    QC.property $ \b -> checkIntegerAdapter-      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeBigint]-      IntegerTypeInt8 IntegerTypeInt16 False-      (IntegerValueInt8 b) (IntegerValueInt16 $ fromIntegral b)--  H.it "upgrade uint8 to int16 when uint16 is not supported" $-    QC.property $ \b -> checkIntegerAdapter-      [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]-      IntegerTypeUint8 IntegerTypeInt16 False-      (IntegerValueUint8 b) (IntegerValueInt16 $ fromIntegral b)--  H.it "cross-convert uint32 to int32, even when uint16 is supported" $-    QC.property $ \b -> checkIntegerAdapter-      [IntegerTypeUint16, IntegerTypeInt32]-      IntegerTypeUint32 IntegerTypeInt32 True-      (IntegerValueUint32 b) (IntegerValueInt32 $ fromIntegral b)--  H.it "downgrade bigint to int32, not uint32" $-    QC.property $ \b -> checkIntegerAdapter-      [IntegerTypeInt16, IntegerTypeUint16, IntegerTypeInt32, IntegerTypeUint32]-      IntegerTypeBigint IntegerTypeInt32 True-      (IntegerValueBigint b) (IntegerValueInt32 $ fromIntegral b)--  H.it "upgrade uint64 to bigint when supported" $-    QC.property $ \i -> checkIntegerAdapter-      [IntegerTypeInt32, IntegerTypeUint32, IntegerTypeBigint]-      IntegerTypeUint64 IntegerTypeBigint False-      (IntegerValueUint64 i) (IntegerValueBigint $ fromIntegral i)--  H.it "downgrade uint64 to uint32 when bigint is unsupported" $-    QC.property $ \i -> checkIntegerAdapter-      [IntegerTypeInt32, IntegerTypeUint32]-      IntegerTypeUint64 IntegerTypeUint32 True-      (IntegerValueUint64 i) (IntegerValueUint32 $ fromIntegral i)--testLiteralAdapter :: H.SpecWith ()-testLiteralAdapter = H.describe "Test literal adapter" $ do--  H.it "encode binary data as strings" $-    QC.property $ \b -> checkLiteralAdapter-      [LiteralVariantString]-      LiteralTypeBinary LiteralTypeString False-      (LiteralBinary b) (LiteralString b)--  H.it "encode booleans as strings" $-    QC.property $ \b -> checkLiteralAdapter-      [LiteralVariantString]-      LiteralTypeBoolean LiteralTypeString False-      (LiteralBoolean b) (LiteralString $ if b then "true" else "false")--  H.it "encode booleans as integers" $-    QC.property $ \b -> checkLiteralAdapter-      [LiteralVariantInteger]-      LiteralTypeBoolean (LiteralTypeInteger IntegerTypeInt16) False-      (LiteralBoolean b) (LiteralInteger $ IntegerValueInt16 $ if b then 1 else 0)--  H.it "floating-point encoding is delegated to the float adapter" $-    QC.property $ \f -> checkLiteralAdapter-      [LiteralVariantFloat]-      (LiteralTypeFloat FloatTypeBigfloat) (LiteralTypeFloat FloatTypeFloat32) True-      (LiteralFloat $ FloatValueBigfloat f) (LiteralFloat $ FloatValueFloat32 $ realToFrac f)--  H.it "integer encoding is delegated to the integer adapter" $-    QC.property $ \i -> checkLiteralAdapter-      [LiteralVariantInteger]-      (LiteralTypeInteger IntegerTypeBigint) (LiteralTypeInteger IntegerTypeInt32) True-      (LiteralInteger $ IntegerValueBigint i) (LiteralInteger $ IntegerValueInt32 $ fromIntegral i)--  H.it "strings are unchanged" $-    QC.property $ \s -> checkLiteralAdapter-      [LiteralVariantString]-      LiteralTypeString LiteralTypeString False-      (LiteralString s) (LiteralString s)--spec :: H.Spec-spec = do-  testFloatAdapter-  testIntegerAdapter-  testLiteralAdapter
+ src/test/haskell/Hydra/MonadsSpec.hs view
@@ -0,0 +1,53 @@+module Hydra.MonadsSpec where++import Hydra.Kernel+import qualified Hydra.Dsl.Terms as Terms+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.List as L+import qualified Data.Map as M+import qualified Test.Hspec as H+++checkErrorTrace :: H.SpecWith ()+checkErrorTrace = do+  H.describe "Check error traces resulting from an explicit failure" $ do++    H.it "Error traces are in the right order" $+      H.shouldBe+        (unFlow (withTrace "one" $ withTrace "two" $ if False then pure 42 else fail "oops") () emptyTrace)+        (FlowState Nothing () emptyTrace {traceMessages = ["Error: oops (one > two)"]})++checkMaxTraceDepth :: H.SpecWith ()+checkMaxTraceDepth = do+  H.describe "Check breaking out of flows with an infinite loop" $ do++    H.it "Flows with no trace are OK" $+      H.shouldBe+        (unFlow (testFlow 42 0) () emptyTrace)+        (FlowState (Just 42) () emptyTrace)++    H.it "Flows with a trace just below the maximum depth are OK" $+      H.shouldBe+        (unFlow (testFlow 42 maxTraceDepth) () emptyTrace)+        (FlowState (Just 42) () emptyTrace)++    H.it "Flows fail when their trace reaches the maximum depth" $ do+      H.shouldBe (flowStateValue overflow) Nothing+      H.shouldBe (L.length $ traceMessages $ flowStateTrace overflow) 1+  where+    overflow = unFlow (testFlow 42 (maxTraceDepth+1)) () emptyTrace++testFlow :: x -> Int -> Flow () x+testFlow seed depth = helper depth+  where+    helper d = if d == 0+      then pure seed+      else withTrace ("level " ++ show (depth-d)) $ helper (d-1)++spec :: H.Spec+spec = do+  checkErrorTrace+  checkMaxTraceDepth
src/test/haskell/Hydra/ReductionSpec.hs view
@@ -1,7 +1,12 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.ReductionSpec.spec+-}+ module Hydra.ReductionSpec where  import Hydra.Kernel-import Hydra.Reduction import Hydra.Dsl.Terms as Terms import Hydra.Lib.Strings import qualified Hydra.Dsl.Types as Types@@ -20,18 +25,18 @@   H.describe "Tests for alpha conversion" $ do     H.it "Variables are substituted at the top level" $       QC.property $ \v ->-        alphaConvert (Name v) (var $ v ++ "'") (var v) == (var (v ++ "'") :: Term)+        alphaConvert (Name v) (Name $ v ++ "'") (var v) == (var (v ++ "'") :: Term)     H.it "Variables are substituted within subexpressions" $       QC.property $ \v ->-        alphaConvert (Name v) (var $ v ++ "'") (list [int32 42, var v])+        alphaConvert (Name v) (Name $ v ++ "'") (list [int32 42, var v])           == (list [int32 42, var (v ++ "'")] :: Term)     H.it "Lambdas with unrelated variables are transparent to alpha conversion" $       QC.property $ \v ->-        alphaConvert (Name v) (var $ v ++ "1") (lambda (v ++ "2") $ list [int32 42, var v, var (v ++ "2")])+        alphaConvert (Name v) (Name $ v ++ "1") (lambda (v ++ "2") $ list [int32 42, var v, var (v ++ "2")])           == (lambda (v ++ "2") $ list [int32 42, var (v ++ "1"), var (v ++ "2")] :: Term)     H.it "Lambdas of the same variable are opaque to alpha conversion" $       QC.property $ \v ->-        alphaConvert (Name v) (var $ v ++ "1") (lambda v $ list [int32 42, var v, var (v ++ "2")])+        alphaConvert (Name v) (Name $ v ++ "1") (lambda v $ list [int32 42, var v, var (v ++ "2")])           == (lambda v $ list [int32 42, var v, var (v ++ "2")] :: Term)  checkLiterals :: H.SpecWith ()@@ -149,13 +154,13 @@ --        (reduce True app5) --        (TypeRecord $ RowType (Name "Example") [Types.field "foo" $ Types.function Types.string Types.string])   where-    app1 = Types.apply (Types.lambda "t" $ Types.function (Types.var "t") (Types.var "t")) Types.string :: Type-    app2 = Types.apply (Types.lambda "x" testTypeLatLon) Types.int32 :: Type-    app3 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") [Types.field "foo" $ Types.var "a"]) Types.unit :: Type-    app4 = Types.apply (Types.apply (Types.lambda "x" $ Types.lambda "y" $ TypeRecord $ RowType (Name "Example") [+    app1 = Types.apply (Types.forAll "t" $ Types.function (Types.var "t") (Types.var "t")) Types.string :: Type+    app2 = Types.apply (Types.forAll "x" testTypeLatLon) Types.int32 :: Type+    app3 = Types.apply (Types.forAll "a" $ TypeRecord $ RowType (Name "Example") [Types.field "foo" $ Types.var "a"]) Types.unit :: Type+    app4 = Types.apply (Types.apply (Types.forAll "x" $ Types.forAll "y" $ TypeRecord $ RowType (Name "Example") [       Types.field "f1" $ Types.var "x",       Types.field "f2" $ Types.var "y"]) Types.int32) Types.int64 :: Type-    app5 = Types.apply (Types.lambda "a" $ TypeRecord $ RowType (Name "Example") [Types.field "foo" $ Types.var "a"]) app1+    app5 = Types.apply (Types.forAll "a" $ TypeRecord $ RowType (Name "Example") [Types.field "foo" $ Types.var "a"]) app1  reduce :: Type -> Type reduce typ = fromFlow typ (schemaContext testGraph) (betaReduceType typ)
+ src/test/haskell/Hydra/Reference/AlgorithmW.hs view
@@ -0,0 +1,658 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}++-- Implementation of Hindley Milner algorithm W to system F translation by Ryan Wisnesky.+-- Lightweight adaptation to Hydra by Joshua Shinavier.+-- License: Apache 2.0 https://www.apache.org/licenses/LICENSE-2.0 ++module Hydra.Reference.AlgorithmW where++import Prelude+import Control.Monad.Except+import Control.Monad.State+import Data.List (nub)+import Debug.Trace++import Hydra.Minimal++natType = TyLit $ LiteralTypeInteger IntegerTypeInt32+constNeg = Const $ PrimTyped $ TypedPrimitive (Name "hydra.lib.math.neg") $ Forall [] $ TyFn natType natType+-- Note: Hydra has no built-in pred or succ functions, but neg has the expected type+constPred = constNeg+constSucc = constNeg+nat = Const . PrimLiteral . int32+str = Const . PrimLiteral . string++-- A typed primitive corresponds to the Hydra primitive of the same name+data TypedPrimitive = TypedPrimitive Name TypSch deriving (Eq, Show)++------------------------+-- STLC++type Var = String++data Prim+ = PrimLiteral Literal+ | PrimTyped TypedPrimitive+ | Succ | Pred | If0+ | Fst | Snd | Pair | TT+ | Nil | Cons | FoldList  + | FF | Inl | Inr | Case + deriving (Eq, Show)+ +showPrim :: Prim -> String+showPrim (PrimLiteral l) = case l of+  LiteralBoolean b -> show b+  LiteralFloat fv -> case fv of+    FloatValueBigfloat f -> show f+    FloatValueFloat32 f -> show f+    _ -> show fv+  LiteralInteger iv -> case iv of+    IntegerValueInt32 i -> show i+    _ -> show iv+  LiteralString s -> show s+  _ -> show l+showPrim (PrimTyped (TypedPrimitive name _)) = unName name ++ "()"+showPrim Succ = "S"+showPrim Pred = "P"+showPrim FoldList = "fold"+showPrim Fst = "fst"+showPrim Snd = "snd"+showPrim Nil = "nil"+showPrim Cons = "cons"+showPrim TT = "tt"+showPrim FF = "ff"+showPrim Inl = "inl"+showPrim Inr = "inr"+showPrim Case = "case"+showPrim If0 = "if0"+showPrim Pair = "pair"++data Expr = Const Prim+ | Var Var+ | App Expr Expr+ | Abs Var Expr+ | Letrec [(Var, Expr)] Expr+ deriving (Eq, Show)++showExpr :: Expr -> String+showExpr (Const p) = showPrim p+showExpr (Var v) = v+showExpr (App (App (App a' a) b) b') = "(" ++ showExpr a' ++ " " ++ showExpr a ++ " " ++ showExpr b ++ " " ++ showExpr b' ++ ")"+showExpr (App (App a b) b') = "(" ++ showExpr a ++ " " ++ showExpr b ++ " " ++ showExpr b' ++ ")"+showExpr (App a b) = "(" ++ showExpr a ++ " " ++ showExpr b ++ ")"+showExpr (Abs a b) = "(\\" ++ a ++ ". " ++ showExpr b ++ ")"+showExpr (Letrec ab c) = "let " ++ d ++ showExpr c+  where d = foldr (\(p, q) r -> p ++ " = " ++ showExpr q ++ " \n\t\t" ++ r) "in " ab++data MTy = TyVar Var+  | TyLit LiteralType+  | TyList MTy+  | TyFn MTy MTy+  | TyProd MTy MTy+  | TySum MTy MTy+  | TyUnit +  | TyVoid+ deriving (Eq, Show)+ +showMTy :: MTy -> String+showMTy (TyLit lt) = case lt of+  LiteralTypeInteger it -> drop (length "IntegerType") $ show it+  LiteralTypeFloat ft -> drop (length "FloatType") $ show ft+  _ -> drop (length "LiteralType") $ show lt+showMTy (TyVar v) = v+showMTy (TyList t) = "(List " ++ (showMTy t) ++ ")"+showMTy (TyFn t1 t2) = "(" ++ showMTy t1 ++ " -> " ++ showMTy t2 ++ ")"+showMTy (TyProd t1 t2) = "(" ++ showMTy t1 ++ " * " ++ showMTy t2 ++  ")"+showMTy (TySum t1 t2) = "(" ++ showMTy t1 ++ " + " ++ showMTy t2 ++  ")"+showMTy TyUnit = "Unit"+showMTy TyVoid = "Void"+  +instance Show TypSch where+  show (Forall [] t) = show t+  show (Forall x t) = "forall " ++ d ++ show t+   where d = foldr (\p q -> p ++ " " ++ q) ", " x+  +data TypSch = Forall [Var] MTy+ deriving Eq ++------------------------+-- System F++data FExpr = FConst Prim+ | FVar Var+ | FApp FExpr FExpr+ | FAbs Var FTy FExpr+ | FTyApp FExpr [FTy]+ | FTyAbs [Var] FExpr + | FLetrec [(Var, FTy, FExpr)] FExpr+ deriving (Eq, Show)++showFExpr :: FExpr -> String+showFExpr (FConst p) = showPrim p+showFExpr (FVar v) = v+showFExpr (FTyApp e t) = "(" ++ showFExpr e ++ " " ++ show (showFTy <$> t) ++ ")"+showFExpr (FApp (FApp (FApp a' a) b) b') = "(" ++ showFExpr a' ++ " " ++ showFExpr a ++ " " ++ showFExpr b ++ " " ++ showFExpr b' ++ ")"+showFExpr (FApp (FApp a b) b') = "(" ++ showFExpr a ++ " " ++ showFExpr b ++ " " ++ showFExpr b' ++ ")"+showFExpr (FApp a b) = "(" ++ showFExpr a ++ " " ++ showFExpr b ++ ")"+showFExpr (FAbs a t b) = "(\\" ++ a ++ ":" ++ showFTy t ++ ". " ++ showFExpr b ++ ")"+showFExpr (FLetrec ab c) = "let " ++ d ++ showFExpr c+  where d = foldr (\(p, t, q) r -> p ++ ":" ++ showFTy t ++ " = " ++ showFExpr q ++ " \n\t\t" ++ r) "in " ab+showFExpr (FTyAbs ab c) = "(/\\" ++ d ++ showFExpr c ++ ")"+  where d = foldr (\p r -> p ++ " " ++ r) ". " ab++data FTy = FTyVar Var +  | FTyLit LiteralType+  | FTyList FTy+  | FTyFn FTy FTy+  | FTyProd FTy FTy+  | FTySum FTy FTy+  | FTyUnit +  | FTyVoid+  | FForall [Var] FTy+ deriving (Eq, Show)+ +showFTy :: FTy -> String+showFTy (FTyLit lt) = showMTy $ TyLit lt+showFTy (FTyVar v) = v+showFTy (FTyList t) = "(List " ++ (showFTy t) ++ ")"+showFTy (FTyFn t1 t2) = "(" ++ showFTy t1 ++ " -> " ++ showFTy t2 ++ ")"+showFTy (FTyProd t1 t2) = "(" ++ showFTy t1 ++ " * " ++ showFTy t2 ++  ")"+showFTy (FTySum t1 t2) = "(" ++ showFTy t1 ++ " + " ++ showFTy t2 ++  ")"+showFTy FTyUnit = "Unit"+showFTy FTyVoid = "Void"+showFTy (FForall x t) = "(forall " ++ d ++ showFTy t ++ ")"+ where d = foldr (\p q -> p ++ " " ++ q) ", " x++mTyToFTy :: MTy -> FTy +mTyToFTy (TyVar v) = FTyVar v +mTyToFTy (TyLit lt) = FTyLit lt+mTyToFTy TyUnit = FTyUnit+mTyToFTy TyVoid = FTyVoid+mTyToFTy (TyList x) = FTyList $ mTyToFTy x+mTyToFTy (TyFn x y) = FTyFn (mTyToFTy x) (mTyToFTy y)+mTyToFTy (TyProd x y) = FTyProd (mTyToFTy x) (mTyToFTy y)+mTyToFTy (TySum x y) = FTySum (mTyToFTy x) (mTyToFTy y)++tyToFTy :: TypSch -> FTy +tyToFTy (Forall [] t) = mTyToFTy t+tyToFTy (Forall vs t) = FForall vs (mTyToFTy t)++--------------------+-- Contexts ++type Ctx  = [(Var, TypSch)]+type FCtx = [(Var, FTy)]++instance Show Ctx+ where show [] = ""+       show ((v,t):[]) = v ++ ":" ++ show t ++ "  "+       show ((v,t):x ) = v ++ ":" ++ show t ++ " " ++ show x++instance Show FCtx+ where show [] = ""+       show ((v,t):[]) = v ++ ":" ++ show t+       show ((v,t):x ) = v ++ ":" ++ show t ++ " " ++ show x++class Vars a where+  vars :: a -> [Var]++instance Vars Ctx where+ vars [] = []+ vars ((v,t):l) = vars t ++ vars l++instance Vars TypSch where+ vars (Forall vs t) = filter (\v -> not $ elem v vs) (vars t) ++instance Vars MTy where+ vars (TyVar v) = [v] + vars (TyList t) = vars t + vars (TyFn t1 t2) = vars t1 ++ vars t2+ vars TyUnit = []+ vars TyVoid = []+ vars (TyProd t1 t2) = vars t1 ++ vars t2+ vars (TySum t1 t2) = vars t1 ++ vars t2+ vars (TyLit _) = []++primTy :: Prim -> TypSch+primTy (PrimLiteral l) = Forall [] $ TyLit $ literalType l+primTy (PrimTyped (TypedPrimitive _ forAll)) = forAll+primTy Fst = Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "x")+primTy Snd = Forall ["x", "y"] $ (TyProd (TyVar "x") (TyVar "y")) `TyFn` (TyVar "y")+primTy Nil = Forall ["t"] $ TyList (TyVar "t")+primTy Cons = Forall ["t"] $ TyFn (TyVar "t") (TyFn (TyList (TyVar "t")) (TyList (TyVar "t")))+primTy TT = Forall [] TyUnit+primTy FF = Forall ["t"] $ TyFn TyVoid (TyVar "t")+primTy Inl = Forall ["x", "y"] $ (TyVar "x") `TyFn` (TyProd (TyVar "x") (TyVar "y"))  +primTy Inr = Forall ["x", "y"] $ (TyVar "y") `TyFn` (TyProd (TyVar "x") (TyVar "y"))+primTy Succ = Forall [] $ natType `TyFn` natType+primTy Pred = Forall [] $ natType `TyFn` natType+primTy Pair = Forall ["x", "y"] $ (TyFn (TyVar "x") (TyFn (TyVar "y") (TyProd (TyVar "x") (TyVar "y"))))+primTy If0 = Forall [] $ natType `TyFn` (natType `TyFn` (natType `TyFn` natType))+primTy FoldList = Forall ["a", "b"] $ p `TyFn` ((TyVar "b") `TyFn` ((TyList $ TyVar "a") `TyFn` (TyVar "b")))+ where p = TyVar "b" `TyFn` (TyVar "a" `TyFn` TyVar "b")+primTy Case = Forall ["x", "y", "z"] $ (TySum (TyVar "x") (TyVar "y")) `TyFn` (l `TyFn` (r `TyFn` (TyVar "z"))) + where l = (TyVar "x") `TyFn` (TyVar "z")+       r = (TyVar "y") `TyFn` (TyVar "z")+  +ctxToFCtx :: Ctx -> [(Var, FTy)]+ctxToFCtx [] = []+ctxToFCtx ((k,v):b) = (k, (tyToFTy v)) : ctxToFCtx b++-----------------------------+-- Substitution++type Subst = [(Var, MTy)]++idSubst :: Subst +idSubst = []++o :: Subst -> Subst -> Subst+o f g = addExtra ++ map h g+ where h (v, g') = (v, subst f g')+       addExtra = filter (\(v,f')-> case lookup v g of +                                      Just y  -> False +                                      Nothing -> True) f+       +class Substable a where+  subst :: Subst -> a -> a+  +instance Substable MTy where+ subst f (TyLit lt) = TyLit lt+ subst f TyUnit = TyUnit+ subst f TyVoid = TyVoid+ subst f (TyList t) = TyList $ subst f t+ subst f (TyFn t1 t2) = TyFn (subst f t1) (subst f t2)+ subst f (TyProd t1 t2) = TyProd  (subst f t1) (subst f t2)+ subst f (TySum t1 t2) = TySum  (subst f t1) (subst f t2)+ subst f (TyVar v) = case lookup v f of+                      Nothing -> TyVar v+                      Just y -> y+                      +instance Substable FTy where+ subst f (FTyLit lt) = FTyLit lt+ subst f FTyUnit = FTyUnit+ subst f FTyVoid = FTyVoid+ subst f (FTyList t) = FTyList $ subst f t + subst f (FTyFn t1 t2) = FTyFn (subst f t1) (subst f t2) + subst f (FTyProd t1 t2) = FTyProd  (subst f t1) (subst f t2)+ subst f (FTySum t1 t2) = FTySum  (subst f t1) (subst f t2)+ subst f (FTyVar v) = case lookup v f of+                        Nothing -> FTyVar v+                        Just y -> mTyToFTy y+ subst f (FForall vs t) = FForall vs $ subst phi' t                        +  where phi' = filter (\(v,f')-> not (elem v vs)) f++instance Substable TypSch where+ subst f (Forall vs t) = Forall vs $ subst f' t +   where f' = filter (\(v,t')-> not $ elem v vs) f++instance Substable Ctx where+ subst phi g = map (\(k,v)->(k, subst phi v)) g++instance Substable FExpr where + subst phi (FConst p) = FConst p+ subst phi (FVar p) = FVar p+ subst phi (FApp p q) = FApp (subst phi p) (subst phi q)+ subst phi (FAbs p t q) = FAbs p (subst phi t) (subst phi q)+ subst phi (FTyApp p q) = FTyApp (subst phi p) (map (subst phi) q) + subst phi (FTyAbs vs p) = FTyAbs vs (subst phi' p)+  where phi' = filter (\(v,f')-> not (elem v vs)) phi+ subst phi (FLetrec vs p) = FLetrec (map (\(k,t,v)->(k,subst phi t, subst phi v)) vs) (subst phi p)++subst' :: [(Var,FTy)] -> FTy -> FTy +subst' f (FTyLit lt) = FTyLit lt+subst' f FTyUnit = FTyUnit+subst' f FTyVoid = FTyVoid+subst' f (FTyList t) = FTyList $ subst' f t +subst' f (FTyFn t1 t2) = FTyFn (subst' f t1) (subst' f t2) +subst' f (FTyProd t1 t2) = FTyProd  (subst' f t1) (subst' f t2)+subst' f (FTySum t1 t2) = FTySum  (subst' f t1) (subst' f t2)+subst' f (FTyVar v) = case lookup v f of+                        Nothing -> FTyVar v+                        Just y -> y+subst' f (FForall vs t) = FForall vs $ subst' f' t                         + where f' = filter (\(v,f')-> not (elem v vs)) f+ +------------------------------------+-- Type checking for F++open :: [Var] -> [FTy] -> FTy -> Either String FTy+open vs ts e | length vs == length ts = return $ subst' (zip vs ts) e+             | otherwise = throwError "Cannot open"+++wfTy :: [Var] -> FTy -> Either String ()+wfTy tvs x = case x of+                FTyLit _ -> return ()+                FTyList y -> wfTy tvs y+                FTyFn w v -> wfTy tvs w >> wfTy tvs v+                FTyProd w v -> wfTy tvs w >> wfTy tvs v+                FTySum w v -> wfTy tvs w >> wfTy tvs v+                FTyUnit -> return ()+                FTyVoid -> return ()+                FForall vs y -> wfTy (vs++tvs) y+                FTyVar v -> if elem v tvs then return () else throwError $ "unbound tyvar " ++ v ++ " in " ++ show tvs+++typeOf :: [Var] -> [(Var,FTy)] -> FExpr -> Either String FTy+typeOf tvs g (FVar x) = case lookup x g of+  Nothing -> throwError $ "unbound var: " ++ x ++ " in ctx " ++ show g+  Just y -> return y+typeOf tvs g (FConst p) = return $ tyToFTy $ primTy p+typeOf tvs g (FApp a b) = do { t1 <- typeOf tvs g a+                             ; t2 <- typeOf tvs g b+                             ; wfTy tvs t1+                             ; wfTy tvs t2+                             ; case t1 of+                                (FTyFn p q) -> if p == t2+                                               then return q+                                               else throwError $ "3In " ++ (show $ FApp a b) ++ " expected " ++ show p ++ " given " ++ show t2+                                v -> throwError $ "4In " ++ show g ++ " |- " ++ show (FApp a b) ++ " not a fn type: " ++ show v }+typeOf tvs g (FAbs x t e) = do { wfTy tvs t+                               ; t1 <- typeOf tvs ((x,t):g) e+                               ; wfTy tvs t1+                               ; return $ t `FTyFn` t1 }+typeOf tvs g (FTyAbs vs e) = do { t1 <- typeOf (vs++tvs) g e+                                ; wfTy (vs++tvs) t1+                                ; return $ FForall vs t1 }+typeOf tvs g (FTyApp e ts) = do { t1 <- typeOf tvs g e+                                ; wfTy tvs t1+                                ; case t1 of+                                    FForall vs t -> open vs ts t+                                    v -> throwError $ "not a forall type: " ++ show v }+typeOf tvs g (FLetrec es e) = do { let g' = map (\(k,t,e)->(k,t)) es+                                 ; est <- mapM (\(_,_,v)->typeOf tvs (g'++g) v) es+                                 ; mapM (wfTy tvs) est+                                 ; mapM (wfTy tvs) $ snd $ unzip g'+                                 ; if est == (snd $ unzip g')+                                   then typeOf tvs (g'++g) e+                                   else throwError $ "Disagree: " ++ show est ++ " and " ++ (show $ snd $ unzip g') }+++-----------------------------+-- Unification++mgu :: MTy -> MTy -> E Subst+mgu (TyLit lt1) (TyLit lt2) = if lt1 == lt2+  then return []+  else throwError $ "Cannot unify literal types " ++ show lt1 ++ " and " ++ show lt2+mgu (TyList a) (TyList b) = mgu a b+mgu TyUnit TyUnit = return []+mgu TyVoid TyVoid = return []+mgu (TyProd a b) (TyProd a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }+mgu (TySum  a b) (TySum  a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }+mgu (TyFn   a b) (TyFn   a' b') = do { s <- mgu a a' ; s' <- mgu (subst s b) (subst s b'); return $ s' `o` s }+mgu (TyVar a) (TyVar b) | a == b = return []+mgu (TyVar a) b = do { occurs a b; return [(a, b)] }+mgu a (TyVar b) = mgu (TyVar b) a+mgu a b = throwError $ "cannot unify " ++ show a ++ " with " ++ show b ++mgu' :: [MTy] -> [MTy] -> E Subst+mgu' [] [] = return idSubst+mgu' (a:as) (b:bs) = do { f <- mgu a b; s <- mgu' (map (subst f) as) (map (subst f) bs); return $ s `o` f }++occurs :: Var -> MTy -> E ()+occurs v (TyLit _) = return ()+occurs v (TyList l) = occurs v l+occurs v TyUnit = return ()+occurs v TyVoid = return ()       +occurs v (TyFn   a b) = do { occurs v a; occurs v b }+occurs v (TyProd a b) = do { occurs v a; occurs v b }+occurs v (TySum  a b) = do { occurs v a; occurs v b }+occurs v (TyVar v') | v == v' = throwError $ "occurs check failed"+                    | otherwise = return ()++-----------------------------+-- Algorithm W ++type E = ExceptT String (State Integer)+type M a = E (Subst, a)++fresh :: E MTy+fresh = do { s <- get; put (s + 1); return $ TyVar $ "v" ++ show s }++inst :: TypSch -> E (MTy, [MTy])+inst (Forall vs ty) = do { vs' <- mapM (\_->fresh) vs; return $ (subst (zip vs vs') ty,  vs') }++gen :: Ctx -> MTy -> (TypSch, [Var])+gen g t = (Forall vs t , vs)+ where vs = nub $ filter (\v -> not $ elem v (vars g)) (vars t)++fTyApp x [] = x+fTyApp x y = FTyApp x y++fTyAbs [] x = x+fTyAbs x y = FTyAbs x y++check :: [Var] -> Ctx -> MTy -> FExpr -> M ()+check k g t e = let ret = typeOf k (ctxToFCtx g) e+                in case ret of+                  Right t0 -> if t0 == mTyToFTy t+                              then return (idSubst, ())+                              else throwError $ "2In\n" ++ show k ++ ", " ++ show g +++                                 " |- " ++ show e ++ " : " ++ show t ++ "\n " ++ show t0 ++ " is computed"+                  Left err -> throwError $ "1In\n" ++ show k ++ ", " ++ show g +++                                 " |- " ++ show e ++ " : " ++ show t ++ "\n" ++ err++check0 :: [Var] -> Ctx -> [MTy] -> [FExpr] -> M ()+check0 k g [] [] = return (idSubst, ())+check0 k g (a:b) (c:d) = check k g a c >> check0 k g b d++w :: Ctx -> Expr -> M (MTy, FExpr)+w g (Const p) = do { (t,vs) <- inst $ primTy p+                     ; let ret = (idSubst, (t, fTyApp (FConst p) $ map mTyToFTy vs))+                     ; check (map (\(TyVar a )->a) vs) (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                     ; return ret }+ where Forall vs t' = primTy p+w g (Var x) = case lookup x g of+                Nothing -> throwError $ "Unknown var: " ++ (show x) ++ " in ctx " ++ (show g)+                Just s -> do { (t, vs) <- inst s+                             ; let ret = (idSubst, (t, fTyApp (FVar x) $ map mTyToFTy vs))+                             ; check (map (\(TyVar a )->a) vs) (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                             ; return ret }+w g (App e0 e1) = do { (s0, (t0, a)) <- w g e0+                     ; (s1, (t1, b)) <- w (subst s0 g) e1+                     ; t' <- fresh+                     ; s2 <-  (subst s1 t0) `mgu` (t1 `TyFn` t')+                     ; let ret = (s2 `o` (s1 `o` s0), (subst s2 t', FApp (subst (s2 `o` s1) a) (subst s2 b)))+                     ; check ((vars (subst (fst ret) g)) ++ (vars (subst (fst ret) t'))) (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                     ; return ret; }+w g (Abs x e) = do { t  <- fresh+                   ; (s, (t', a)) <- w ((x, (Forall [] t)):g) e+                   ; let ret = (s, (TyFn (subst s t) t', FAbs x (mTyToFTy $ subst s t) a))+                   ; check ((vars (subst s t)) ++ (vars t') ++ (vars $ subst (fst ret) ((x, (Forall [] t)):g)))+                       (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                   ; return ret; }+w g (Letrec xe0 e1) = do { t0s <- mapM (\(k,v) -> do { f <- fresh; return (k, f) }) xe0+                         ; let g' = map (\(k,v) -> (k, Forall [] v)) t0s ++ g+                         ; (s0, (ts,e0Xs)) <- w' g' xe0+                         ; s' <- mgu' (map (\(_,v) -> subst s0 v) t0s) ts++                         ; let g''' = subst (s' `o` s0) g+                               g''  = map (\(k,t) -> (k, fst $ gen {--((subst s' g') ++ --} g''' (subst s' t))) $ zip (fst $ unzip xe0) ts+                               g''X = map (\(k,t) -> (k,       gen {--((subst s' g') ++ --} g''' (subst s' t))) $ zip (fst $ unzip xe0) ts+                         ; (s2, (t',e1X)) <- w (g'' ++ g''') e1++                         ; let mmm    = map (\((x,(ww,ww2)),e0X)->(x, (fTyApp (FVar x) $ map FTyVar ww2))) $  zip g''X e0Xs+                         ; let e0X's  = map (\((x,(ww,ww2)),e0X)->(x,ww,ww2, subst'' mmm e0X))             $  zip g''X e0Xs+                         ; let e0X''s = map (\( x, ww,ww2,  e  )->(x,ww,ww2,  fTyAbs ww2 e  ))                         e0X's++                         ; let bs = map (\(x,ww,ww2,e0X'') -> (x, subst s2 $ tyToFTy ww, subst (s' `o` s2) e0X'')) e0X''s+                         ; let ret = (s2 `o` s' `o` s0, (t', FLetrec bs e1X))+                         ; check ((vars $ subst (fst ret) g') ++ (vars t')) (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                         ; return ret }++ where w' g [] = return (idSubst, ([], []))+       w' g  ((k,v):tl) = do { (u,(u', j)) <- w g v+                             ; (r,(r', h)) <- w' (subst u g ) tl+                             ; let ret = (r `o` u, ((subst r u'):r', (subst r j):h))+                             ; --check0 (subst (fst ret) g) (fst $ snd $ ret) (snd $ snd $ ret)+                             ; return ret }+       +++subst'' :: [(Var, FExpr)] -> FExpr -> FExpr+subst'' phi (FConst c) = FConst c+subst'' phi (FVar v') = case lookup v' phi of+                         Just y -> y+                         Nothing -> FVar v'+subst'' phi (FApp a b) = FApp (subst'' phi a) (subst'' phi b)+subst'' phi (FAbs v' a b) = FAbs v' a $ subst'' phi' b + where phi' = filter (\(k,v) -> not (k == v')) phi +subst'' phi (FTyApp a ts) = FTyApp (subst'' phi a) ts+subst'' phi (FTyAbs vs a) = FTyAbs vs $ subst'' phi a+subst'' phi (FLetrec es e) = FLetrec (map (\(k,t,f)->(k,t,subst'' phi' f)) es) (subst'' phi' e)+ where phi' = filter (\(k,v) -> not (elem k ns)) phi+       (ns,ts,es') = unzip3 es +       +----------------------------------------+-- Main+ +tests = [testJ, testM, testJ, testB'', testB' , testB, test4, testC, testA, test0, test1, testB, test2, test3a, test5, test6]+-- tests = [testJ, testB'', testB' , testB]+++testOne t = do { putStrLn $ "Untyped input: "+               ; putStrLn $ "\t" ++  show t+               ; let out = fst $ runState (runExceptT (w [] t)) 0+               ; case out of+                   Left  e -> putStrLn $ "\t" ++ "err: " ++ e+                   Right (s, (ty, f)) -> do {+                                            ; putStrLn $ "\nType inferred by Hindley-Milner: "+                                            ; putStrLn $ "\t" ++ show ty+                                            ; putStrLn "\nSystem F translation: "+                                            ; putStrLn $ "\t" ++ show f+                                            ; putStrLn "\nSystem F type: "+                                            ; case (typeOf (vars ty) [] f) of+                                               Left err -> putStrLn $ "\t" ++  "err: " ++ err+                                               Right tt -> do { putStrLn $ " \t" ++ show tt+                                                              ; if tt == mTyToFTy ty then return () else putStrLn "**** !!! NO MATCH" } }+               ; putStrLn ""+               ; putStrLn "------------------------"+               ; putStrLn ""  }++--testOne t = do { putStrLn $ "Untyped input: "+--               ; putStrLn $ "\t" ++  showExpr t+--               ; let out = fst $ runState (runExceptT (w [] t)) 0+--               ; case out of+--                   Left  e -> putStrLn $ "\t" ++ "err: " ++ e+--                   Right (s, (ty, f)) -> do {+--                                            ; putStrLn $ "\nType inferred by Hindley-Milner: "+--                                            ; putStrLn $ "\t" ++ showMTy ty+--                                            ; putStrLn "\nSystem F translation: "+--                                            ; putStrLn $ "\t" ++ showFExpr f+--                                            ; putStrLn "\nSystem F type: "+--                                            ; case (typeOf (vars ty) [] f) of+--                                               Left err -> putStrLn $ "\t" ++  "err: " ++ err+--                                               Right tt -> do { putStrLn $ " \t" ++ showFTy tt+--                                                              ; if tt == mTyToFTy ty then return () else putStrLn "**** !!! NO MATCH" } }+--               ; putStrLn ""+--               ; putStrLn "------------------------"+--               ; putStrLn ""  }++stlc = Letrec [("x",Var "y"),("y",Var "x")] (App (App (Const Pair) (Var "x")) (Var "y"))+--main = testOne stlc++yyy = let x = y+          y = x in (x,y)++xxx = let foo = bar+          bar = \f -> f $ bar f+      in (foo, bar)++testM :: Expr+testM = Letrec [("g", Var "f"), ("f", Var "g")] $ App (App (Const Pair) $ Var "f") (Var "g")++testJ :: Expr+testJ = Letrec [ ("bar2", barBody2), ("bar1", barBody) ] $ App (App (Const Pair) (Var "bar1")) (Var "bar2")+ where fooBody = (App (Var "bar1") (Abs "x" $ str "false"))+       barBody = Abs "f" $ App (Var "f") $  (App (Var "bar1") (Var "f"))+       barBody2 = Abs "f" $ App (Var "f") $  (App (Var "bar2") (Var "f"))++letrec' x e f = Letrec [(x,e)] f++testA :: Expr+testA =  letrec' "f" ( (Abs "x" (Var "x"))) $ App (Var "f")  (nat 0)+ where sng0 = App (Var "sng") (nat 0)+       sngAlice = App (Var "sng") (str "alice")+       body = (Var "sng")++test0 :: Expr+test0 =  letrec' "f" (App (Abs "x" (Var "x")) (nat 0)) (Var "f")+ where sng0 = App (Var "sng") (nat 0)+       sngAlice = App (Var "sng") (str "alice")++testB' :: Expr+testB' = (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil)))++testB''' :: Expr+testB''' = (Abs "x" (( (Var "x")) ))++testB'' :: Expr+testB'' = (Abs "x" ((App (Const Cons) (Var "x")) ))++testB :: Expr+testB = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body+ where body = (Var "sng")++test1 :: Expr+test1 = letrec' "sng" (Abs "x" (App (App (Const Cons) (Var "x")) (Const Nil))) body+ where sng0 = App (Var "sng") (nat 0)+       sngAlice = App (Var "sng") (str "alice")+       body = App (App (Const Pair) sng0) sngAlice++test2 :: Expr+test2 = letrec' "+" (Abs "x" $ Abs "y" $ recCall) twoPlusOne+ where+   recCall = App (Const Succ) $ App (App (Var "+") (App (Const Pred) (Var "x"))) (Var "y")+   ifz x y z = App (App (App (Const If0) x) y) z+   twoPlusOne = App (App (Var "+") two) one+   two = App (Const Succ) one+   one = App (Const Succ) (nat 0)++testC :: Expr+testC = letrec' "+" (Abs "x" $ Abs "y" $ recCall) $ twoPlusOne+ where+   recCall = App (Const Succ) $ App (App (Var "+") (App (Const Pred) (Var "x"))) ( (Var "y"))+   ifz x y z = App (App (App (Const If0) x) y) z+   twoPlusOne = App (App (Var "+") two) one+   two = App (Const Succ) one+   one = App (Const Succ) (nat 0)++test3 :: Expr+test3 = letrec' "f" f x+ where x =  (Var "f")+       f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x")++test3a :: Expr+test3a = Letrec [("f", f), ("g", g)] x+ where x =  App (App (Const $ Pair) (Var "f")) (Var "g")+       f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x")+       g = Abs "xx" $ Abs "yy" $ App (App (Var "g") (nat 0)) (Var "xx")++test4 :: Expr+test4 = Letrec [("f", f) ,("g", g)] b+ where b = App (App (Const Pair) (Var "f")) (Var "f")+       f = Abs "f" $ Abs "x" $  (App (Var "f") (nat 0))+       g = Abs "u" $ Abs "v" $ App (App (Var "g") (Var "v")) (nat 0)++test4x :: Expr+test4x = Letrec [("f", f) {--,("g", g)--}] (Var "f") --b+ where b = App (App (Const Pair) (Var "f")) (Var "f")+       f = Abs "x" $ Abs "y" $ App (App (Var "f") (nat 0)) (Var "x")+       g = Abs "u" $ Abs "v" $ App (App (Var "g") (Var "v")) (nat 0)++test5 :: Expr+test5 = Letrec [("f", f), ("g", g)] b+ where b = App (App (Const Pair) (Var "f")) (Var "g")+       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (nat 0)+       g = Abs "u" $ Abs "v" $ App (App (Var "f") (Var "v")) (nat 0)+++test6 :: Expr+test6 = Letrec [("f", f), ("g", g)] b+ where b = App (App (Const Pair) (Var "f")) (Var "g")+       f = Abs "x" $ Abs "y" $ App (App (Var "g") (nat 0)) (Var "x")+       g = Abs "u" $ Abs "v" $ App (App (Var "f") (nat 0)) (nat 0)
+ src/test/haskell/Hydra/Reference/AlgorithmWBridge.hs view
@@ -0,0 +1,197 @@+-- | Wrapper for @wisnesky's Algorithm W implementation which makes it into an alternative inferencer for Hydra++module Hydra.Reference.AlgorithmWBridge where++import Hydra.Reference.AlgorithmW++import qualified Hydra.Core as Core+import qualified Hydra.Graph as Graph+import qualified Hydra.Dsl.Literals as Literals+import qualified Hydra.Dsl.LiteralTypes as LiteralTypes+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Types as Types+import Hydra.Sources.Libraries+import Hydra.Coders+import Hydra.Rewriting++import qualified Data.List as L+import qualified Data.Map as M+import qualified Control.Monad as CM++import Control.Monad.Except+import Control.Monad.State+++-- A minimal Hydra graph container for use in these translation functions+data HydraContext = HydraContext (M.Map Core.Name Graph.Primitive)++----------------------------------------++-- Note: no support for @wisnesky's Prim constructors other than Str, Nat, Cons, and Nil+hydraTermToStlc :: HydraContext -> Core.Term -> Either String Expr+hydraTermToStlc context term = case term of+    Core.TermApplication (Core.Application t1 t2) -> App <$> toStlc t1 <*> toStlc t2+    Core.TermFunction f -> case f of+--      Core.FunctionElimination elm -> case elm of+--        EliminationRecord (Projection tname fname) -> Right $ ExprProj+      Core.FunctionLambda (Core.Lambda (Core.Name v) _ body) -> Abs <$> pure v <*> toStlc body+      Core.FunctionPrimitive name -> do+        prim <- case M.lookup name prims of+          Nothing -> Left $ "no such primitive: " ++ Core.unName name+          Just p -> Right p+        ts <- hydraTypeSchemeToStlc $ Graph.primitiveType prim+        return $ Const $ PrimTyped $ TypedPrimitive name ts+    Core.TermLet (Core.Let bindings env) -> Letrec <$> CM.mapM bindingToStlc bindings <*> toStlc env+      where+        bindingToStlc (Core.Binding (Core.Name v) term _) = do+          s <- toStlc term+          return (v, s)+    Core.TermList els -> do+      sels <- CM.mapM toStlc els+      return $ foldr (\el acc -> App (App (Const Cons) el) acc) (Const Nil) sels+    Core.TermLiteral lit -> pure $ Const $ PrimLiteral lit+    Core.TermProduct els -> toPairs <$> CM.mapM toStlc els+      where+        toPairs sels = case sels of+          [] -> Const TT+          [h] -> h+          (h:r) -> pair h (toPairs r)+    Core.TermVariable (Core.Name v) -> pure $ Var v+    _ -> Left $ "Unsupported term: " ++ show term+  where+    HydraContext prims = context+    toStlc = hydraTermToStlc context+    pair a b = App (App (Const Pair) a) b++hydraTypeSchemeToStlc :: Core.TypeScheme -> Either String TypSch+hydraTypeSchemeToStlc (Core.TypeScheme vars body) = do+    sbody <- toStlc body+    return $ Forall (Core.unName <$> vars) sbody+  where+    toStlc typ = case deannotateType typ of+      Core.TypeFunction (Core.FunctionType dom cod) -> TyFn <$> toStlc dom <*> toStlc cod+      Core.TypeList et -> TyList <$> toStlc et+      Core.TypeLiteral lt -> pure $ TyLit lt+--      TypeMap MapType |+--      TypeOptional Type |+      Core.TypeProduct types -> toProd <$> (CM.mapM toStlc types)+        where+          toProd ts = case ts of+            [h] -> h+            (h:r) -> TyProd h (toProd r)+--      TypeRecord RowType |+--      TypeSet Type |+      Core.TypeSum types -> if L.length types == 0+        then pure TyVoid+        else if L.length types == 1+          then Left $ "unary sums are not yet supported"+          else do+            stypes <- CM.mapM toStlc types+            let rev = L.reverse stypes+            return $ L.foldl (\a e -> TySum e a) (TySum (rev !! 1) (rev !! 0)) $ L.drop 2 rev+--      TypeUnion RowType |+      Core.TypeVariable name -> pure $ TyVar $ Core.unName name+--      TypeWrap (Nominal Type)+      _ -> Left $ "unsupported type: " ++ show typ++-- | Convert a System F term expression to a Hydra term+toTerm :: FExpr -> Core.Term+toTerm expr = case expr of+  FAbs v dom e -> Core.TermFunction $ Core.FunctionLambda (Core.Lambda (Core.Name v) (Just hdom) (toTerm e))+    where+      hdom = Core.typeSchemeType $ toTypeScheme dom+  -- App (App (Const Pair) (nat 0)) (nat 1)+  --   e1 = App (Const Pair) (nat 0)+  --   e2 = nat 1++  -- FApp (FApp (FTyApp (FConst pair) [Int32,Int32]) (FConst 0)) (FConst 1)+  --   e1 = FApp (FTyApp (FConst pair) [Int32,Int32]) (FConst 0)+  --   e2 = FConst 1+  FApp e1 e2 -> case e1 of+    FApp (FTyApp (FConst Cons) _) hd -> Core.TermList $+        fmap toTerm (hd:(gather e2)) -- TODO: include inferred type+      where+        gather e = case e of+          FTyApp (FConst Nil) _ -> []+          FApp (FApp (FTyApp (FConst Cons) _) hd) tl -> hd:(gather tl)+    FApp (FTyApp (FConst Pair) _) lhs -> Core.TermProduct [toTerm lhs, toTerm e2]+    _ -> Core.TermApplication $ Core.Application (toTerm e1) (toTerm e2)+  FConst prim -> case prim of+    PrimLiteral lit -> Core.TermLiteral lit+    PrimTyped (TypedPrimitive name _) -> Core.TermFunction $ Core.FunctionPrimitive name+    Nil -> Core.TermList []+    Pair -> Terms.lambdas ["a", "b"] $ Terms.pair (Terms.var "a") (Terms.var "b")+    TT -> Terms.tuple []+    _ -> Terms.string $ "unexpected primitive: " ++ show prim+    -- Note: other prims are unsupported; they can be added here as needed+  FLetrec bindings env -> Core.TermLet $ Core.Let (fmap bindingToHydra bindings) (toTerm env)+    where+      bindingToHydra (v, ty, term) = Core.Binding (Core.Name v) (toTerm term) $ Just $ toTypeScheme ty+  FTyAbs params body -> L.foldl (\t v -> Core.TermTypeLambda $ Core.TypeLambda (Core.Name v) t) (toTerm body) $ L.reverse params+  FTyApp fun args -> L.foldl (\t a -> Core.TermTypeApplication $ Core.TypedTerm t a) (toTerm fun) $ L.reverse hargs+    where+      hargs = fmap (\t -> Core.typeSchemeType $ toTypeScheme t) args+  FVar v -> Core.TermVariable $ Core.Name v++toType :: FTy -> Core.Type+toType ty = case ty of+  FTyVar v -> Core.TypeVariable $ Core.Name v+  FTyLit lt -> Core.TypeLiteral lt+  FTyList lt -> Core.TypeList $ toType lt+  FTyFn dom cod -> Core.TypeFunction $ Core.FunctionType (toType dom) (toType cod)+  FTyProd t1 t2 -> Core.TypeProduct (toType <$> (t1:(componentsTypesOf t2)))+    where+      componentsTypesOf t = case t of+        FTyProd t1 t2 -> t1:(componentsTypesOf t2)+        _ -> [t]+  FTySum t1 t2 -> Core.TypeSum (toType <$> (t1:(componentsTypesOf t2)))+    where+      componentsTypesOf t = case t of+        FTySum t1 t2 -> t1:(componentsTypesOf t2)+        _ -> [t]+  FTyUnit -> Core.TypeProduct []+  FTyVoid -> Core.TypeSum []++-- | Convert a System F type expression to a Hydra type scheme+toTypeScheme :: FTy -> Core.TypeScheme+toTypeScheme ty = case ty of+  FForall vars body -> Core.TypeScheme (Core.Name <$> vars) $ toType body+  _ -> Core.TypeScheme [] $ toType ty++termToInferredFExpr :: HydraContext -> Core.Term -> IO (FExpr, FTy)+termToInferredFExpr context term = do+  stlc <- case hydraTermToStlc context (wrapTerm term) of+     Left err -> fail err+     Right t -> return t+  inferExpr stlc++termToInferredTerm :: HydraContext -> Core.Term -> IO (Core.Term, Core.TypeScheme)+termToInferredTerm context term = do+  fexpr <- fst <$> termToInferredFExpr context term+  unwrapTerm (normalizeTypeVariablesInTerm $ toTerm fexpr)++sFieldName = Core.Name "tempVar"++-- Wrap a term inside a let-term; the Algorithm W implementation only produces "forall" types for let-bindings.+wrapTerm :: Core.Term -> Core.Term+wrapTerm term = Core.TermLet $ Core.Let ([Core.Binding sFieldName term Nothing]) $+  Core.TermLiteral $ Core.LiteralString "tempEnvironment"++unwrapTerm :: Core.Term -> IO (Core.Term, Core.TypeScheme)+unwrapTerm term = case term of+  Core.TermLet (Core.Let bindings _) -> case bindings of+    [(Core.Binding fname t mts)] -> if fname == sFieldName+      then case mts of+         Nothing -> fail "no type scheme in inferred let binding"+         Just ts -> pure (t, ts)+      else fail "expected let binding matching input"+    _ -> fail "expected let bindings"++inferExpr :: Expr -> IO (FExpr, FTy)+inferExpr t = case (fst $ runState (runExceptT (w [] t)) 0) of+  Left e -> fail $ "inference error: " ++ e+  Right (_, (ty, f)) -> case (typeOf [] [] f) of+    Left err -> fail $ "type error: " ++ err+    Right tt -> if tt == mTyToFTy ty+      then return (f, tt)+      else fail "no match"
+ src/test/haskell/Hydra/Reference/AlgorithmWSpec.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.Reference.AlgorithmWSpec.spec+-}+module Hydra.Reference.AlgorithmWSpec where++import Hydra.Kernel+import Hydra.Sources.Libraries+import Hydra.TestUtils+import Hydra.TestData+import qualified Hydra.Extract.Core as ExtractCore+import Hydra.Dsl.Terms as Terms+import qualified Hydra.Dsl.Annotations as Ann+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Show.Core as ShowCore+import qualified Hydra.Reference.AlgorithmWBridge as W++import qualified Hydra.TestUtils as TU+import Hydra.Testing+import Hydra.TestSuiteSpec+import Hydra.Test.TestSuite+import qualified Hydra.Dsl.Testing as Testing++import qualified Test.Hspec as H+import qualified Test.QuickCheck as QC+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S+import Control.Monad+++testHydraContext = W.HydraContext $ graphPrimitives testGraph++inferType :: Term -> IO (Term, TypeScheme)+inferType = W.termToInferredTerm testHydraContext++expectType :: Term -> TypeScheme -> H.Expectation+expectType term ts = do+  result <- inferType term+  H.shouldBe (ShowCore.typeScheme $ snd result) (ShowCore.typeScheme ts)+  H.shouldBe (ShowCore.term $ removeTypesFromTerm $ fst result) (ShowCore.term $ removeTypesFromTerm term)++algorithmWRunner :: TestRunner+algorithmWRunner desc tcase = if Testing.isDisabled tcase || Testing.isDisabledForMinimalInference tcase+  then Nothing+  else case testCaseWithMetadataCase tcase of+    TestCaseInference (InferenceTestCase input output) -> Just $ expectType input output+    _ -> Nothing++spec :: H.Spec+spec = runTestGroup "" algorithmWRunner allTests
src/test/haskell/Hydra/RewritingSpec.hs view
@@ -1,12 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} +{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.RewritingSpec.spec+-} module Hydra.RewritingSpec where  import Hydra.Kernel-import Hydra.Flows+import Hydra.Monads+import Hydra.Tools.Monads import Hydra.Dsl.Terms as Terms-import Hydra.Lib.Io import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.ShorthandTypes+import qualified Hydra.Show.Core as ShowCore  import Hydra.TestUtils @@ -34,74 +41,237 @@   QuuxPair left right -> QuuxPair QuuxUnit right   _ -> q -testExpandLambdas :: H.SpecWith ()-testExpandLambdas = do-  H.describe "Test expanding to lambda terms" $ do+checkFoldOverTerm :: H.SpecWith ()+checkFoldOverTerm = do+  H.describe "Test foldOverTerm" $ do+    H.describe "Pre-order" $ do+      H.it "test #1" $+        H.shouldBe+          (traverse TraversalOrderPre node1)+          ["a"]+      H.it "test #2" $+        H.shouldBe+          (traverse TraversalOrderPre node2)+          ["a", "b", "c", "d"]+    H.describe "Post-order" $ do+      H.it "test #1" $+        H.shouldBe+          (traverse TraversalOrderPost node1)+          ["a"]+      H.it "test #1" $+        H.shouldBe+          (traverse TraversalOrderPost node2)+          ["b", "d", "c", "a"]+  where+    node label children = Terms.pair (Terms.string label) (Terms.list children)+    labelOf term = case term of+      TermProduct [TermLiteral (LiteralString label), _] -> Just label+      _ -> Nothing+    traverse :: TraversalOrder -> Term -> [String]+    traverse order = Y.catMaybes . foldOverTerm order (\l t -> l ++ [labelOf t]) []+    node1 = node "a" []+    node2 = node "a" [node "b" [], node "c" [node "d" []]] -    H.it "Try some terms which do not expand" $ do-      noChange (int32 42)-      noChange (list ["foo", "bar"])-      noChange-        (splitOn @@ "foo" @@ "bar")-      noChange-        (lambda "x" $ int32 42)-      noChange-        (typed Types.int32 $ int32 42)+checkStripTerm :: H.SpecWith ()+checkStripTerm = do+  H.describe "Tests for stripping annotations from terms" $ do+    H.it "Un-annotated terms are not affected" $+      QC.property $ \term -> case (term :: Term) of+        TermAnnotated _ -> True+        _ -> deannotateTerm term == term+    H.it "Terms are stripped recursively" $+      QC.property $ \term -> case (term :: Term) of+        TermAnnotated _ -> True+        _ -> deannotateTerm (Terms.annot M.empty (Terms.annot M.empty term)) == term -    H.it "Expand bare function terms" $ do-      expandsTo-        toLower-        (lambda "v1" $ toLower @@ var "v1")-      expandsTo-        splitOn-        (lambda "v1" $ lambda "v2" $ splitOn @@ var "v1" @@ var "v2")-      expandsTo-        (matchOpt (int32 42) length)-        -- Note two levels of lambda expansion-        (lambda "v1" $ (matchOpt (int32 42) $ lambda "v1" $ length @@ var "v1") @@ var "v1")+checkStripType :: H.SpecWith ()+checkStripType = do+  H.describe "Tests for stripping annotations from types" $ do+    H.it "Un-annotated types are not affected" $+      QC.property $ \typ -> case (typ :: Type) of+        TypeAnnotated _ -> True+        _ -> deannotateType typ == typ+    H.it "Types are stripped recursively" $+      QC.property $ \typ -> case (typ :: Type) of+        TypeAnnotated _ -> True+        _ -> deannotateType (Types.annot M.empty (Types.annot M.empty typ)) == typ -    H.it "Expand subterms within applications" $ do-      expandsTo-        (splitOn @@ "bar")-        (lambda "v1" $ splitOn @@ "bar" @@ var "v1")-      expandsTo-        ((lambda "x" $ var "x") @@ length)-        ((lambda "x" $ var "x") @@ (lambda "v1" $ length @@ var "v1"))+testExpandLambdas :: Graph -> H.SpecWith ()+testExpandLambdas g = do+  H.describe "Test expanding to (untyped) lambda terms" $ do -    H.it "Expand arbitrary subterms" $ do-      expandsTo-        (list [lambda "x" $ list ["foo"], splitOn @@ "bar"])-        (list [lambda "x" $ list ["foo"], lambda "v1" $ splitOn @@ "bar" @@ var "v1"])+    H.describe "Try terms which do not expand" $ do+      H.it "test #1" $+        noChange (int32 42)+      H.it "test #2" $+        noChange (list ["foo", "bar"])+      H.it "test #3" $+        noChange (splitOn @@ "foo" @@ "bar")+      H.it "test #4" $+        noChange (lambda "x" $ lambda "y" $ splitOn @@ var "x" @@ var "y")+      H.it "test #5" $+        noChange (lambda "x" $ int32 42) +    H.describe "Try bare function terms" $ do+      H.it "test #1" $+        expandsTo+          toLower+          (lambda "v1" $ toLower @@ var "v1")+      H.it "test #2" $+        expandsTo+          splitOn+          (lambda "v1" $ lambda "v2" $ splitOn @@ var "v1" @@ var "v2")+      H.it "test #3" $+        expandsTo+          (splitOn @@ var "foo")+          (lambda "v1" $ splitOn @@ var "foo" @@ var "v1")+      H.it "test #4" $+        expandsTo+          (splitOn @@ var "foo" @@ var "bar")+          (splitOn @@ var "foo" @@ var "bar")+      H.it "test #5" $+        expandsTo+          (splitOn @@ var "foo" @@ var "bar" @@ var "baz")+          (splitOn @@ var "foo" @@ var "bar" @@ var "baz")+      H.it "test #6" $+        expandsTo+          (primitive _optionals_maybe @@ (int32 42) @@ length)+          -- Note two levels of lambda expansion+          (lambda "v1" $ (primitive _optionals_maybe @@ (int32 42) @@ (lambda "v1" $ length @@ var "v1")) @@ var "v1")+      H.it "test #7" $+        expandsTo+          (project (Name "Person") (Name "firstName"))+          (lambda "v1" $ ((project (Name "Person") (Name "firstName") @@ var "v1")))+      -- TODO: case statement++    H.describe "Try subterms within applications" $ do+      H.it "test #1" $+        expandsTo+          (splitOn @@ "bar")+          (lambda "v1" $ splitOn @@ "bar" @@ var "v1")+      H.it "test #2" $+        expandsTo+          (lambda "x" $ splitOn @@ var "x")+          (lambda "x" $ lambda "v1" $ splitOn @@ var "x" @@ var "v1")+      H.it "test #3" $+        expandsTo+          ((lambda "x" $ var "x") @@ length)+          (lambda "v1" $ length @@ var "v1")++    H.describe "Try let terms" $ do+      H.it "test #1" $+        noChange+          (lets ["foo">: int32 137] $ int32 42)+      H.it "test #2" $+        expandsTo+          (lets ["foo">: splitOn] $ var "foo")+          (lets ["foo">: lambda "v1" $ lambda "v2" $ splitOn @@ var "v1" @@ var "v2"] $ var "foo")++    H.describe "Check that complete applications are no-ops" $ do+      H.it "test #1" $+        noChange+          (toLower @@ "FOO")+      H.it "test #2" $+        noChange+          (splitOn @@ "foo" @@ "bar")++    H.describe "Try other subterms" $ do+      H.it "test #1" $+        expandsTo+          (list [lambda "x" $ list ["foo"], splitOn @@ "bar"])+          (list [lambda "x" $ list ["foo"], lambda "v1" $ splitOn @@ "bar" @@ var "v1"])+     H.it "Check that lambda expansion is idempotent" $ do       QC.property $ \term -> do-        inf <- fromFlowIo testGraph $ inferTermType term+        let once = expandLambdas g term+        let twice = expandLambdas g once+        H.shouldBe once twice+  where+    length = primitive $ Name "hydra.lib.strings.length"+    splitOn = primitive $ Name "hydra.lib.strings.splitOn"+    toLower = primitive $ Name "hydra.lib.strings.toLower"+    fromList = primitive $ Name "hydra.lib.sets.fromList"+    expandsTo termBefore termAfter = do+       let result = expandLambdas g termBefore+       H.shouldBe (ShowCore.term result) (ShowCore.term termAfter)+    noChange term = expandsTo term term++-- TODO: merge this into expandLambdas+testExpandTypedLambdas :: H.SpecWith ()+testExpandTypedLambdas = do+  H.describe "Test expanding to typed lambda terms" $ do++    H.describe "Try some terms which do not expand" $ do+      H.it "test #1" $+        noChange (int32 42)+      H.it "test #2" $+        noChange (list ["foo", "bar"])+      H.it "test #3" $+        noChange (splitOn @@ "foo" @@ "bar")+      H.it "test #4" $+        noChange (lambda "x" $ int32 42)++    H.describe "Expand bare function terms" $ do+      H.it "test #1" $+        expandsTo+          toLower+          (lambda "v1" $ toLower @@ var "v1")+      H.it "test #2" $+        expandsTo+          splitOn+          (lambda "v1" $ lambda "v2" $ splitOn @@ var "v1" @@ var "v2")+      H.it "test #3" $+        expandsTo+          (primitive _optionals_maybe @@ (int32 42) @@ length)+          -- Note two levels of lambda expansion+          (lambda "v1" $ (primitive _optionals_maybe @@ (int32 42) @@ (lambda "v1" $ length @@ var "v1")) @@ var "v1")+      H.it "test #4" $+        expandsTo+          (project (Name "Person") (Name "firstName"))+          (lambda "v1" $ ((project (Name "Person") (Name "firstName") @@ var "v2")))+      -- TODO: case statement++    H.describe "Expand subterms within applications" $ do+      H.it "test #1" $+        expandsTo+          (splitOn @@ "bar")+          (lambda "v1" $ splitOn @@ "bar" @@ var "v1")+      H.it "test #2" $+        expandsTo+          ((lambda "x" $ var "x") @@ length)+          ((lambda "x" $ var "x") @@ (lambda "v1" $ length @@ var "v1"))++    H.describe "Expand arbitrary subterms" $ do+      H.it "test #1" $+        expandsTo+          (list [lambda "x" $ list ["foo"], splitOn @@ "bar"])+          (list [lambda "x" $ list ["foo"], lambda "v1" $ splitOn @@ "bar" @@ var "v1"])++    H.it "Check that lambda expansion is idempotent" $ do+      QC.property $ \term -> do         let once = expandTypedLambdas term         let twice = expandTypedLambdas once         H.shouldBe once twice    where-    length = primitive $ Name "hydra/lib/strings.length"-    splitOn = primitive $ Name "hydra/lib/strings.splitOn"-    toLower = primitive $ Name "hydra/lib/strings.toLower"+    length = primitive $ Name "hydra.lib.strings.length"+    splitOn = primitive $ Name "hydra.lib.strings.splitOn"+    toLower = primitive $ Name "hydra.lib.strings.toLower"     expandsTo termBefore termAfter = do---      result <- fromFlowIo testGraph $ expandLambdas termBefore+--      result <- flowToIo testGraph $ expandLambdas termBefore --      H.shouldBe result termAfter-       inf <- fromFlowIo testGraph $ inferTermType termBefore+       inf <- flowToIo testGraph (inferenceResultTerm <$> inferInGraphContext termBefore)        let result = expandTypedLambdas inf-       H.shouldBe (showTerm (removeTermAnnotations result)) (showTerm termAfter)-+       H.shouldBe (ShowCore.term (removeTermAnnotations result)) (ShowCore.term termAfter)     noChange term = expandsTo term term -    app = lambda "a" $ project testTypePersonName (Name "firstName") @@ var "a"- testFoldOverTerm :: H.SpecWith () testFoldOverTerm = do   H.describe "Test folding over terms" $ do      H.it "Try a simple fold" $ do       H.shouldBe-        (foldOverTerm TraversalOrderPre addInt32s 0+        (foldOverTerm TraversalOrderPre adds 0           (list [int32 42, (lambda "x" $ var "x") @@ int32 10]))         52 @@ -115,7 +285,7 @@           (list [list [string "foo", string "bar"], (lambda "x" $ var "x") @@ (list [string "quux"])]))         [2, 1, 2]   where-    addInt32s sum term = case term of+    adds sum term = case term of       TermLiteral (LiteralInteger (IntegerValueInt32 i)) -> sum + i       _ -> sum     listLengths l term = case term of@@ -151,7 +321,7 @@   where     makeLet body pairs = TermLet $ Let (makeBinding <$> pairs) body       where-        makeBinding (k, v) = LetBinding (Name k) v Nothing+        makeBinding (k, v) = Binding (Name k) v Nothing     letTerm1 = makeLet (TermList [Terms.var "x", Terms.var "y"]) [       ("x", Terms.int32 1),       ("y", Terms.int32 2)]@@ -202,15 +372,92 @@         (freeVariablesInTerm (list [var "x", (lambda "y" $ var "y") @@ var "y"]))         (S.fromList [Name "x", Name "y"]) ---testReplaceFreeName :: H.SpecWith ()---testReplaceFreeName = do---  H.describe "Test replace free type variables" $ do------    H.it "Check that variable types are replaced" $ do---      H.shouldBe---        (replaceFreeName (Name "v1") Types.string $ Types.var "v")---        ()+testNormalizeTypeVariablesInTerm :: H.SpecWith ()+testNormalizeTypeVariablesInTerm = do+    H.describe "No type variables" $ do+      H.it "test #1" $ noChange+        (int32 42)+      H.it "test #2" $ noChange+        (tlet (int32 42) [+          ("foo", Nothing, string "foo")])+      H.it "test #3" $ noChange+        (tlet (int32 42) [+          ("foo", Just tsString, string "foo")])+      H.it "test #4" $ noChange+        (withMonoFoo $ int32 42) +    H.describe "Only free type variables" $ do+      H.it "test #1" $ noChange+        (withPolyFoo $ int32 42)+      H.it "test #2" $ noChange+        (withMonoFoo const42)+      H.it "test #3" $ noChange+        (withPolyFoo const42)++    H.describe "Simple polymorphic let bindings" $ do+      H.it "test #1" $ changesTo+        (withIdBefore id42)+        (withIdAfter id42)++    H.describe "Rewriting of bindings does not affect environment" $ do+      H.it "test #1" $ changesTo+        (withIdBefore const42) -- Free variable "a" coincides with bound variable "a", but in a different branch.+        (withIdAfter const42)+      H.it "test #2" $ changesTo -- Same substitution in bindings and environment+        (withIdBefore (withIdBefore id42))+        (withIdAfter (withIdAfter id42))++    H.describe "Nested polymorphic let bindings" $ do+      H.it "Parent variable shadows child variable" $ changesTo+        (tlet id42 [+          ("id", Just faa, tlet (lambdaTyped "y" tA $ var "id2" @@ var "y") [+            ("id2", Just faa, lambdaTyped "x" tA $ var "x")])])+        (tlet id42 [+          ("id", Just ft0t0, tlet (lambdaTyped "y" t0 $ var "id2" @@ var "y") [+            ("id2", Just ft1t1, lambdaTyped "x" t1 $ var "x")])])+      H.it "No shadowing" $ changesTo+        (tlet id42 [+          ("id", Just faa, tlet (lambdaTyped "y" tA $ var "id2" @@ var "y") [+            ("id2", Just fbb, lambdaTyped "x" tB $ var "x")])])+        (tlet id42 [+          ("id", Just ft0t0, tlet (lambdaTyped "y" t0 $ var "id2" @@ var "y") [+            ("id2", Just ft1t1, lambdaTyped "x" t1 $ var "x")])])+      H.it "No shadowing, locally free type variable" $ changesTo+        (tlet (var "fun1" @@ string "foo" @@ int32 42) [+          ("fun1", Just (Types.poly ["a", "b"] $ Types.functionMany [tA, tB, tPair tA tB]), lambdaTyped "x" tA $ lambdaTyped "y" tB $+            tlet (var "fun2" @@ var "x") [+              ("fun2", Just (Types.poly ["c"] $ tFun tC $ tPair tC tB), lambdaTyped "z" tC $ pair (var "z") (var "y"))])])+        (tlet (var "fun1" @@ string "foo" @@ int32 42) [+          ("fun1", Just (Types.poly ["t0", "t1"] $ Types.functionMany [t0, t1, tPair t0 t1]), lambdaTyped "x" t0 $ lambdaTyped "y" t1 $+            tlet (var "fun2" @@ var "x") [+              ("fun2", Just (Types.poly ["t2"] $ tFun t2 $ tPair t2 t1), lambdaTyped "z" t2 $ pair (var "z") (var "y"))])])+  where+    changesTo term1 term2 = H.shouldBe (normalize term1) term2+    noChange term = H.shouldBe (normalize term) term+    normalize = normalizeTypeVariablesInTerm+    tlet env triples = TermLet $ Let (toBinding <$> triples) env+      where+        toBinding (key, mts, value) = Binding (Name key) value mts+    t0 = Types.var "t0"+    t1 = Types.var "t1"+    t2 = Types.var "t2"+    const42 = lambdaTyped "x" (Types.function tA tInt32) $ int32 42+    faa = Types.poly ["a"] $ tFun tA tA+    fbb = Types.poly ["b"] $ tFun tB tB+    ft0t0 = Types.poly ["t0"] $ tFun t0 t0+    ft1t1 = Types.poly ["t1"] $ tFun t1 t1+    id42 = var "id" @@ int32 42+    tsString = Types.mono Types.string+    tsA = Types.mono $ Types.var "a"+    withIdBefore term = tlet term [+      ("id", Just faa, lambda "x" $ var "x")]+    withIdAfter term = tlet term [+      ("id", Just ft0t0, lambda "x" $ var "x")]+    withMonoFoo term = tlet term [+      ("foo", Just tsString, string "foo")]+    withPolyFoo term = tlet term [+      ("foo", Just tsA, var "bar")]+ testReplaceTerm :: H.SpecWith () testReplaceTerm = do     H.describe "Test term replacement" $ do@@ -314,7 +561,7 @@       H.it "Isolated bindings" $ do         checkBindings           [("a", string "foo"), ("b", string "bar")]-          [["b"], ["a"]]+          [["a"], ["b"]]        H.it "Single recursive binding" $ do         checkBindings@@ -329,25 +576,28 @@       H.it "Mixed bindings" $ do         checkBindings           [("a", var "b"), ("b", list [var "a", var "c"]), ("c", string "foo"), ("d", string "bar")]-          [["d"], ["c"], ["a", "b"]]+          [["c"], ["a", "b"], ["d"]]   where     checkBindings bindings expectedVars = H.shouldBe-        (topologicalSortBindings bindingMap)+        (topologicalSortBindingMap bindingMap)         expected       where         bindingMap = M.mapKeys (\k -> Name k) $ M.fromList bindings         expected = fmap (fmap (\k -> (Name k, Y.fromMaybe unit $ M.lookup (Name k) bindingMap))) expectedVars ---withType :: Graph -> Type -> Term -> Term---withType typ = setTermType $ Just typ- spec :: H.Spec spec = do---   testExpandLambdas -- TODO: restore me+  checkFoldOverTerm+  checkStripTerm+  checkStripType+   testFoldOverTerm++  testExpandLambdas testGraph+--  testExpandTypedLambdas -- TODO: restore me / merge with testExpandLambdas   testFlattenLetTerms   testFreeVariablesInTerm---  testReplaceFreeName+  testNormalizeTypeVariablesInTerm   testReplaceTerm   testRewriteExampleType   testSimplifyTerm
+ src/test/haskell/Hydra/SerializationSpec.hs view
@@ -0,0 +1,113 @@+module Hydra.SerializationSpec where++import qualified Test.Hspec as H++import Hydra.Ast+import Hydra.Serialization+import Hydra.Ext.Haskell.Operators+++check :: Expr -> String -> H.Expectation+check expr printed = printExpr (parenthesize expr) `H.shouldBe` printed++cases :: Expr -> [(Expr, Expr)] -> Expr+cases cond cases = ifx ofOp lhs rhs+  where+    lhs = spaceSep [cst "case", cond]+    rhs = newlineSep (uncurry (ifx caseOp) <$> cases)+    ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent "  ") (Precedence 0) AssociativityNone++lam :: [String] -> Expr -> Expr+lam vars = ifx lambdaOp $ cst $ "\\" ++ unwords vars++checkAssociativity :: H.SpecWith ()+checkAssociativity = do+  H.describe "Unit tests to verify that associativity is respected" $ do++    H.it "Right-associative operator" $ do+      check+        (ifx arrowOp (ifx arrowOp (cst "a") (cst "b")) (ifx arrowOp (cst "c") (cst "d")))+        "(a -> b) -> c -> d"++checkCaseStatements :: H.SpecWith ()+checkCaseStatements = do+  H.describe "Unit tests for case statements" $ do++    H.it "Simple case statement" $ do+      check+        (cases (ifx gtOp (cst "x") (num 42)) [(cst "False", cst "Big"), (cst "True", cst "Small")])+        (    "case x > 42 of\n"+          ++ "  False -> Big\n"+          ++ "  True -> Small")++    H.it "Nested case statement" $ do+      check+        (cases (ifx gtOp (cst "x") (num 42)) [+          (cst "True", cases (ifx gtOp (cst "x") (num 100)) [(cst "True", cst "ReallyBig"), (cst "False", cst "Big")]),+          (cst "False", cst "Small")])+        (    "case x > 42 of\n"+          ++ "  True -> case x > 100 of\n"+          ++ "    True -> ReallyBig\n"+          ++ "    False -> Big\n"+          ++ "  False -> Small")++checkLambdas :: H.SpecWith ()+checkLambdas = do+  H.describe "Unit tests for lambda expressions" $ do++    H.it "Simple lambda" $ do+      check+        (lam ["x", "y"] (ifx plusOp (cst "x") (cst "y")))+        "\\x y -> x + y"++checkLists :: H.SpecWith ()+checkLists = do+  H.describe "Unit tests for list expressions" $ do++    H.it "Empty list" $ do+      check+        (bracketList inlineStyle [])+        "[]"++    H.it "Simple non-empty list" $ do+      check+        (bracketList inlineStyle [num 1, num 2, num 3])+        "[1, 2, 3]"++    H.it "Nested list" $ do+      check+        (bracketList inlineStyle [bracketList inlineStyle [num 1, num 3], num 2])+        "[[1, 3], 2]"++    H.it "List with parenthesized expression inside" $ do+      check+        (bracketList inlineStyle [bracketList inlineStyle [num 1, ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10))], num 2])+        "[[1, (2 + 3) * (1 + 10)], 2]"++checkPrecedence :: H.SpecWith ()+checkPrecedence = do+  H.describe "Unit tests to verify that operator precedence is respected" $ do++    H.it "Check expressions with operators of different precedence" $ do+      check+        (ifx plusOp (ifx multOp (num 2) (num 3)) (ifx multOp (num 1) (num 10)))+        "2 * 3 + 1 * 10"+      check+        (ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10)))+        "(2 + 3) * (1 + 10)"++    H.it "Check an operator which is both left- and right-associative" $ do+      check+        (ifx multOp (cst "x") (ifx multOp (cst "y") (cst "z")))+        "x * y * z"+      check+        (ifx multOp (ifx multOp (cst "x") (cst "y")) (cst "z"))+        "x * y * z"++spec :: H.Spec+spec = do+  checkAssociativity+  checkCaseStatements+  checkLambdas+  checkLists+  checkPrecedence
+ src/test/haskell/Hydra/SortingSpec.hs view
@@ -0,0 +1,157 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.SortingSpec.spec+-}+module Hydra.SortingSpec where++import qualified Test.Hspec as H++import Hydra.Sorting+import Hydra.Tools.Monads+++checkSort :: [(Int, [Int])] -> Either [[Int]] [Int] -> H.Expectation+checkSort adj exp = H.shouldBe (hydraEitherToHaskellEither $ topologicalSort adj) exp++checkSortSCC :: [(Int, [Int])] -> [[Int]] -> H.Expectation+checkSortSCC adj exp = H.shouldBe (topologicalSortComponents adj) exp++checkSortDiscreteSet :: H.SpecWith ()+checkSortDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do++  H.it "Empty set" $+    checkSort [] (Right [] :: Either [[Int]] [Int])++  H.it "Singleton set" $+    checkSort [(1, [])]+      (Right [1])++  H.it "Discrete set with multiple elements" $+    checkSort [(3, []), (1, []), (2, [])]+--      (Right [3, 2, 1])+      (Right [1, 2, 3])++checkSortTreesAndDags :: H.SpecWith ()+checkSortTreesAndDags = H.describe "Check sorting of trees and DAGs" $ do++  H.it "Linked list" $+    checkSort [(3, [1]), (2, [3]), (1, [])]+      (Right [1, 3, 2])++  H.it "Binary tree" $+    checkSort [(3, [1, 4]), (4, [6, 2]), (1, [5]), (2, []), (6, []), (5, [])]+--      (Right [6, 5, 2, 4, 1, 3])+      (Right [5, 1, 2, 6, 4, 3])++  H.it "Two trees" $+    checkSort [(3, [1, 4]), (5, [6, 2]), (2, [7]), (1, []), (4, []), (6, []), (7, [])]+--      (Right [7, 6, 4, 2, 5, 1, 3])+      (Right [1, 7, 2, 4, 3, 6, 5])++  H.it "Diamond (DAG)" $+    checkSort [(1, [3, 4]), (3, [2]), (4, [2]), (2, [5]), (5, [])]+      (Right [5, 2, 3, 4, 1])++checkSortCycles :: H.SpecWith ()+checkSortCycles = H.describe "Check that sorting of graphs with cycles fails" $ do++  H.it "Two-node cycle" $+    checkSort [(1, [2]), (2, [1])]+      (Left [[1, 2]])++  H.it "Cycle with incoming and outgoing edges" $+    checkSort [(1, [3]), (3, [2]), (2, [3, 4]), (4, [5]), (5, [])]+      (Left [[2, 3]])++checkSortSCCDiscreteSet :: H.SpecWith ()+checkSortSCCDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do++  H.it "Empty set" $+    checkSortSCC []+      ([] :: [[Int]])++  H.it "Singleton set" $+    checkSortSCC [(1, [])]+      [[1]]++  H.it "Discrete set with multiple elements" $+    checkSortSCC [(3, []), (1, []), (2, [])]+--      [[3], [2], [1]]+      [[1], [2], [3]]++checkSortSCCWeaklyConnectedComponents :: H.SpecWith ()+checkSortSCCWeaklyConnectedComponents = H.describe "Check weakly-connected components" $ do++  H.describe "Single, two-element component" $ do+    H.it "test #1" $+      checkSortSCC [(1, [2]), (2, [])]+        [[2], [1]]+    H.it "test #2" $+      checkSortSCC [(2, [1]), (1, [])]+        [[1], [2]]++  H.it "Multiple-element component" $ do+    checkSortSCC [(2, [1, 3]), (1, [3]), (3, [])]+      [[3], [1], [2]]++checkSortSCCStronglyConnectedComponents :: H.SpecWith ()+checkSortSCCStronglyConnectedComponents = H.describe "Check strongly-connected components" $ do++  H.describe "Cycle of two nodes" $ do+    H.it "test #1" $+      checkSortSCC [(1, [2]), (2, [1])]+        [[1, 2]]+    H.it "test #2" $+      checkSortSCC [(2, [1]), (1, [2])]+        [[1, 2]]++  H.describe "Cycle of three nodes, ordered naturally" $ do++    H.it "test #1" $+      checkSortSCC [(1, [2]), (2, [3]), (3, [1])]+        [[1, 2, 3]]+    H.it "test #2" $+      checkSortSCC [(2, [1]), (3, [2]), (1, [3])]+        [[1, 2, 3]]++  H.it "Multiple, disconnected cycles, each ordered naturally" $ do+    checkSortSCC+      ([(200, [])] ++ [(100, [])] ++ [(300, [])] ++ [(10, [20]), (20, [10])] ++ [(1, [2]), (2, [3]), (3, [1])])+--      [[300], [200], [100], [10, 20], [1, 2, 3]]+      [[1, 2, 3], [10, 20], [100], [200], [300]]++  H.it "Complex cycles" $ do+    checkSortSCC [(1, [2, 3]), (2, [3]), (3, [1])]+      [[1, 2, 3]]++checkSortSCCMixed :: H.SpecWith ()+checkSortSCCMixed = H.describe "Check graphs which are a mix of weakly- and strongly-connected components" $ do++  H.it "Chain of three SCCs" $+    checkSortSCC+      [(1, [2, 10]), (2, [3]), (3, [1]), (10, [20]), (20, [100, 10]), (100, [])]+      [[100], [10, 20], [1, 2, 3]]++  H.it "SCCs with dependencies to/from non-SCC nodes" $+    checkSortSCC+      [(1, [2, 3, 10]), (2, [3]), (3, [1]),+       (10, [20, 30]), (20, [30]), (30, []),+       (100, [200, 2]), (200, []), (300, [100]),+       (1000, []),+       (2000, [])]+--      [[2000], [1000], [200], [30], [20], [10], [1, 2, 3], [100], [300]]+      [[30], [20], [10], [1, 2, 3], [200], [100], [300], [1000], [2000]]++spec :: H.Spec+spec = do+  H.describe "Check topological sort (without cycles)" $ do+    checkSortDiscreteSet+    checkSortTreesAndDags+    checkSortCycles++  H.describe "Check sorting of strongly connected components" $ do+    checkSortSCCDiscreteSet+    checkSortSCCWeaklyConnectedComponents+    checkSortSCCStronglyConnectedComponents+    checkSortSCCMixed
+ src/test/haskell/Hydra/Staging/Json/CoderSpec.hs view
@@ -0,0 +1,140 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.Staging.Json.CoderSpec.spec+-}+module Hydra.Staging.Json.CoderSpec where++import Hydra.Kernel+import Hydra.Lib.Literals+import Hydra.Ext.Org.Json.Coder+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Json as Json+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Data.Bifunctor as BF+import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import qualified Test.QuickCheck as QC+++literalTypeConstraintsAreRespected :: H.SpecWith ()+literalTypeConstraintsAreRespected = H.describe "Verify that JSON's literal type constraints are respected" $ do++  -- TODO: binary data++  H.it "Check booleans" $+    QC.property $ \b -> checkJsonCoder Types.boolean (Terms.boolean b) (Json.ValueBoolean b)++  H.it "Check 32-bit floats" $+    QC.property $ \f -> checkJsonCoder Types.float32 (Terms.float32 f) (jsonFloat $ realToFrac f)++  H.it "Check 64-bit floats (doubles)" $+    QC.property $ \d -> checkJsonCoder Types.float64 (Terms.float64 d) (jsonFloat $ realToFrac d)++  -- TODO: bigfloat++  H.it "Check 32-bit integers" $+    QC.property $ \i -> checkJsonCoder Types.int32 (Terms.int32 i) (jsonInt i)++  H.it "Check 16-bit unsigned integers" $+    QC.property $ \i -> checkJsonCoder Types.uint16 (Terms.uint16 i) (jsonInt i)++  H.it "Check arbitrary-precision integers" $+    QC.property $ \i -> checkJsonCoder Types.bigint (Terms.bigint i) (jsonInt i)++  H.it "Check strings" $+    QC.property $ \s -> checkJsonCoder Types.string (Terms.string s) (Json.ValueString s)++supportedTypesPassThrough :: H.SpecWith ()+supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do++  H.it "Lists become JSON arrays" $+    QC.property $ \strings -> checkJsonCoder listOfStringsType+      (Terms.list $ Terms.string <$> strings) (Json.ValueArray $ Json.ValueString <$> strings)++  H.it "Maps become JSON objects" $+    QC.property $ \keyvals -> checkJsonCoder mapOfStringsToIntsType+      (makeMap keyvals) (jsonMap $ BF.bimap id jsonInt <$> keyvals)++  H.it "Optionals become JSON null or type-specific values" $+    QC.property $ \ms -> checkJsonCoder optionalStringType+      (Terms.optional $ Terms.string <$> ms) (Y.maybe Json.ValueNull Json.ValueString ms)++  H.it "Records become JSON objects" $+    QC.property $ \lat lon -> checkJsonCoder testTypeLatLon+      (latlonRecord lat lon) (jsonMap [+        ("lat", jsonFloat $ realToFrac lat),+        ("lon", jsonFloat $ realToFrac lon)])++unsupportedTypesAreTransformed :: H.SpecWith ()+unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do++  -- TODO: functions++  H.it "Sets become arrays" $+    QC.property $ \strings -> checkJsonCoder setOfStringsType+      (stringSet strings)+      (Json.ValueArray $ Json.ValueString <$> S.toList strings)++  H.it "Nominal types are dereferenced" $+    QC.property $ \s -> checkJsonCoder testTypeStringAlias+      (Terms.wrap testTypeStringAliasName $ Terms.string s)+      (Json.ValueString s)++  -- TODO: restore me+--  H.it "Unions become JSON objects (as records)" $+--    QC.property $ \int -> checkJsonCoder stringOrIntType+--      (Terms.inject stringOrIntName $ Field (Name "right") $ Terms.int32 int)+--      (jsonMap [("right", jsonInt int)])++wrappedTypesAreSupported :: H.SpecWith ()+wrappedTypesAreSupported = H.describe "Verify that nominal types are supported" $ do+  H.it "Nominal unions become single-attribute objects" $+    QC.property $ \() -> checkJsonCoder (TypeVariable testTypeUnionMonomorphicName)+      (Terms.inject testTypeUnionMonomorphicName $ Terms.field "bool" $ Terms.boolean True)+      (jsonMap [("bool", jsonBool True)])++  H.it "Nominal enums become single-attribute objects with empty-object values, and type annotations are transparent" $+    QC.property $ \() -> checkJsonCoder (TypeVariable testTypeComparisonName)+      (Terms.inject testTypeComparisonName $ Terms.field "equalTo" Terms.unit)+      (jsonMap [("equalTo", jsonMap [])])++spec :: H.Spec+spec = do+  literalTypeConstraintsAreRespected+  supportedTypesPassThrough+  unsupportedTypesAreTransformed+  -- TODO: restore+--  wrappedTypesAreSupported++checkJsonCoder :: Type -> Term -> Json.Value -> H.Expectation+checkJsonCoder typ term node = case mstep of+    Nothing -> HL.assertFailure (traceSummary trace)+    Just step -> do+      shouldSucceedWith (coderEncode step term) node+      shouldSucceedWith (coderEncode step term >>= coderDecode step) term+  where+    FlowState mstep _ trace = unFlow (jsonCoder typ) testGraph emptyTrace++jsonBool :: Bool -> Json.Value+jsonBool = Json.ValueBoolean++jsonFloat :: Double -> Json.Value+jsonFloat = Json.ValueNumber++jsonInt :: Integral i => i -> Json.Value+jsonInt = Json.ValueNumber . bigintToBigfloat . fromIntegral++jsonMap :: [(String, Json.Value)] -> Json.Value+jsonMap = Json.ValueObject . M.fromList++jsonNull :: Json.Value+jsonNull = Json.ValueNull
+ src/test/haskell/Hydra/Staging/Json/SerdeSpec.hs view
@@ -0,0 +1,107 @@+-- Note: these tests are dependent on Data.Aeson, both because the Serde depends on Data.Aeson+--       and because of the particular serialization style.++module Hydra.Staging.Json.SerdeSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Staging.Json.Serde+import qualified Hydra.Dsl.Types as Types++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Data.List as L+import qualified Test.QuickCheck as QC+import qualified Data.Maybe as Y+++checkLiterals :: H.SpecWith ()+checkLiterals = H.describe "Test literal values" $ do++  H.it "Booleans become 'true' and 'false'" $ do+    QC.property $ \b -> checkSerialization jsonStringCoder+      (TypedTerm (boolean b) $ Types.boolean)+      (if b then "true" else "false")++  H.it "int32's become numbers, and are serialized in the obvious way" $ do+    QC.property $ \i -> checkSerialization jsonStringCoder+      (TypedTerm (int32 i) $ Types.int32)+      (show i)++  H.it "uint8's and other finite integer types become numbers, and are serialized in the obvious way" $ do+    QC.property $ \i -> checkSerialization jsonStringCoder+      (TypedTerm (uint8 i) $ Types.uint8)+      (show i)++  H.it "bigints become numbers" $ do+    QC.property $ \i -> checkSerialization jsonStringCoder+      (TypedTerm (bigint i) $ Types.bigint)+      (show i)++checkOptionals :: H.SpecWith ()+checkOptionals = H.describe "Test and document serialization of optionals" $ do++  H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $+    QC.property $ \mi -> checkSerialization jsonStringCoder+      (TypedTerm+        (optional $ (Just . int32) =<< mi)+        (Types.optional Types.int32))+      (Y.maybe "null" show mi)++  H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $+    QC.property $ \mi -> checkSerialization jsonStringCoder+      (TypedTerm+        (optional $ Just $ optional $ (Just . int32) =<< mi)+        (Types.optional $ Types.optional Types.int32))+      ("[" ++ Y.maybe "null" show mi ++ "]")++  H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $+    QC.property $ \() -> checkSerialization jsonStringCoder+      (TypedTerm+        (optional Nothing)+        (Types.optional $ Types.optional Types.int32))+      "[]"++checkRecordsAndUnions :: H.SpecWith ()+checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do++  H.it "Empty records become empty objects" $+    QC.property $ \() -> checkSerialization jsonStringCoder+      (TypedTerm unit Types.unit)+      "{}"++  H.it "Simple records become simple objects" $+    QC.property $ \() -> checkSerialization jsonStringCoder+      (TypedTerm (latlonRecord 37 (negate 122)) testTypeLatLon)+      "{\"lat\":37,\"lon\":-122}"++  -- TODO: restore me+--  H.it "Optionals are omitted from record objects if 'nothing'" $+--    QC.property $ \() -> checkSerialization jsonStringCoder+--      (TypedTerm+--        (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])+--        (TypeRecord $ RowType testTypeName [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))+--      "{\"one\":\"test\"}"++  -- TODO: restore me+--  H.it "Simple unions become simple objects, via records" $+--    QC.property $ \() -> checkSerialization jsonStringCoder+--      (TypedTerm+--        (inject testTypeName $ Field (Name "left") $ string "test")+--        (TypeUnion $ RowType testTypeName [Types.field "left" Types.string, Types.field "right" Types.int32]))+--      "{\"left\":\"test\"}"++jsonByteStringCoderIsInformationPreserving :: H.SpecWith ()+jsonByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized JSON, and back again is a no-op" $ do++  H.it "Generate arbitrary type/term pairs, serialize the terms to JSON, deserialize them, and compare" $+    QC.property (checkSerdeRoundTrip jsonByteStringCoder)++spec :: H.Spec+spec = do+  checkLiterals+  checkOptionals+  checkRecordsAndUnions+--  jsonByteStringCoderIsInformationPreserving -- TODO: restore me
+ src/test/haskell/Hydra/Staging/TestGraph.hs view
@@ -0,0 +1,46 @@+module Hydra.Staging.TestGraph (+  module Hydra.Staging.TestGraph,+  module Hydra.Sources.Libraries,+  module Hydra.Test.TestGraph,+) where++import Hydra.Kernel+import Hydra.Sources.Libraries+import Hydra.Dsl.Terms+import Hydra.Sources.Kernel.Types.Core+import Hydra.Dsl.Annotations as Ann+import Hydra.Dsl.Bootstrap+import qualified Hydra.Dsl.Types as Types+import Hydra.Test.TestGraph++import qualified Data.Map  as M+import qualified Data.Set  as S+import qualified Hydra.Dsl.Terms as Terms+++testGraph :: Graph+testGraph = elementsToGraph hydraCoreGraph (Just testSchemaGraph) [testElementArthur, testElementFirstName]++testSchemaGraph :: Graph+testSchemaGraph = elementsToGraph hydraCoreGraph (Just hydraCoreGraph) [+    def testTypeBuddyListAName testTypeBuddyListA,+    def testTypeBuddyListBName testTypeBuddyListB,+    def testTypeComparisonName testTypeComparison,+    def testTypeIntListName testTypeIntList,+    def testTypeHydraLiteralTypeName testTypeHydraLiteralType,+    def testTypeHydraTypeName testTypeHydraType,+    def testTypeLatLonName testTypeLatLon,+    def testTypeLatLonPolyName testTypeLatLonPoly,+    def testTypeListName testTypeList,+    def testTypeNumberName testTypeNumber,+    def testTypePersonName testTypePerson,+    def testTypePersonOrSomethingName testTypePersonOrSomething,+    def testTypeSimpleNumberName testTypeSimpleNumber,+    def testTypeStringAliasName $ Ann.doc "An alias for the string type" testTypeStringAlias,+    def testTypePolymorphicWrapperName testTypePolymorphicWrapper,+    def testTypeTimestampName testTypeTimestamp,+    def testTypeUnionMonomorphicName testTypeUnionMonomorphic,+    def testTypeUnionPolymorphicRecursiveName testTypeUnionPolymorphicRecursive,+    def testTypeUnitName testTypeUnit]+  where+    def = typeElement
+ src/test/haskell/Hydra/Staging/Yaml/CoderSpec.hs view
@@ -0,0 +1,125 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.Staging.Yaml.CoderSpec.spec+-}+module Hydra.Staging.Yaml.CoderSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Staging.Yaml.Coder+import qualified Hydra.Ext.Org.Yaml.Model as YM+import qualified Hydra.Dsl.Types as Types+import Hydra.Dsl.Tests++import Hydra.TestData+import Hydra.TestUtils++import qualified Data.Bifunctor as BF+import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Maybe as Y+import qualified Test.QuickCheck as QC+++literalTypeConstraintsAreRespected :: H.SpecWith ()+literalTypeConstraintsAreRespected = H.describe "Verify that YAML's literal type constraints are respected" $ do++  -- TODO: binary data++  H.it "Check booleans" $+    QC.property $ \b -> checkYamlCoder Types.boolean (boolean b) (yamlBool b)++  H.it "Check 32-bit floats" $+    QC.property $ \f -> checkYamlCoder Types.float32 (float32 f) (yamlFloat $ realToFrac f)++  H.it "Check 64-bit floats (doubles)" $+    QC.property $ \d -> checkYamlCoder Types.float64 (float64 d) (yamlFloat $ realToFrac d)++  -- TODO: bigfloat++  H.it "Check 32-bit integers" $+    QC.property $ \i -> checkYamlCoder Types.int32 (int32 i) (yamlInt i)++  H.it "Check 16-bit unsigned integers" $+    QC.property $ \i -> checkYamlCoder Types.uint16 (uint16 i) (yamlInt i)++  H.it "Check arbitrary-precision integers" $+    QC.property $ \i -> checkYamlCoder Types.bigint (bigint i) (yamlInt i)++  H.it "Check strings" $+    QC.property $ \s -> checkYamlCoder Types.string (string s) (yamlStr s)++supportedTypesPassThrough :: H.SpecWith ()+supportedTypesPassThrough = H.describe "Verify that supported types are mapped directly" $ do++  H.it "Lists become YAML sequences" $+    QC.property $ \strings -> checkYamlCoder listOfStringsType+      (list $ string <$> strings) (YM.NodeSequence $ yamlStr <$> strings)++  H.it "Maps become YAML mappings" $+    QC.property $ \keyvals -> checkYamlCoder mapOfStringsToIntsType+      (makeMap keyvals) (yamlMap $ BF.bimap yamlStr yamlInt <$> keyvals)++  H.it "Optionals become YAML null or type-specific nodes" $+    QC.property $ \ms -> checkYamlCoder optionalStringType+      (optional $ string <$> ms) (YM.NodeScalar $ Y.maybe YM.ScalarNull YM.ScalarStr ms)++  H.it "Records become YAML mappings" $+    QC.property $ \lat lon -> checkYamlCoder testTypeLatLon+      (latlonRecord lat lon) (yamlMap [+        (yamlStr "lat", yamlFloat $ realToFrac lat),+        (yamlStr "lon", yamlFloat $ realToFrac lon)])++unsupportedTypesAreTransformed :: H.SpecWith ()+unsupportedTypesAreTransformed = H.describe "Verify that unsupported types are transformed appropriately" $ do++  -- TODO: functions++  H.it "Sets become sequences" $+    QC.property $ \strings -> checkYamlCoder setOfStringsType+      (stringSet strings) (YM.NodeSequence $ yamlStr <$> S.toList strings)++  H.it "Nominal types are dereferenced" $+    QC.property $ \s -> checkYamlCoder testTypeStringAlias+      (wrap testTypeStringAliasName $ string s) (yamlStr s)++  H.it "Unions become YAML mappings (as records)" $+    QC.property $ \int -> checkYamlCoder stringOrIntType+      (variant stringOrIntName (Name "right") $ int32 int)+      (yamlMap [(yamlStr "right", yamlInt int)])++spec :: H.Spec+spec = do+  literalTypeConstraintsAreRespected+  supportedTypesPassThrough+  unsupportedTypesAreTransformed++checkYamlCoder :: Type -> Term -> YM.Node -> H.Expectation+checkYamlCoder typ term node = case mstep of+    Nothing -> HL.assertFailure (traceSummary trace)+    Just step -> do+      shouldSucceedWith (coderEncode step term) node+      shouldSucceedWith (coderEncode step term >>= coderDecode step) term+  where+    FlowState mstep _ trace = unFlow (yamlCoder typ) testGraph emptyTrace++yamlBool :: Bool -> YM.Node+yamlBool = YM.NodeScalar . YM.ScalarBool++yamlFloat :: Double -> YM.Node+yamlFloat = YM.NodeScalar . YM.ScalarFloat++yamlInt :: Integral i => i -> YM.Node+yamlInt = YM.NodeScalar . YM.ScalarInt . fromIntegral++yamlMap :: [(YM.Node, YM.Node)] -> YM.Node+yamlMap = YM.NodeMapping . M.fromList++yamlNull :: YM.Node+yamlNull = YM.NodeScalar YM.ScalarNull++yamlStr :: String -> YM.Node+yamlStr = YM.NodeScalar . YM.ScalarStr
+ src/test/haskell/Hydra/Staging/Yaml/SerdeSpec.hs view
@@ -0,0 +1,110 @@+-- Note: these tests are dependent on HsYaml, both because the Serde depends on HsYaml+--       and because of the particular serialization style.++module Hydra.Staging.Yaml.SerdeSpec where++import Hydra.Kernel+import Hydra.Dsl.Terms+import Hydra.Staging.Yaml.Serde+import qualified Hydra.Dsl.Types as Types++import Hydra.TestData+import Hydra.TestUtils++import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL+import qualified Data.List as L+import qualified Test.QuickCheck as QC+import qualified Data.Maybe as Y+++checkLiterals :: H.SpecWith ()+checkLiterals = H.describe "Test literal values" $ do++  H.it "Booleans become 'true' and 'false' (not 'y' and 'n')" $ do+    QC.property $ \b -> checkSerialization yamlStringCoder+      (TypedTerm (boolean b) Types.boolean)+      (if b then "true" else "false")++  H.it "int32's become ints, and are serialized in the obvious way" $ do+    QC.property $ \i -> checkSerialization yamlStringCoder+      (TypedTerm (int32 i) Types.int32)+      (show i)++  H.it "uint8's and other finite integer types become ints, and are serialized in the obvious way" $ do+    QC.property $ \i -> checkSerialization yamlStringCoder+      (TypedTerm (uint8 i) Types.uint8)+      (show i)++  H.it "bigints become ints" $ do+    QC.property $ \i -> checkSerialization yamlStringCoder+      (TypedTerm (bigint i) Types.bigint)+      (show i)++  -- TODO: examine quirks around floating-point serialization more closely. These could affect portability of the serialized YAML.++  -- TODO: binary string and character string serialization++checkOptionals :: H.SpecWith ()+checkOptionals = H.describe "Test and document serialization of optionals" $ do++  H.it "A 'nothing' becomes 'null' (except when it appears as a field)" $+    QC.property $ \mi -> checkSerialization yamlStringCoder+      (TypedTerm+        (optional $ (Just . int32) =<< mi)+        (Types.optional Types.int32))+      (Y.maybe "null" show mi)++  H.it "Nested optionals case #1: just x? :: optional<optional<int32>>" $+    QC.property $ \mi -> checkSerialization yamlStringCoder+      (TypedTerm+        (optional $ Just $ optional $ (Just . int32) =<< mi)+        (Types.optional $ Types.optional Types.int32))+      ("- " ++ Y.maybe "null" show mi)++  H.it "Nested optionals case #2: nothing :: optional<optional<int32>>" $+    QC.property $ \() -> checkSerialization yamlStringCoder+      (TypedTerm+        (optional Nothing)+        (Types.optional $ Types.optional Types.int32))+      "[]"++checkRecordsAndUnions :: H.SpecWith ()+checkRecordsAndUnions = H.describe "Test and document handling of optionals vs. nulls for record and union types" $ do++  H.it "Empty records become empty objects" $+    QC.property $ \() -> checkSerialization yamlStringCoder+      (TypedTerm unit Types.unit)+      "null"++  H.it "Simple records become simple objects" $+    QC.property $ \() -> checkSerialization yamlStringCoder+      (TypedTerm (latlonRecord 37.0 (negate 122.0)) testTypeLatLon)+      "lat: 37.0\nlon: -122.0"++  H.it "Optionals are omitted from record objects if 'nothing'" $+    QC.property $ \() -> checkSerialization yamlStringCoder+      (TypedTerm+        (record testTypeName [Field (Name "one") $ optional $ Just $ string "test", Field (Name "two") $ optional Nothing])+        (TypeRecord $ RowType testTypeName [Types.field "one" $ Types.optional Types.string, Types.field "two" $ Types.optional Types.int32]))+      "one: test"++  H.it "Simple unions become simple objects, via records" $+    QC.property $ \() -> checkSerialization yamlStringCoder+      (TypedTerm+        (inject testTypeName $ Field (Name "left") $ string "test")+        (TypeUnion $ RowType testTypeName [Types.field "left" Types.string, Types.field "right" Types.int32]))+      "left: test\n"++yamlByteStringCoderIsInformationPreserving :: H.SpecWith ()+yamlByteStringCoderIsInformationPreserving = H.describe "Verify that a round trip from a type+term, to serialized YAML, and back again is a no-op" $ do++  H.it "Generate arbitrary type/term pairs, serialize the terms to YAML, deserialize them, and compare" $+    QC.property (checkSerdeRoundTrip yamlByteStringCoder)++spec :: H.Spec+spec = do+  checkLiterals+  checkOptionals+  checkRecordsAndUnions+--  yamlByteStringCoderIsInformationPreserving -- TODO: restore me
− src/test/haskell/Hydra/StripSpec.hs 
@@ -1,43 +0,0 @@-module Hydra.StripSpec where--import Hydra.Kernel--import Hydra.TestUtils-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.Char as C-import qualified Data.List as L-import qualified Data.Map as M---checkStripTerm :: H.SpecWith ()-checkStripTerm = do-  H.describe "Tests for stripping annotations from terms" $ do-    H.it "Un-annotated terms are not affected" $-      QC.property $ \term -> case (term :: Term) of-        TermAnnotated _ -> True-        _ -> stripTerm term == term-    H.it "Terms are stripped recursively" $-      QC.property $ \term -> case (term :: Term) of-        TermAnnotated _ -> True-        _ -> stripTerm (Terms.annot M.empty (Terms.annot M.empty term)) == term--checkStripType :: H.SpecWith ()-checkStripType = do-  H.describe "Tests for stripping annotations from types" $ do-    H.it "Un-annotated types are not affected" $-      QC.property $ \typ -> case (typ :: Type) of-        TypeAnnotated _ -> True-        _ -> stripType typ == typ-    H.it "Types are stripped recursively" $-      QC.property $ \typ -> case (typ :: Type) of-        TypeAnnotated _ -> True-        _ -> stripType (Types.annot M.empty (Types.annot M.empty typ)) == typ--spec :: H.Spec-spec = do-  checkStripTerm-  checkStripType
− src/test/haskell/Hydra/TermAdaptersSpec.hs 
@@ -1,294 +0,0 @@-module Hydra.TermAdaptersSpec where--import Hydra.Kernel-import Hydra.TermAdapters-import Hydra.AdapterUtils-import Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types-import Hydra.Dsl.Tests--import Hydra.TestData-import Hydra.TestUtils--import qualified Test.Hspec as H-import qualified Data.Map as M-import qualified Test.QuickCheck as QC-import qualified Data.Set as S-import qualified Data.Maybe as Y---constraintsAreAsExpected :: H.SpecWith ()-constraintsAreAsExpected = H.describe "Verify that the language constraints include/exclude the appropriate types" $ do--    H.it "int16 and int32 are supported in the test context" $ do-      typeIsSupported (context [TypeVariantLiteral]) Types.int16 `H.shouldBe` True-      typeIsSupported (context [TypeVariantLiteral]) Types.int32 `H.shouldBe` True--    H.it "int8 and bigint are unsupported in the test context" $ do-      typeIsSupported (context [TypeVariantLiteral]) Types.int8 `H.shouldBe` False-      typeIsSupported (context [TypeVariantLiteral]) Types.bigint `H.shouldBe` False--    H.it "Records are supported, but unions are not" $ do-      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) testTypeLatLon `H.shouldBe` True-      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord]) stringOrIntType `H.shouldBe` False--    H.it "Records are supported if and only if each of their fields are supported" $ do-      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])-        (TypeRecord $ RowType (Name "Example") [Types.field "first" Types.string, Types.field "second" Types.int16])-        `H.shouldBe` True-      typeIsSupported (context [TypeVariantLiteral, TypeVariantRecord])-        (TypeRecord $ RowType (Name "Example") [Types.field "first" Types.string, Types.field "second" Types.int8])-        `H.shouldBe` False--    H.it "Lists are supported if the list element type is supported" $ do-      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfStringsType `H.shouldBe` True-      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfListsOfStringsType `H.shouldBe` True-      typeIsSupported (context [TypeVariantLiteral, TypeVariantList]) listOfSetOfStringsType `H.shouldBe` False--  where-    context = languageConstraints . adapterContextLanguage . termTestContext--supportedConstructorsAreUnchanged :: H.SpecWith ()-supportedConstructorsAreUnchanged = H.describe "Verify that supported term constructors are unchanged" $ do--  H.it "Strings (and other supported literal values) pass through without change" $-    QC.property $ \b -> checkDataAdapter-      [TypeVariantLiteral]-      Types.string-      Types.string-      False-      (string b)-      (string b)--  H.it "Lists (when supported) pass through without change" $-    QC.property $ \strings -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantList]-      listOfStringsType-      listOfStringsType-      False-      (list $ string <$> strings)-      (list $ string <$> strings)--  H.it "Maps (when supported) pass through without change" $-    QC.property $ \keyvals -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantMap]-      mapOfStringsToIntsType-      mapOfStringsToIntsType-      False-      (makeMap keyvals)-      (makeMap keyvals)--  H.it "Optionals (when supported) pass through without change" $-    QC.property $ \mi -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantOptional]-      optionalInt8Type-      optionalInt16Type-      False-      (optional $ int8 <$> mi)-      (optional $ int16 . fromIntegral <$> mi)--  H.it "Records (when supported) pass through without change" $-    QC.property $ \a1 a2 -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantRecord]-      (TypeRecord $ RowType testTypeName [Types.field "first" Types.string, Types.field "second" Types.int8])-      (TypeRecord $ RowType testTypeName [Types.field "first" Types.string, Types.field "second" Types.int16])-      False-      (record testTypeName [field "first" $ string a1, field "second" $ int8 a2])-      (record testTypeName [field "first" $ string a1, field "second" $ int16 $ fromIntegral a2])--  H.it "Unions (when supported) pass through without change" $-    QC.property $ \int -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantUnion]-      stringOrIntType-      stringOrIntType-      False-      (variant stringOrIntName (Name "right") $ int32 int)-      (variant stringOrIntName (Name "right") $ int32 int)--  H.it "Sets (when supported) pass through without change" $-    QC.property $ \strings -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantSet]-      setOfStringsType-      setOfStringsType-      False-      (stringSet strings)-      (stringSet strings)--  H.it "Primitive function references (when supported) pass through without change" $-    QC.property $ \name -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantFunction]-      concatType-      concatType-      False-      (primitive name)-      (primitive name)--  H.it "Projections (when supported) pass through without change" $-    QC.property $ \fname -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantFunction, TypeVariantRecord]-      exampleProjectionType-      exampleProjectionType-      False-      (project testTypePersonName fname)-      (project testTypePersonName fname)--unsupportedConstructorsAreModified :: H.SpecWith ()-unsupportedConstructorsAreModified = H.describe "Verify that unsupported term constructors are changed in the expected ways" $ do--  H.it "Sets (when unsupported) become lists" $-    QC.property $ \strings -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantList]-      setOfStringsType-      listOfStringsType-      False-      (stringSet strings)-      (stringList $ S.toList strings)--  H.it "Optionals (when unsupported) become lists" $-    QC.property $ \ms -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantList]-      (Types.optional Types.string)-      (Types.list Types.string)-      False-      (optional $ string <$> ms)-      (list $ Y.maybe [] (\s -> [string s]) ms)--  H.it "Primitive function references (when unsupported) become variant terms" $-    QC.property $ \name -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]-      concatType-      (functionProxyType Types.string)-      False-      (primitive name)-      (inject functionProxyName $ field "primitive" $ string $ unName name) -- Note: the function name is not dereferenced--  H.it "Projections (when unsupported) become variant terms" $-    QC.property $ \fname -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantUnion, TypeVariantRecord]-      exampleProjectionType-      (functionProxyType testTypePerson)-      False-      (project testTypePersonName fname)-      (inject functionProxyName $ field "record" $ string $-        show (project testTypePersonName fname :: Term)) -- Note: the field name is not dereferenced----  H.it "Nominal types (when unsupported) are dereferenced" $---    QC.property $ \s -> checkDataAdapter---      [TypeVariantLiteral, TypeVariantAnnotated]---      testTypeStringAlias---      (TypeAnnotated $ Annotated Types.string $ Kv $---        M.fromList [(key_description, Terms.string "An alias for the string type")])---      False---      (string s)---      (string s)--  H.it "Unions (when unsupported) become records" $-    QC.property $ \i -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantOptional, TypeVariantRecord]-      eitherStringOrInt8Type-      (TypeRecord $ RowType eitherStringOrInt8TypeName [-        Types.field "left" $ Types.optional Types.string,-        Types.field "right" $ Types.optional Types.int16])-      False-      (inject eitherStringOrInt8TypeName $ field "right" $ int8 i)-      (record eitherStringOrInt8TypeName [-        field "left" $ optional Nothing,-        field "right" $ optional $ Just $ int16 $ fromIntegral i])--termsAreAdaptedRecursively :: H.SpecWith ()-termsAreAdaptedRecursively = H.describe "Verify that the adapter descends into subterms and transforms them appropriately" $ do--  H.it "A list of int8's becomes a list of int32's" $-    QC.property $ \ints -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantList]-      listOfInt8sType-      listOfInt16sType-      False-      (list $ int8 <$> ints)-      (list $ int16 . fromIntegral <$> ints)--  H.it "A list of sets of strings becomes a list of lists of strings" $-    QC.property $ \lists -> checkDataAdapter-      [TypeVariantLiteral, TypeVariantList]-      listOfSetOfStringsType-      listOfListsOfStringsType-      False-      (list $ (\l -> set $ S.fromList $ string <$> l) <$> lists)-      (list $ (\l -> list $ string <$> S.toList (S.fromList l)) <$> lists)--roundTripsPreserveSelectedTypes :: H.SpecWith ()-roundTripsPreserveSelectedTypes = H.describe "Verify that the adapter is information preserving, i.e. that round-trips are no-ops" $ do--  H.it "Check strings (pass-through)" $-    QC.property $ \s -> roundTripIsNoop Types.string (string s)--  H.it "Check lists (pass-through)" $-    QC.property $ \strings -> roundTripIsNoop listOfStringsType (list $ string <$> strings)--  H.it "Check sets (which map to lists)" $-    QC.property $ \strings -> roundTripIsNoop setOfStringsType (stringSet strings)--  H.it "Check primitive function references (which map to variants)" $-    QC.property $ \name -> roundTripIsNoop concatType (primitive name)--  H.it "Check projection terms (which map to variants)" $-    QC.property $ \fname -> roundTripIsNoop exampleProjectionType (project testTypePersonName fname)--  H.it "Check nominally typed terms (which pass through as instances of the aliased type)" $-    QC.property $ \s -> roundTripIsNoop testTypeStringAlias (wrap testTypeStringAliasName $ string s)----roundTripsPreserveArbitraryTypes :: H.SpecWith ()---roundTripsPreserveArbitraryTypes = H.describe "Verify that the adapter is information preserving for arbitrary typed terms" $ do------  H.it "Check arbitrary type/term pairs" $---    QC.property $ \(TypedTerm term typ) -> roundTripIsNoop typ term--fieldAdaptersAreAsExpected :: H.SpecWith ()-fieldAdaptersAreAsExpected = H.describe "Check that field adapters are as expected" $ do--  H.it "An int8 field becomes an int16 field" $-    QC.property $ \i -> checkFieldAdapter-      [TypeVariantLiteral, TypeVariantRecord]-      (Types.field "second" Types.int8)-      (Types.field "second" Types.int16)-      False-      (field "second" $ int8 i)-      (field "second" $ int16 $ fromIntegral i)--roundTripIsNoop :: Type -> Term -> H.Expectation-roundTripIsNoop typ term = shouldSucceedWith-   (step coderEncode term >>= step coderDecode)-   term-  where-    step = adapt typ--    -- Use a YAML-like language (but supporting unions) as the default target language-    testLanguage = Language (LanguageName "hydra/test") $ LanguageConstraints {-      languageConstraintsEliminationVariants = S.empty, -- S.fromList eliminationVariants,-      languageConstraintsLiteralVariants = S.fromList [-        LiteralVariantBoolean, LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString],-      languageConstraintsFloatTypes = S.fromList [FloatTypeBigfloat],-      languageConstraintsFunctionVariants = S.empty,-      languageConstraintsIntegerTypes = S.fromList [IntegerTypeBigint],-      languageConstraintsTermVariants = S.fromList termVariants,-      languageConstraintsTypeVariants = S.fromList [-        TypeVariantAnnotated, TypeVariantLiteral, TypeVariantList, TypeVariantMap, TypeVariantRecord, TypeVariantUnion],-      languageConstraintsTypes = \typ -> case stripType typ of-        TypeOptional (TypeOptional _) -> False-        _ -> True }--    -- Note: in a real application, you wouldn't create the adapter just to use it once;-    --       it should be created once, then applied to many terms.-    adapt typ dir term = do-      adapter <- languageAdapter testLanguage typ-      dir (adapterCoder adapter) term--spec :: H.Spec-spec = do-  constraintsAreAsExpected-  supportedConstructorsAreUnchanged-  unsupportedConstructorsAreModified-  termsAreAdaptedRecursively-  roundTripsPreserveSelectedTypes---  roundTripsPreserveArbitraryTypes -- TODO: restore me-  fieldAdaptersAreAsExpected
src/test/haskell/Hydra/TestData.hs view
@@ -2,7 +2,7 @@  import Hydra.Kernel import Hydra.Dsl.Terms-import Hydra.TestGraph+import Hydra.Staging.TestGraph import qualified Hydra.Dsl.Terms as Terms import qualified Hydra.Dsl.Types as Types
− src/test/haskell/Hydra/TestGraph.hs 
@@ -1,217 +0,0 @@-module Hydra.TestGraph (-  module Hydra.TestGraph,-  module Hydra.Sources.Libraries,-) where--import Hydra.Kernel-import Hydra.Sources.Libraries-import Hydra.Dsl.Terms-import Hydra.Sources.Core-import Hydra.Dsl.Annotations as Ann-import Hydra.Dsl.Bootstrap-import qualified Hydra.Dsl.Types as Types--import qualified Data.Map  as M-import qualified Data.Set  as S-import qualified Hydra.Dsl.Terms as Terms---testTypeLatLonName :: Name-testTypeLatLonName = Name "LatLon"--testTypeLatLonPolyName :: Name-testTypeLatLonPolyName = Name "LatLonPoly"--latlonRecord :: Float -> Float -> Term-latlonRecord lat lon = record testTypeLatLonName [Field (Name "lat") $ float32 lat, Field (Name "lon") $ float32 lon]--testTypeLatLon :: Type-testTypeLatLon = TypeRecord $ RowType testTypeLatLonName [Types.field "lat" Types.float32, Types.field "lon" Types.float32]--testTypeLatLonPoly :: Type-testTypeLatLonPoly = TypeLambda $ LambdaType (Name "a") $-  TypeRecord $ RowType testTypeLatLonPolyName [Types.field "lat" $ Types.var "a", Types.field "lon" $ Types.var "a"]--testTypeStringAlias :: Type-testTypeStringAlias = TypeWrap $ WrappedType testTypeStringAliasName Types.string--testTypeStringAliasName :: Name-testTypeStringAliasName = Name "StringTypeAlias"--testElementArthur :: Element-testElementArthur = Element {-  elementName = Name "ArthurDent",-  elementData = testDataArthur}--testElementFirstName :: Element-testElementFirstName = Element {-  elementName = Name "firstName",-  elementData = project testTypePersonName $ Name "firstName"}--testGraph :: Graph-testGraph = elementsToGraph hydraCore (Just testSchemaGraph) [testElementArthur, testElementFirstName]--testNamespace :: Namespace-testNamespace = Namespace "testGraph"--testSchemaGraph :: Graph-testSchemaGraph = elementsToGraph hydraCore (Just hydraCore) [-    def testTypeBuddyListAName testTypeBuddyListA,-    def testTypeBuddyListBName testTypeBuddyListB,-    def testTypeComparisonName testTypeComparison,-    def testTypeFoobarValueName testTypeFoobarValue,-    def testTypeIntListName testTypeIntList,-    def testTypeHydraLiteralTypeName testTypeHydraLiteralType,-    def testTypeHydraTypeName testTypeHydraType,-    def testTypeLatLonName testTypeLatLon,-    def testTypeLatLonPolyName testTypeLatLonPoly,-    def testTypeListName testTypeList,-    def testTypeNumberName testTypeNumber,-    def testTypePersonName testTypePerson,-    def testTypePersonOrSomethingName testTypePersonOrSomething,-    def testTypeSimpleNumberName testTypeSimpleNumber,-    def testTypeStringAliasName $ Ann.doc "An alias for the string type" testTypeStringAlias,-    def testTypeTimestampName testTypeTimestamp,-    def testTypeUnionMonomorphicName testTypeUnionMonomorphic,-    def testTypeUnionPolymorphicRecursiveName testTypeUnionPolymorphicRecursive]-  where-    def = typeElement--testSchemaNamespace :: Namespace-testSchemaNamespace = Namespace "testSchemaGraph"--testDataArthur :: Term-testDataArthur = record testTypePersonName [-  Field (Name "firstName") $ string "Arthur",-  Field (Name "lastName") $ string "Dent",-  Field (Name "age") $ int32 42]--testTypeBuddyListA :: Type-testTypeBuddyListA = Types.lambda "a" $ TypeRecord $ RowType testTypeBuddyListAName [-  Types.field "head" $ Types.var "a",-  Types.field "tail" $ Types.optional $ Types.apply (TypeVariable testTypeBuddyListBName) (Types.var "a")]--testTypeBuddyListAName :: Name-testTypeBuddyListAName = Name "BuddyListA"--testTypeBuddyListB :: Type-testTypeBuddyListB = Types.lambda "a" $ TypeRecord $ RowType testTypeBuddyListBName [-  Types.field "head" $ Types.var "a",-  Types.field "tail" $ Types.optional $ Types.apply (TypeVariable testTypeBuddyListAName) (Types.var "a")]--testTypeBuddyListBName :: Name-testTypeBuddyListBName = Name "BuddyListB"---testTypeComparison :: Type-testTypeComparison = TypeUnion $ RowType testTypeComparisonName [-  Types.field "lessThan" Types.unit,-  Types.field "equalTo" Types.unit,-  Types.field "greaterThan" Types.unit]--testTypeComparisonName :: Name-testTypeComparisonName = Name "Comparison"---- TODO: remove-testTypeFoobarValue :: Type-testTypeFoobarValue = TypeUnion $ RowType testTypeFoobarValueName [-  Types.field "bool" Types.boolean,-  Types.field "string" Types.string,-  Types.field "unit" Types.unit]-testTypeFoobarValueName :: Name-testTypeFoobarValueName = Name "FoobarValue"--testTypeIntList :: Type-testTypeIntList = TypeRecord $ RowType testTypeIntListName [-  Types.field "head" $ Types.int32,-  Types.field "tail" $ Types.optional $ TypeVariable testTypeIntListName]--testTypeIntListName :: Name-testTypeIntListName = Name "IntList"--testTypeHydraLiteralType :: Type-testTypeHydraLiteralType = Ann.doc "An approximation of Hydra's LiteralType type" $-  TypeUnion $ RowType testTypeHydraLiteralTypeName [---    Types.field "boolean" Types.unit,---    Types.field "string" Types.unit]-    Types.field "boolean" Types.string,-    Types.field "string" Types.string]--testTypeHydraLiteralTypeName :: Name-testTypeHydraLiteralTypeName = Name "HydraLiteralType"--testTypeHydraType :: Type-testTypeHydraType = Ann.doc "An approximation of Hydra's Type type" $-  TypeUnion $ RowType testTypeHydraTypeName [-    Types.field "literal" $ TypeVariable testTypeHydraLiteralTypeName,-    Types.field "list" $ TypeVariable testTypeHydraTypeName]--testTypeHydraTypeName :: Name-testTypeHydraTypeName = Name "HydraType"--testTypeList :: Type-testTypeList = Types.lambda "a" $ TypeRecord $ RowType testTypeListName [-  Types.field "head" $ Types.var "a",-  Types.field "tail" $ Types.optional $ Types.apply (TypeVariable testTypeListName) (Types.var "a")]--testTypeListName :: Name-testTypeListName = Name "List"--testTypeNumber :: Type-testTypeNumber = TypeUnion $ RowType testTypeNumberName [-  Types.field "int" Types.int32,-  Types.field "float" Types.float32]--testTypeNumberName :: Name-testTypeNumberName = Name "Number"--testTypePerson :: Type-testTypePerson = TypeRecord $ RowType testTypePersonName [-  Types.field "firstName" Types.string,-  Types.field "lastName" Types.string,-  Types.field "age" Types.int32]--testTypePersonName :: Name-testTypePersonName = Name "Person"--testTypePersonOrSomething :: Type-testTypePersonOrSomething = Types.lambda "a" $ TypeUnion $ RowType testTypePersonOrSomethingName [-  Types.field "person" testTypePerson,-  Types.field "other" $ Types.var "a"]--testTypePersonOrSomethingName :: Name-testTypePersonOrSomethingName = Name "PersonOrSomething"--testTypeSimpleNumberName :: Name-testTypeSimpleNumberName = Name "SimpleNumber"--testTypeSimpleNumber :: Type-testTypeSimpleNumber = TypeUnion $ RowType testTypeSimpleNumberName [-  Types.field "int" Types.int32,-  Types.field "float" Types.float32]--testTypeTimestamp :: Type-testTypeTimestamp = TypeUnion $ RowType testTypeTimestampName [-  FieldType (Name "unixTimeMillis") Types.uint64,-  FieldType (Name "date") Types.string]--testTypeTimestampName :: Name-testTypeTimestampName = Name "Timestamp"--testTypeUnionMonomorphic :: Type-testTypeUnionMonomorphic = TypeUnion $ RowType testTypeUnionMonomorphicName [-  Types.field "bool" Types.boolean,-  Types.field "string" Types.string,-  Types.field "unit" Types.unit]--testTypeUnionMonomorphicName :: Name-testTypeUnionMonomorphicName = Name "UnionMonomorphic"--testTypeUnionPolymorphicRecursive :: Type-testTypeUnionPolymorphicRecursive = Types.lambda "a" $ TypeUnion $ RowType testTypeUnionPolymorphicRecursiveName [-  Types.field "bool" Types.boolean,-  Types.field "value" $ Types.var "a",-  Types.field "other" $ Types.apply (TypeVariable testTypeUnionPolymorphicRecursiveName) (Types.var "a")]--testTypeUnionPolymorphicRecursiveName :: Name-testTypeUnionPolymorphicRecursiveName = Name "UnionPolymorphicRecursive"
src/test/haskell/Hydra/TestSuiteSpec.hs view
@@ -1,44 +1,66 @@+{-+stack ghci hydra:lib hydra:hydra-test++Test.Hspec.hspec Hydra.TestSuiteSpec.spec+-}+ module Hydra.TestSuiteSpec where  import Hydra.Kernel-import qualified Hydra.Dsl.Terms as Terms import Hydra.TestUtils import Hydra.Testing-+import Hydra.Inference import Hydra.Test.TestSuite+import qualified Hydra.Show.Core as ShowCore+import qualified Hydra.Dsl.Testing as Testing  import qualified Control.Monad as CM import qualified Test.Hspec as H+import qualified Test.HUnit.Lang as HL import qualified Test.QuickCheck as QC import qualified Data.List as L import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Maybe as Y  -runTestSuite :: H.SpecWith ()-runTestSuite = do-    runTestGroup allTests+type TestRunner = String -> TestCaseWithMetadata -> Y.Maybe H.Expectation -runTestCase :: Int -> TestCase -> H.SpecWith ()-runTestCase idx tc = H.it desc $-  shouldSucceedWith-    (eval $ testCaseInput tc)-    (testCaseOutput tc)+defaultTestRunner :: TestRunner+defaultTestRunner desc tcase = if Testing.isDisabled tcase+  then Nothing+  else Just $ case testCaseWithMetadataCase tcase of+    TestCaseCaseConversion (CaseConversionTestCase fromConvention toConvention fromString toString) -> H.shouldBe+      (convertCase fromConvention toConvention fromString)+      toString+    TestCaseEvaluation (EvaluationTestCase _ input output) -> shouldSucceedWith+      (eval input)+      output+    TestCaseInference (InferenceTestCase input output) -> expectInferenceResult desc input output+    TestCaseInferenceFailure (InferenceFailureTestCase input) -> expectInferenceFailure desc input   where-    desc = Y.fromMaybe ("test #" ++ show idx) $ testCaseDescription tc+    cx = fromFlow emptyInferenceContext () $ graphToInferenceContext testGraph -runTestGroup :: TestGroup -> H.SpecWith ()-runTestGroup tg = do+runTestCase :: String -> TestRunner -> TestCaseWithMetadata -> H.SpecWith ()+runTestCase pdesc runner tcase@(TestCaseWithMetadata name _ mdesc _) = case runner cdesc tcase of+    Nothing -> return ()+    Just e -> H.it desc e+  where+    desc = name ++ Y.maybe ("") (\d -> ": " ++ d) mdesc+    cdesc = if L.null pdesc then desc else pdesc ++ ", " ++ desc++runTestGroup :: String -> TestRunner -> TestGroup -> H.SpecWith ()+runTestGroup pdesc runner tg = do     H.describe desc $ do-      CM.sequence (L.zipWith runTestCase [1..] (testGroupCases tg))-      -      CM.sequence (runTestGroup <$> (testGroupSubgroups tg))+      CM.mapM (runTestCase cdesc runner) $ testGroupCases tg+      CM.sequence (runTestGroup cdesc runner <$> (testGroupSubgroups tg))       return ()   where-    desc = testGroupName tg ++ case testGroupDescription tg of+    desc = testGroupName tg ++ descSuffix+    cdesc = if L.null pdesc then desc else pdesc ++ ", " ++ desc+    descSuffix = case testGroupDescription tg of       Nothing -> ""       Just d -> " (" ++ d ++ ")"  spec :: H.Spec-spec = do-  runTestSuite+spec = runTestGroup "" defaultTestRunner allTests
src/test/haskell/Hydra/TestUtils.hs view
@@ -1,27 +1,16 @@ module Hydra.TestUtils (-  check,-  checkLiteralAdapter,-  checkFieldAdapter,-  checkFloatAdapter,-  checkIntegerAdapter,-  checkDataAdapter,-  checkSerdeRoundTrip,-  checkSerialization,-  eval,-  shouldFail,-  shouldSucceedWith,-  strip,-  termTestContext,-  module Hydra.TestGraph,+  module Hydra.TestUtils,+  module Hydra.Staging.TestGraph, ) where  import Hydra.Kernel-import Hydra.LiteralAdapters-import Hydra.TermAdapters-import Hydra.AdapterUtils--import Hydra.TestGraph+import Hydra.Adapt.Literals+import Hydra.Adapt.Terms+import Hydra.Adapt.Utils+import Hydra.Staging.TestGraph import Hydra.ArbitraryCore()+import qualified Hydra.Dsl.Terms as Terms+import qualified Hydra.Show.Core as ShowCore  import qualified Test.Hspec as H import qualified Test.HUnit.Lang as HL@@ -33,7 +22,7 @@   baseLanguage :: Language-baseLanguage = hydraCoreLanguage+baseLanguage = hydraLanguage  baseContext :: AdapterContext baseContext = AdapterContext testGraph baseLanguage M.empty@@ -68,12 +57,17 @@ checkLiteralAdapter = checkAdapter id literalAdapter context   where     context variants = withConstraints $ (languageConstraints baseLanguage) {-        languageConstraintsLiteralVariants = S.fromList variants,+        languageConstraintsLiteralVariants = variantSet,         languageConstraintsFloatTypes = floatVars,         languageConstraintsIntegerTypes = integerVars }       where-        floatVars = S.fromList [FloatTypeFloat32]-        integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32]+        variantSet = S.fromList variants+        floatVars = if (S.member LiteralVariantFloat variantSet)+          then S.fromList [FloatTypeFloat32]+          else S.empty+        integerVars = if (S.member LiteralVariantInteger variantSet)+          then S.fromList [IntegerTypeInt16, IntegerTypeInt32]+          else S.empty  checkFieldAdapter :: [TypeVariant] -> FieldType -> FieldType -> Bool -> Field -> Field -> H.Expectation checkFieldAdapter = checkAdapter id fieldAdapter termTestContext@@ -91,7 +85,7 @@       languageConstraintsIntegerTypes = S.fromList variants }  checkDataAdapter :: [TypeVariant] -> Type -> Type -> Bool -> Term -> Term -> H.Expectation-checkDataAdapter = checkAdapter stripTerm termAdapter termTestContext+checkDataAdapter = checkAdapter deannotateTerm termAdapter termTestContext  checkSerdeRoundTrip :: (Type -> Flow Graph (Coder Graph Graph Term BS.ByteString))   -> TypedTerm -> H.Expectation@@ -99,8 +93,8 @@     case mserde of       Nothing -> HL.assertFailure (traceSummary trace)       Just serde -> shouldSucceedWith-        (stripTerm <$> (coderEncode serde term >>= coderDecode serde))-        (stripTerm term)+        (deannotateTerm <$> (coderEncode serde term >>= coderDecode serde))+        (deannotateTerm term)   where     FlowState mserde _ trace = unFlow (mkSerde typ) testGraph emptyTrace @@ -117,8 +111,55 @@     FlowState mserde _ trace = unFlow (mkSerdeStr typ) testGraph emptyTrace  eval :: Term -> Flow Graph Term-eval = reduceTerm True M.empty+eval = reduceTerm True +expectFailure :: (a -> String) -> String -> Flow () a -> H.Expectation+expectFailure print desc f = case my of+    Nothing -> return ()+    Just v -> HL.assertFailure $ "Failure case succeeded with " ++ print v ++ "\n" ++ traceSummary trace+  where+    FlowState my _ trace = unFlow f2 () emptyTrace+    f2 = do+      putAttr key_debugId $ Terms.string desc+      f++expectInferenceFailure :: String -> Term -> H.Expectation+expectInferenceFailure desc term = expectFailure (ShowCore.typeScheme . snd) desc $ do+  cx <- graphToInferenceContext testGraph+  inferTypeOf cx term++expectInferenceResult :: String -> Term -> TypeScheme -> H.Expectation+expectInferenceResult desc term expected = do+    expectSuccess desc (ShowCore.typeScheme . snd <$> result) (ShowCore.typeScheme expected)+    expectSuccess desc (ShowCore.term . removeTypesFromTerm . fst <$> result) (ShowCore.term $ removeTypesFromTerm term)+  where+    result = do+      cx <- graphToInferenceContext testGraph+      inferTypeOf cx term++expectSuccess :: (Eq a, Show a) => String -> Flow () a -> a -> H.Expectation+expectSuccess desc f x = case my of+    Nothing -> HL.assertFailure $ traceSummary trace+    Just y -> y `H.shouldBe` x+  where+    FlowState my _ trace = unFlow f2 () emptyTrace+    f2 = do+      putAttr key_debugId $ Terms.string desc+      f++expectTypeOfResult :: String -> M.Map Name Type -> Term -> Type -> H.Expectation+expectTypeOfResult desc types term expected = do+    expectSuccess desc (ShowCore.type_ <$> result) (ShowCore.type_ expected)+  where+    result = do+      cx <- graphToInferenceContext testGraph++      -- typeOf is always called on System F terms+      (iterm, ts) <- inferTypeOf cx term+      let vars = S.fromList $ typeSchemeVariables ts++      typeOfInternal cx vars types [] iterm+ shouldFail :: Flow Graph a -> H.Expectation shouldFail f = H.shouldBe True (Y.isNothing $ flowStateValue $ unFlow f testGraph emptyTrace) @@ -137,7 +178,7 @@     FlowState my _ trace = unFlow f testGraph emptyTrace  strip :: Term -> Term-strip = stripTerm+strip = deannotateTerm  termTestContext :: [TypeVariant] -> AdapterContext termTestContext variants = withConstraints $ (languageConstraints baseLanguage) {@@ -148,7 +189,7 @@   where     literalVars = S.fromList [LiteralVariantFloat, LiteralVariantInteger, LiteralVariantString]     floatVars = S.fromList [FloatTypeFloat32]-    integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32]+    integerVars = S.fromList [IntegerTypeInt16, IntegerTypeInt32, IntegerTypeBigint]  withConstraints :: LanguageConstraints -> AdapterContext withConstraints c = baseContext { adapterContextLanguage = baseLanguage { languageConstraints = c }}
− src/test/haskell/Hydra/Tier1Spec.hs 
@@ -1,50 +0,0 @@-module Hydra.Tier1Spec where--import Hydra.Kernel--import Hydra.TestUtils-import qualified Hydra.Dsl.Terms as Terms-import qualified Hydra.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Test.QuickCheck as QC-import qualified Data.Char as C-import qualified Data.List as L-import qualified Data.Map as M-import qualified Data.Maybe as Y---checkFoldOverTerm :: H.SpecWith ()-checkFoldOverTerm = do-  H.describe "Test foldOverTerm" $ do-    H.describe "Pre-order" $ do-      H.it "test #1" $-        H.shouldBe-          (traverse TraversalOrderPre node1)-          ["a"]-      H.it "test #2" $-        H.shouldBe-          (traverse TraversalOrderPre node2)-          ["a", "b", "c", "d"]-    H.describe "Post-order" $ do-      H.it "test #1" $-        H.shouldBe-          (traverse TraversalOrderPost node1)-          ["a"]-      H.it "test #1" $-        H.shouldBe-          (traverse TraversalOrderPost node2)-          ["b", "d", "c", "a"]-  where-    node label children = Terms.pair (Terms.string label) (Terms.list children)-    labelOf term = case term of-      TermProduct [TermLiteral (LiteralString label), _] -> Just label-      _ -> Nothing-    traverse :: TraversalOrder -> Term -> [String]-    traverse order = Y.catMaybes . foldOverTerm order (\l t -> l ++ [labelOf t]) []-    node1 = node "a" []-    node2 = node "a" [node "b" [], node "c" [node "d" []]]--spec :: H.Spec-spec = do-  checkFoldOverTerm
− src/test/haskell/Hydra/Tools/SerializationSpec.hs 
@@ -1,113 +0,0 @@-module Hydra.Tools.SerializationSpec where--import qualified Test.Hspec as H--import Hydra.Ast-import Hydra.Tools.Serialization-import Hydra.Ext.Haskell.Operators---check :: Expr -> String -> H.Expectation-check expr printed = printExpr (parenthesize expr) `H.shouldBe` printed--cases :: Expr -> [(Expr, Expr)] -> Expr-cases cond cases = ifx ofOp lhs rhs-  where-    lhs = spaceSep [cst "case", cond]-    rhs = newlineSep (uncurry (ifx caseOp) <$> cases)-    ofOp = Op (Symbol "of") (Padding WsSpace $ WsBreakAndIndent "  ") (Precedence 0) AssociativityNone--lam :: [String] -> Expr -> Expr-lam vars = ifx lambdaOp $ cst $ "\\" ++ unwords vars--checkAssociativity :: H.SpecWith ()-checkAssociativity = do-  H.describe "Unit tests to verify that associativity is respected" $ do--    H.it "Right-associative operator" $ do-      check-        (ifx arrowOp (ifx arrowOp (cst "a") (cst "b")) (ifx arrowOp (cst "c") (cst "d")))-        "(a -> b) -> c -> d"--checkCaseStatements :: H.SpecWith ()-checkCaseStatements = do-  H.describe "Unit tests for case statements" $ do--    H.it "Simple case statement" $ do-      check-        (cases (ifx gtOp (cst "x") (num 42)) [(cst "False", cst "Big"), (cst "True", cst "Small")])-        (    "case x > 42 of\n"-          ++ "  False -> Big\n"-          ++ "  True -> Small")--    H.it "Nested case statement" $ do-      check-        (cases (ifx gtOp (cst "x") (num 42)) [-          (cst "True", cases (ifx gtOp (cst "x") (num 100)) [(cst "True", cst "ReallyBig"), (cst "False", cst "Big")]),-          (cst "False", cst "Small")])-        (    "case x > 42 of\n"-          ++ "  True -> case x > 100 of\n"-          ++ "    True -> ReallyBig\n"-          ++ "    False -> Big\n"-          ++ "  False -> Small")--checkLambdas :: H.SpecWith ()-checkLambdas = do-  H.describe "Unit tests for lambda expressions" $ do--    H.it "Simple lambda" $ do-      check-        (lam ["x", "y"] (ifx plusOp (cst "x") (cst "y")))-        "\\x y -> x + y"--checkLists :: H.SpecWith ()-checkLists = do-  H.describe "Unit tests for list expressions" $ do--    H.it "Empty list" $ do-      check-        (bracketList inlineStyle [])-        "[]"--    H.it "Simple non-empty list" $ do-      check-        (bracketList inlineStyle [num 1, num 2, num 3])-        "[1, 2, 3]"--    H.it "Nested list" $ do-      check-        (bracketList inlineStyle [bracketList inlineStyle [num 1, num 3], num 2])-        "[[1, 3], 2]"--    H.it "List with parenthesized expression inside" $ do-      check-        (bracketList inlineStyle [bracketList inlineStyle [num 1, ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10))], num 2])-        "[[1, (2 + 3) * (1 + 10)], 2]"--checkPrecedence :: H.SpecWith ()-checkPrecedence = do-  H.describe "Unit tests to verify that operator precedence is respected" $ do--    H.it "Check expressions with operators of different precedence" $ do-      check-        (ifx plusOp (ifx multOp (num 2) (num 3)) (ifx multOp (num 1) (num 10)))-        "2 * 3 + 1 * 10"-      check-        (ifx multOp (ifx plusOp (num 2) (num 3)) (ifx plusOp (num 1) (num 10)))-        "(2 + 3) * (1 + 10)"--    H.it "Check an operator which is both left- and right-associative" $ do-      check-        (ifx multOp (cst "x") (ifx multOp (cst "y") (cst "z")))-        "x * y * z"-      check-        (ifx multOp (ifx multOp (cst "x") (cst "y")) (cst "z"))-        "x * y * z"--spec :: H.Spec-spec = do-  checkAssociativity-  checkCaseStatements-  checkLambdas-  checkLists-  checkPrecedence
− src/test/haskell/Hydra/Tools/SortingSpec.hs 
@@ -1,145 +0,0 @@-module Hydra.Tools.SortingSpec where--import qualified Test.Hspec as H--import Hydra.Tools.Sorting---checkSort :: (Eq a, Ord a, Show a) => [(a, [a])] -> Either [[a]] [a] -> H.Expectation-checkSort adj exp = H.shouldBe (topologicalSort adj) exp--checkSortSCC :: (Eq a, Ord a, Show a) => [(a, [a])] -> [[a]] -> H.Expectation-checkSortSCC adj exp = H.shouldBe (topologicalSortComponents adj) exp--checkSortDiscreteSet :: H.SpecWith ()-checkSortDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do--  H.it "Empty set" $-    checkSort [] (Right [] :: Either [[Int]] [Int])--  H.it "Singleton set" $-    checkSort [(1, [])]-      (Right [1])--  H.it "Discrete set with multiple elements" $-    checkSort [(3, []), (1, []), (2, [])]-      (Right [3, 2, 1])--checkSortTreesAndDags :: H.SpecWith ()-checkSortTreesAndDags = H.describe "Check sorting of trees and DAGs" $ do--  H.it "Linked list" $-    checkSort [(3, [1]), (2, [3]), (1, [])]-      (Right [1, 3, 2])--  H.it "Binary tree" $-    checkSort [(3, [1, 4]), (4, [6, 2]), (1, [5]), (2, []), (6, []), (5, [])]-      (Right [6, 5, 2, 4, 1, 3])--  H.it "Two trees" $-    checkSort [(3, [1, 4]), (5, [6, 2]), (2, [7]), (1, []), (4, []), (6, []), (7, [])]-      (Right [7, 6, 4, 2, 5, 1, 3])--  H.it "Diamond (DAG)" $-    checkSort [(1, [3, 4]), (3, [2]), (4, [2]), (2, [5]), (5, [])]-      (Right [5, 2, 3, 4, 1])--checkSortCycles :: H.SpecWith ()-checkSortCycles = H.describe "Check that sorting of graphs with cycles fails" $ do--  H.it "Two-node cycle" $-    checkSort [(1, [2]), (2, [1])]-      (Left [[1, 2]])--  H.it "Cycle with incoming and outgoing edges" $-    checkSort [(1, [3]), (3, [2]), (2, [3, 4]), (4, [5]), (5, [])]-      (Left [[2, 3]])--checkSortSCCDiscreteSet :: H.SpecWith ()-checkSortSCCDiscreteSet = H.describe "Check sorting of discrete sets (no dependencies)" $ do--  H.it "Empty set" $-    checkSortSCC []-      ([] :: [[Int]])--  H.it "Singleton set" $-    checkSortSCC [(1, [])]-      [[1]]--  H.it "Discrete set with multiple elements" $-    checkSortSCC [(3, []), (1, []), (2, [])]-      [[3],[2],[1]]--checkSortSCCWeaklyConnectedComponents :: H.SpecWith ()-checkSortSCCWeaklyConnectedComponents = H.describe "Check weakly-connected components" $ do--  H.describe "Single, two-element component" $ do-    H.it "test #1" $-      checkSortSCC [(1, [2]), (2, [])]-        [[2], [1]]-    H.it "test #2" $-      checkSortSCC [(2, [1]), (1, [])]-        [[1], [2]]--  H.it "Multiple-element component" $ do-    checkSortSCC [(2, [1, 3]), (1, [3]), (3, [])]-      [[3], [1], [2]]--checkSortSCCStronglyConnectedComponents :: H.SpecWith ()-checkSortSCCStronglyConnectedComponents = H.describe "Check strongly-connected components" $ do--  H.describe "Cycle of two nodes" $ do-    H.it "test #1" $-      checkSortSCC [(1, [2]), (2, [1])]-        [[1, 2]]-    H.it "test #2" $-      checkSortSCC [(2, [1]), (1, [2])]-        [[1, 2]]--  H.describe "Cycle of three nodes, ordered naturally" $ do--    H.it "test #1" $-      checkSortSCC [(1, [2]), (2, [3]), (3, [1])]-        [[1, 2, 3]]-    H.it "test #2" $-      checkSortSCC [(2, [1]), (3, [2]), (1, [3])]-        [[1, 2, 3]]--  H.it "Multiple, disconnected cycles, each ordered naturally" $ do-    checkSortSCC-      ([(200, [])] ++ [(100, [])] ++ [(300, [])] ++ [(10, [20]), (20, [10])] ++ [(1, [2]), (2, [3]), (3, [1])])-      [[300], [200], [100], [10, 20], [1, 2, 3]]--  H.it "Complex cycles" $ do-    checkSortSCC [(1, [2, 3]), (2, [3]), (3, [1])]-      [[1, 2, 3]]--checkSortSCCMixed :: H.SpecWith ()-checkSortSCCMixed = H.describe "Check graphs which are a mix of weakly- and strongly-connected components" $ do--  H.it "Chain of three SCCs" $-    checkSortSCC-      [(1, [2, 10]), (2, [3]), (3, [1]), (10, [20]), (20, [100, 10]), (100, [])]-      [[100], [10, 20], [1, 2, 3]]--  H.it "SCCs with dependencies to/from non-SCC nodes" $-    checkSortSCC-      [(1, [2, 3, 10]), (2, [3]), (3, [1]),-       (10, [20, 30]), (20, [30]), (30, []),-       (100, [200, 2]), (200, []), (300, [100]),-       (1000, []),-       (2000, [])]-      [[2000], [1000], [200], [30], [20], [10], [1, 2, 3], [100], [300]]--spec :: H.Spec-spec = do-  H.describe "Check topological sort (without cycles)" $ do-    checkSortDiscreteSet-    checkSortTreesAndDags-    checkSortCycles--  H.describe "Check sorting of strongly connected components" $ do-    checkSortSCCDiscreteSet-    checkSortSCCWeaklyConnectedComponents-    checkSortSCCStronglyConnectedComponents-    checkSortSCCMixed
− src/test/haskell/Hydra/UnificationSpec.hs 
@@ -1,36 +0,0 @@-module Hydra.UnificationSpec where--import Hydra.Kernel-import Hydra.Unification-import Hydra.TestUtils-import qualified Hydra.Dsl.Types as Types--import qualified Test.Hspec as H-import qualified Data.Map as M---expectUnified :: [TypeConstraint] -> [(Name, Type)] -> H.Expectation-expectUnified constraints subst = shouldSucceedWith-  (solveConstraints constraints)-  (M.fromList subst)--checkIndividualConstraints :: H.SpecWith ()-checkIndividualConstraints = do-  H.describe "Check a few hand-crafted constraints" $ do--    H.it "Unify nothing" $-      expectUnified [] []--    H.it "Unify variable with variable" $-      expectUnified-        [TypeConstraint (Types.var "a") (Types.var "b") Nothing]-        [(Name "b", Types.var "a")]--    H.it "Unify variable with literal type" $-      expectUnified-        [TypeConstraint (Types.var "a") Types.string Nothing]-        [(Name "a", Types.string)]--spec :: H.Spec-spec = do-  checkIndividualConstraints
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-22.31+resolver: lts-24.7  packages:   - .