singletons-2.5.1/0000755000000000000000000000000007346545000012075 5ustar0000000000000000singletons-2.5.1/CHANGES.md0000755000000000000000000004756007346545000013506 0ustar0000000000000000Changelog for singletons project ================================ 2.5.1 ----- * `ShowSing` is now a type class (with a single instance) instead of a type synonym. This was changed because defining `ShowSing` as a type synonym prevents it from working well with recursive types due to an unfortunate GHC bug. For more information, see [issue #371](https://github.com/goldfirere/singletons/issues/371). * Add an `IsString` instance for `SomeSing`. 2.5 --- * The `Data.Promotion.Prelude.*` namespace has been removed. Use the corresponding modules in the `Data.Singletons.Prelude.*` namespace instead. * Fix a regression in which certain infix type families, such as `(++)`, `($)`, `(+)`, and others, did not have the correct fixities. * The default implementation of the `(==)` type in `PEq` was changed from `(Data.Type.Equality.==)` to a custom type family, `DefaultEq`. The reason for this change is that `(Data.Type.Equality.==)` is unable to conclude that `a == a` reduces to `True` for any `a`. (As a result, the previous version of `singletons` regressed in terms of type inference for the `PEq` instances for `Nat` and `Symbol`, which used that default.) On the other hand, `DefaultEq a a` _does_ reduce to `True` for all `a`. * Add `Enum Nat`, `Show Nat`, and `Show Symbol` instances to `Data.Singletons.TypeLits`. * Template Haskell-generated code may require `DataKinds` and `PolyKinds` in scenarios which did not previously require it: * `singletons` now explicitly quantifies all kind variables used in explicit `forall`s. * `singletons` now generates `a ~> b` instead of `TyFun a b -> Type` whenever possible. * Since `th-desugar` now desugars all data types to GADT syntax, Template Haskell-generated code may require `GADTs` in situations that didn't require it before. * Overhaul the way derived `Show` instances for singleton types works. Before, there was an awkward `ShowSing` class (which was essentially a cargo-culted version of `Show` specialized for `Sing`) that one had to create instances for separately. Now that GHC has `QuantifiedConstraints`, we can scrap this whole class and turn `ShowSing` into a simple type synonym: ```haskell type ShowSing k = forall z. Show (Sing (z :: k)) ``` Now, instead of generating a hand-written `ShowSing` and `Show` instance for each singleton type, we only generate a single (derived!) `Show` instance. As a result of this change, you will likely need to enable `QuantifiedConstraints` and `StandaloneDeriving` if you single any derived `Show` instances in your code. * The kind of the type parameter to `SingI` is no longer specified. This only affects you if you were using the `sing` method with `TypeApplications`. For instance, if you were using `sing @Bool @True` before, then you will now need to now use `sing @Bool` instead. * `singletons` now generates `SingI` instances for defunctionalization symbols through Template Haskell. As a result, you may need to enable `FlexibleInstances` in more places. * `genDefunSymbols` is now more robust with respect to types that use dependent quantification, such as: ```haskell type family MyProxy k (a :: k) :: Type where MyProxy k (a :: k) = Proxy a ``` See the documentation for `genDefunSymbols` for limitations to this. * Rename `Data.Singletons.TypeRepStar` to `Data.Singletons.TypeRepTYPE`, and generalize the `Sing :: Type -> Type` instance to `Sing :: TYPE rep -> Type`, allowing it to work over more open kinds. Also rename `SomeTypeRepStar` to `SomeTypeRepTYPE`, and change its definition accordingly. * Promoting or singling a type synonym or type family declaration now produces defunctionalization symbols for it. (Previously, promoting or singling a type synonym did nothing whatsoever, and promoting or singling a type family produced an error.) * `singletons` now produces fixity declarations for defunctionalization symbols when appropriate. * Add `(%<=?)`, a singled version of `(<=?)` from `GHC.TypeNats`, as well as defunctionalization symbols for `(<=?)`, to `Data.Singletons.TypeLits`. * Add `Data.Singletons.Prelude.{Semigroup,Monoid}`, which define promoted and singled versions of the `Semigroup` and `Monoid` type classes, as well as various newtype modifiers. `Symbol` is now has promoted `Semigroup` and `Monoid` instances as well. As a consequence, `Data.Singletons.TypeLits` no longer exports `(<>)` or `(%<>)`, as they are superseded by the corresponding methods from `PSemigroup` and `SSemigroup`. * Add promoted and singled versions of the `Functor`, `Foldable`, `Traversable`, `Applicative`, `Alternative`, `Monad`, `MonadPlus`, and `MonadZip` classes. Among other things, this grants the ability to promote or single `do`-notation and list comprehensions. * `Data.Singletons.Prelude.List` now reexports more general `Foldable`/`Traversable` functions wherever possible, just as `Data.List` does. * Add `Data.Singletons.Prelude.{Const,Identity}`, which define promoted and singled version of the `Const` and `Identity` data types, respectively. * Promote and single the `Down` newtype in `Data.Singletons.Prelude.Ord`. * To match the `base` library, the promoted/singled versions of `comparing` and `thenCmp` are no longer exported from `Data.Singletons.Prelude`. (They continue to live in `Data.Singletons.Prelude.Ord`.) * Permit singling of expression and pattern signatures. * Permit promotion and singling of `InstanceSigs`. * `sError` and `sUndefined` now have `HasCallStack` constraints, like their counterparts `error` and `undefined`. The promoted and singled counterparts to `errorWithoutStackTrace` have also been added in case you do not want this behavior. * Add `Data.Singletons.TypeError`, which provides a drop-in replacement for `GHC.TypeLits.TypeError` which can be used at both the value- and type-level. 2.4.1 ----- * Restore the `TyCon1`, `TyCon2`, etc. types. It turns out that the new `TyCon` doesn't work with kind-polymorphic tycons. 2.4 --- * Require GHC 8.4. * `Demote Nat` is now `Natural` (from `Numeric.Natural`) instead of `Integer`. In accordance with this change, `Data.Singletons.TypeLits` now exposes `GHC.TypeNats.natVal` (which returns a `Natural`) instead of `GHC.TypeLits.natVal` (which returns an `Integer`). * The naming conventions for infix identifiers (e.g., `(&*)`) have been overhauled. * Infix functions (that are not constructors) are no longer prepended with a colon when promoted to type families. For instance, the promoted version of `(&*)` is now called `(&*)` as well, instead of `(:&*)` as before. There is one exception to this rule: the `(.)` function, which is promoted as `(:.)`. The reason is that one cannot write `(.)` at the type level. * Singletons for infix functions are now always prepended with `%` instead of `%:`. * Singletons for infix classes are now always prepended with `%` instead of `:%`. * Singletons for infix datatypes are now always prepended with a `%`. (Before, there was an unspoken requirement that singling an infix datatype required that name to begin with a colon, and the singleton type would begin with `:%`. But now that infix datatype names can be things like `(+)`, this requirement became obsolete.) The upshot is that most infix names can now be promoted using the same name, and singled by simply prepending the name with `%`. * The suffix for defunctionalized names of symbolic functions (e.g., `(+)`) has changed. Before, the promoted type name would be suffixed with some number of dollar signs (e.g., `(+$)` and `(+$$)`) to indicate defunctionalization symbols. Now, the promoted type name is first suffixed with `@#@` and _then_ followed by dollar signs (e.g., `(+@#@$)` and `(+@#@$$)`). Adopting this conventional eliminates naming conflicts that could arise for functions that consisted of solely `$` symbols. * The treatment of `undefined` is less magical. Before, all uses of `undefined` would be promoted to `GHC.Exts.Any` and singled to `undefined`. Now, there is a proper `Undefined` type family and `sUndefined` singleton function. * As a consequence of not promoting `undefined` to `Any`, there is no need to have a special `any_` function to distinguish the function on lists. The corresponding promoted type, singleton function, and defunctionalization symbols are now named `Any`, `sAny`, and `AnySym{0,1,2}`. * Rework the treatment of empty data types: * Generated `SingKind` instances for empty data types now use `EmptyCase` instead of simply `error`ing. * Derived `PEq` instances for empty data types now return `True` instead of `False`. Derived `SEq` instances now return `True` instead of `error`ing. * Derived `SDecide` instances for empty data types now return `Proved bottom`, where `bottom` is a divergent computation, instead of `error`ing. * Add `Data.Singletons.Prelude.IsString` and `Data.Promotion.Prelude.IsString` modules. `IsString.fromString` is now used when promoting or singling string literals when the `-XOverloadedStrings` extension is enabled (similarly to how `Num.fromInteger` is currently used when promoting or singling numeric literals). * Add `Data.Singletons.Prelude.Void`. * Add promoted and singled versions of `div`, `mod`, `divMod`, `quot`, `rem`, and `quotRem` to `Data.Singletons.TypeLits` that utilize the efficient `Div` and `Mod` type families from `GHC.TypeNats`. Also add `sLog2` and defunctionalization symbols for `Log2` from `GHC.TypeNats`. * Add `(<>)` and `(%<>)`, the promoted and singled versions of `AppendSymbol` from `GHC.TypeLits`. * Add `(%^)`, the singleton version of `GHC.TypeLits.^`. * Add `unlines` and `unwords` to `Data.Singletons.Prelude.List`. * Add promoted and singled versions of `Show`, including `deriving` support. * Add a `ShowSing` class, which facilitates the ability to write `Show` instances for `Sing` instances. * Permit derived `Ord` instances for empty datatypes. * Permit standalone `deriving` declarations. * Permit `DeriveAnyClass` (through the `anyclass` keyword of `DerivingStrategies`) * Add a value-level `(@@)`, which is a synonym for `applySing`. * Add `Eq`, `Ord`, `Num`, `Enum`, and `Bounded` instances for `SomeSing`, which leverage the `SEq`, `SOrd`, `SNum`, `SEnum`, and `SBounded` instances, respectively, for the underlying `Sing`. * Rework the `Sing (a :: *)` instance in `Data.Singletons.TypeRepStar` such that it now uses type-indexed `Typeable`. The new `Sing` instance is now: ```haskell newtype instance Sing :: Type -> Type where STypeRep :: TypeRep a -> Sing a ``` Accordingly, the `SingKind` instance has also been changed: ```haskell instance SingKind Type where type Demote Type = SomeTypeRepStar ... data SomeTypeRepStar where SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStar ``` Aside from cleaning up some implementation details, this change assures that `toSing` can only be called on `TypeRep`s whose kind is of kind `*`. The previous implementation did not enforce this, which could lead to segfaults if used carelessly. * Instead of `error`ing, the `toSing` implementation in the `SingKind (k1 ~> k2)` instance now works as one would expect (provided the user adheres to some common-sense `SingKind` laws, which are now documented). * Add a `demote` function, which is a convenient shorthand for `fromSing sing`. * Add a `Data.Singletons.Sigma` module with a `Sigma` (dependent pair) data type. * Export defunctionalization symbols for `Demote`, `SameKind, `KindOf`, `(~>)`, `Apply`, and `(@@)` from `Data.Singletons`. * Add an explicitly bidirectional pattern synonym `Sing`. Pattern matching on `Sing` brings a `SingI ty` constraint into scope from a singleton `Sing ty`. * Add an explicitly bidirectional pattern synonym `FromSing`. Pattern matching on any demoted (base) type gives us the corresponding singleton. * Add explicitly bidirectional pattern synonyms `SLambda{2..8}`. Pattern matching on any defunctionalized singleton yields a term-level Haskell function on singletons. * Remove the family of `TyCon1`, `TyCon2`, ..., in favor of just `TyCon`. GHC 8.4's type system is powerful enough to allow this nice simplification. 2.3 --- * Documentation clarifiation in `Data.Singletons.TypeLits`, thanks to @ivan-m. * `Demote` was no longer a convenient way of calling `DemoteRep` and has been removed. `DemoteRep` has been renamed `Demote`. * `DemoteRep` is now injective. * Demoting a `Symbol` now gives `Text`. This is motivated by making `DemoteRep` injective. (If `Symbol` demoted to `String`, then there would be a conflict between demoting `[Char]` and `Symbol`.) * Generating singletons also now generates fixity declarations for the singletonized definitions, thanks to @int-index. * Though more an implementation detail: singletons no longer uses kind-level proxies anywhere, thanks again to @int-index. * Support for promoting higher-kinded type variables, thanks for @int-index. * `Data.Singletons.TypeLits` now exports defunctionalization symbols for `KnownNat` and `KnownSymbol`. * Better type inference support around constraints, as tracked in Issue #176. * Type synonym definitions are now ignored, as they should be. * `Show` instances for `SNat` and `SSymbol`, thanks to @cumber. * The `singFun` and `unSingFun` functions no longer use proxies, preferring `TypeApplications`. 2.2 --- * With `TypeInType`, we no longer kind `KProxy`. @int-index has very helpfully removed the use of `KProxy` from `singletons`. * Drop support for GHC 7.x. * Remove `bugInGHC`. That function was intended to work around GHC's difficulty in detecting exhaustiveness of GADT pattern matches. GHC 8 comes with a much better exhaustiveness checker, and so this function is no longer necessary. 2.1 --- * Require `th-desugar` >= 1.6 * Work with GHC 8. GHC 8 gives the opportunity to simplify some pieces of singletons, but these opportunities are not yet fully realized. For example, injective type families means that we no longer need `Sing` to be a data family; it could be a type family. This might drastically simplify the way functions are singletonized. But not yet! * `singletons` now outputs a few more type/kind annotations to help GHC do type inference. There may be a few more programs accepted than before. (This is the fix for #136.) 2.0.1 ----- * Lots more functions in `Data.Singletons.Prelude.List`: `filter`, `find`, `elemIndex`, `elemIndices`, `findIndex`, `findIndices`, `intersect`, `intersectBy`, `takeWhile`, `dropWhile`, `dropWhileEnd`, `span`, `break`, `take`, `drop`, `splitAt`, `group`, `maximum`, `minimum`, `insert`, `sort`, `groupBy`, `lookup`, `partition`, `sum`, `product`, `length`, `replicate`, `transpose`, `(!!)`, `nub`, `nubBy`, `unionBy`, `union`, `genericLength` 2.0.0.2 ------- * Fix fixity of `*`. 2.0.0.1 ------- * Make haddock work. 2.0 --- * Instance promotion now works properly -- it was quite buggy in 1.0. * Classes and instances can now be singletonized. * Limited support for functional dependencies. * We now have promoted and singletonized versions of `Enum`, as well as `Bounded`. * Deriving `Enum` is also now supported. * Ditto for `Num`, which includes an instance for `Nat`, naturally. * Promoting a literal number now uses overloaded literals at the type level, using a type-level `FromInteger` in the type-level `Num` class. * Better support for dealing with constraints. Some previously-unsingletonizable functions that have constrained parameters now work. * No more orphan `Quasi` instances! * Support for functions of arity 8 (instead of the old limit, 7). * Full support for fixity declarations. * A raft of bugfixes. * Drop support for GHC 7.8. You must have GHC 7.10.2. 1.1.2.1 ------- Fix bug #116, thus allowing locally-declared symbols to be used in GHC 7.10. 1.1.2 ----- * No more GHC 7.8.2 support -- you must have GHC 7.8.3. 1.1.1 ----- Update testsuite to work with th-desugar-1.5.2. No functional changes. 1.1 --- This is a maintenance release to support building (but *not* testing, due to GHC bug #10058) with 7.10. This release also targets th-desugar-1.5. Some types changed (using th-desugar's new `DsMonad` instead of `Quasi`), but clients generally won't need to make any changes, unless they, too, generalize over `Quasi`. 1.0 --- This is a complete rewrite of the package. * A much wider array of surface syntax is now accepted for promotion and singletonization, including `let`, `case`, partially-applied functions, and anonymous functions, `where`, sections, among others. * Classes and instances can be promoted (but not singletonized). * Derivation of promoted instances for `Ord` and `Bounded`. This release can be seen as a "technology preview". More features are coming soon. This version drops GHC 7.6 support. 0.10.0 ------ Template Haskell names are now more hygienic. In other words, `singletons` won't try to gobble up something happened to be named `Sing` in your project. (Note that the Template Haskell names are not *completely* hygienic; names generated during singleton generation can still cause conflicts.) If a function to be promoted or singletonized is missing a type signature, that is now an *error*, not a warning. Added a new external module Data.Singletons.TypeLits, which contain the singletons for GHC.TypeLits. Some convenience functions are also provided. The extension `EmptyCase` is no longer needed. This caused pain when trying to support both GHC 7.6.3 and 7.8. 0.9.3 ----- Fix export list of Data.Singletons.TH, again again. Add `SEq` instances for `Nat` and `Symbol`. 0.9.2 ----- Fix export list of Data.Singletons.TH, again. 0.9.1 ----- Fix export list of Data.Singletons.TH. 0.9.0 ----- Make compatible with GHC HEAD, but HEAD reports core lint errors sometimes. Change module structure significantly. If you want to derive your own singletons, you should import `Data.Singletons.TH`. The module `Data.Singletons` now exports functions only for the *use* of singletons. New modules `Data.Singletons.Bool`, `...Maybe`, `...Either`, and `...List` are just like their equivalents from `Data.`, except for `List`, which is quite lacking in features. For singleton equality, use `Data.Singletons.Eq`. For propositional singleton equality, use `Data.Singletons.Decide`. New module `Data.Singletons.Prelude` is meant to mirror the Haskell Prelude, but with singleton definitions. Streamline representation of singletons, resulting in *exponential* speedup at execution. (This has not been rigorously measured, but the data structures are now *exponentially* smaller.) Add internal support for TypeLits, because the TypeLits module no longer exports singleton definitions. Add support for existential singletons, through the `toSing` method of `SingKind`. Remove the `SingE` class, bundling its functionality into `SingKind`. Thus, the `SingRep` synonym has also been removed. Name change: `KindIs` becomes `KProxy`. Add support for singletonizing calls to `error`. Add support for singletonizing empty data definitions. 0.8.6 ----- Make compatible with GHC HEAD, but HEAD reports core lint errors sometimes. 0.8.5 ----- Bug fix to make singletons compatible with GHC 7.6.1. Added git info to cabal file. 0.8.4 ----- Update to work with latest version of GHC (7.7.20130114). Now use branched type family instances to allow for promotion of functions with overlapping patterns. Permit promotion of functions with constraints by omitting constraints. 0.8.3 ----- Update to work with latest version of GHC (7.7.20121031). Removed use of Any to simulate kind classes; now using KindOf and OfKind from GHC.TypeLits. Made compatible with GHC.TypeLits. 0.8.2 ----- Added this changelog Update to work with latest version of GHC (7.6.1). (There was a change to Template Haskell). Moved library into Data.Singletons. 0.8.1 ----- Update to work with latest version of GHC. (There was a change to Template Haskell). Updated dependencies in cabal to include the newer version of TH. 0.8 --- Initial public release singletons-2.5.1/LICENSE0000644000000000000000000000270507346545000013106 0ustar0000000000000000Copyright (c) 2012, Richard Eisenberg All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.singletons-2.5.1/README.md0000755000000000000000000006135107346545000013365 0ustar0000000000000000singletons 2.5.1 ================ [![Hackage](https://img.shields.io/hackage/v/singletons.svg)](http://hackage.haskell.org/package/singletons) [![Build Status](https://travis-ci.org/goldfirere/singletons.svg?branch=master)](https://travis-ci.org/goldfirere/singletons) This is the README file for the singletons library. This file contains all the documentation for the definitions and functions in the library. The singletons library was written by Richard Eisenberg, , and with significant contributions by Jan Stolarek, . There are two papers that describe the library. Original one, _Dependently typed programming with singletons_, is available [here](https://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf) and will be referenced in this documentation as the "singletons paper". A follow-up paper, _Promoting Functions to Type Families in Haskell_, is available [here](https://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf) and will be referenced in this documentation as the "promotion paper". Ryan Scott, , is an active maintainer. Purpose of the singletons library --------------------------------- The library contains a definition of _singleton types_, which allow programmers to use dependently typed techniques to enforce rich constraints among the types in their programs. See the singletons paper for a more thorough introduction. The package also allows _promotion_ of term-level functions to type-level equivalents. Accordingly, it exports a Prelude of promoted and singletonized functions, mirroring functions and datatypes found in Prelude, `Data.Bool`, `Data.Maybe`, `Data.Either`, `Data.Tuple` and `Data.List`. See the promotion paper for a more thorough introduction. [This blog series](https://blog.jle.im/entry/introduction-to-singletons-1.html), authored by Justin Le, offers a tutorial for this library that assumes no knowledge of dependent types. Compatibility ------------- The singletons library requires GHC 8.6.1 or greater. Any code that uses the singleton generation primitives needs to enable a long list of GHC extensions. This list includes, but is not necessarily limited to, the following: * `DataKinds` * `DefaultSignatures` * `EmptyCase` * `ExistentialQuantification` * `FlexibleContexts` * `FlexibleInstances` * `GADTs` * `InstanceSigs` * `KindSignatures` * `NoStarIsType` * `PolyKinds` * `RankNTypes` * `ScopedTypeVariables` * `StandaloneDeriving` * `TemplateHaskell` * `TypeFamilies` * `TypeOperators` * `UndecidableInstances` In particular, `NoStarIsType` is needed to use the `*` type family from the `PNum` class because with `StarIsType` enabled, GHC thinks `*` is a synonym for `Type`. You may also want * `-Wno-redundant-constraints` as the code that `singletons` generates uses redundant constraints, and there seems to be no way, without a large library redesign, to avoid this. Modules for singleton types --------------------------- `Data.Singletons` exports all the basic singletons definitions. Import this module if you are not using Template Haskell and wish only to define your own singletons. `Data.Singletons.TH` exports all the definitions needed to use the Template Haskell code to generate new singletons. `Data.Singletons.Prelude` re-exports `Data.Singletons` along with singleton definitions for various Prelude types. This module provides a singletonized equivalent of the real `Prelude`. Note that not all functions from original `Prelude` could be turned into singletons. `Data.Singletons.Prelude.*` modules provide singletonized equivalents of definitions found in the following `base` library modules: `Data.Bool`, `Data.Maybe`, `Data.Either`, `Data.List`, `Data.Tuple`, `Data.Void` and `GHC.Base`. We also provide singletonized `Eq`, `Ord`, `Show`, `Enum`, and `Bounded` typeclasses. `Data.Singletons.Decide` exports type classes for propositional equality. `Data.Singletons.TypeLits` exports definitions for working with `GHC.TypeLits`. Modules for function promotion ------------------------------ Modules in `Data.Promotion` namespace provide functionality required for function promotion. They mostly re-export a subset of definitions from respective `Data.Singletons` modules. `Data.Promotion.TH` exports all the definitions needed to use the Template Haskell code to generate promoted definitions. `Data.Promotion.Prelude` and `Data.Promotion.Prelude.*` modules re-export all promoted definitions from respective `Data.Singletons.Prelude` modules. `Data.Promotion.Prelude.List` adds a significant amount of functions that couldn't be singletonized but can be promoted. Some functions still don't promote - these are documented in the source code of the module. There is also `Data.Promotion.Prelude.Bounded` module that provides promoted `PBounded` typeclass. Functions to generate singletons -------------------------------- The top-level functions used to generate singletons are documented in the `Data.Singletons.TH` module. The most common case is just calling `singletons`, which I'll describe here: ```haskell singletons :: Q [Dec] -> Q [Dec] ``` Generates singletons from the definitions given. Because singleton generation requires promotion, this also promotes all of the definitions given to the type level. Usage example: ```haskell $(singletons [d| data Nat = Zero | Succ Nat pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n |]) ``` Definitions used to support singletons -------------------------------------- Please refer to the singletons paper for a more in-depth explanation of these definitions. Many of the definitions were developed in tandem with Iavor Diatchki. ```haskell data family Sing (a :: k) ``` The data family of singleton types. A new instance of this data family is generated for every new singleton type. ```haskell class SingI (a :: k) where sing :: Sing a ``` A class used to pass singleton values implicitly. The `sing` method produces an explicit singleton value. ```haskell data SomeSing k where SomeSing :: Sing (a :: k) -> SomeSing k ``` The `SomeSing` type wraps up an _existentially-quantified_ singleton. Note that the type parameter `a` does not appear in the `SomeSing` type. Thus, this type can be used when you have a singleton, but you don't know at compile time what it will be. `SomeSing Thing` is isomorphic to `Thing`. ```haskell class SingKind k where type Demote k :: * fromSing :: Sing (a :: k) -> Demote k toSing :: Demote k -> SomeSing k ``` This class is used to convert a singleton value back to a value in the original, unrefined ADT. The `fromSing` method converts, say, a singleton `Nat` back to an ordinary `Nat`. The `toSing` method produces an existentially-quantified singleton, wrapped up in a `SomeSing`. The `Demote` associated kind-indexed type family maps the kind `Nat` back to the type `Nat`. ```haskell data SingInstance (a :: k) where SingInstance :: SingI a => SingInstance a singInstance :: Sing a -> SingInstance a ``` Sometimes you have an explicit singleton (a `Sing`) where you need an implicit one (a dictionary for `SingI`). The `SingInstance` type simply wraps a `SingI` dictionary, and the `singInstance` function produces this dictionary from an explicit singleton. The `singInstance` function runs in constant time, using a little magic. Equality classes ---------------- There are two different notions of equality applicable to singletons: Boolean equality and propositional equality. * Boolean equality is implemented in the type family `(:==)` (which is actually a synonym for the type family `(==)` from `Data.Type.Equality`) and the class `SEq`. See the `Data.Singletons.Prelude.Eq` module for more information. * Propositional equality is implemented through the constraint `(~)`, the type `(:~:)`, and the class `SDecide`. See modules `Data.Type.Equality` and `Data.Singletons.Decide` for more information. Which one do you need? That depends on your application. Boolean equality has the advantage that your program can take action when two types do _not_ equal, while propositional equality has the advantage that GHC can use the equality of types during type inference. Instances of both `SEq` and `SDecide` are generated when `singletons` is called on a datatype that has `deriving Eq`. You can also generate these instances directly through functions exported from `Data.Singletons.TH`. `Show` classes -------------- Promoted and singled versions of the `Show` class (`PShow` and `SShow`, respectively) are provided in the `Data.Singletons.Prelude.Show` module. In addition, there is a `ShowSing` constraint synonym provided in the `Data.Singletons.ShowSing` module: ```haskell type ShowSing k = (forall z. Show (Sing (z :: k)) ``` This facilitates the ability to write `Show` instances for `Sing` instances. What distinguishes all of these `Show`s? Let's use the `False` constructor as an example. If you used the `PShow Bool` instance, then the output of calling `Show_` on `False` is `"False"`, much like the value-level `Show Bool` instance (similarly for the `SShow Bool` instance). However, the `Show (Sing (z :: Bool))` instance (i.e., `ShowSing Bool`) is intended for printing the value of the _singleton_ constructor `SFalse`, so calling `show SFalse` yields `"SFalse"`. Instance of `PShow`, `SShow`, and `Show` (for the singleton type) are generated when `singletons` is called on a datatype that has `deriving Show`. You can also generate these instances directly through functions exported from `Data.Singletons.TH`. A promoted and singled `Show` instance is provided for `Symbol`, but it is only a crude approximation of the value-level `Show` instance for `String`. On the value level, showing `String`s escapes special characters (such as double quotes), but implementing this requires pattern-matching on character literals, something which is currently impossible at the type level. As a consequence, the type-level `Show` instance for `Symbol`s does not do any character escaping. Errors ------ The `singletons` library provides two different ways to handle errors: * The `Error` type family, from `Data.Singletons.TypeLits`: ```haskell type family Error (str :: a) :: k where {} ``` This is simply an empty, closed type family, which means that it will fail to reduce regardless of its input. The typical use case is giving it a `Symbol` as an argument, so that something akin to `Error "This is an error message"` appears in error messages. * The `TypeError` type family, from `Data.Singletons.TypeError`. This is a drop-in replacement for `TypeError` from `GHC.TypeLits` which can be used at both the type level and the value level (via the `typeError` function). Unlike `Error`, `TypeError` will result in an actual compile-time error message, which may be more desirable depending on the use case. Pre-defined singletons ---------------------- The singletons library defines a number of singleton types and functions by default: * `Bool` * `Maybe` * `Either` * `Ordering` * `()` * tuples up to length 7 * lists These are all available through `Data.Singletons.Prelude`. Functions that operate on these singletons are available from modules such as `Data.Singletons.Bool` and `Data.Singletons.Maybe`. Promoting functions ------------------- Function promotion allows to generate type-level equivalents of term-level definitions. Almost all Haskell source constructs are supported -- see last section of this README for a full list. Promoted definitions are usually generated by calling `promote` function: ```haskell $(promote [d| data Nat = Zero | Succ Nat pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n |]) ``` Every promoted function and data constructor definition comes with a set of so-called "symbols". These are required to represent partial application at the type level. Each function gets N+1 symbols, where N is the arity. Symbols represent application of between 0 to N arguments. When calling any of the promoted definitions it is important refer to it using their symbol name. Moreover, there is new function application at the type level represented by `Apply` type family. Symbol representing arity X can have X arguments passed in using normal function application. All other parameters must be passed by calling `Apply`. Users also have access to `Data.Promotion.Prelude` and its submodules (`Base`, `Bool`, `Either`, `List`, `Maybe` and `Tuple`). These provide promoted versions of function found in GHC's base library. Note that GHC resolves variable names in Template Haskell quotes. You cannot then use an undefined identifier in a quote, making idioms like this not work: ```haskell type family Foo a where ... $(promote [d| ... foo x ... |]) ``` In this example, `foo` would be out of scope. Refer to the promotion paper for more details on function promotion. Classes and instances --------------------- This is best understood by example. Let's look at a stripped down `Ord`: ```haskell class Eq a => Ord a where compare :: a -> a -> Ordering (<) :: a -> a -> Bool x < y = case x `compare` y of LT -> True EQ -> False GT -> False ``` This class gets promoted to a "kind class" thus: ```haskell class PEq a => POrd a where type Compare (x :: a) (y :: a) :: Ordering type (:<) (x :: a) (y :: a) :: Bool type x :< y = ... -- promoting `case` is yucky. ``` Note that default method definitions become default associated type family instances. This works out quite nicely. We also get this singleton class: ```haskell class SEq a => SOrd a where sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y) (%:<) :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (x :< y) default (%:<) :: forall (x :: a) (y :: a). ((x :< y) ~ {- RHS from (:<) above -}) => Sing x -> Sing y -> Sing (x :< y) x %:< y = ... -- this is a bit yucky too ``` Note that a singletonized class needs to use `default` signatures, because type-checking the default body requires that the default associated type family instance was used in the promoted class. The extra equality constraint on the default signature asserts this fact to the type checker. Instances work roughly similarly. ```haskell instance Ord Bool where compare False False = EQ compare False True = LT compare True False = GT compare True True = EQ instance POrd Bool where type Compare 'False 'False = 'EQ type Compare 'False 'True = 'LT type Compare 'True 'False = 'GT type Compare 'True 'True = 'EQ instance SOrd Bool where sCompare :: forall (x :: a) (y :: a). Sing x -> Sing y -> Sing (Compare x y) sCompare SFalse SFalse = SEQ sCompare SFalse STrue = SLT sCompare STrue SFalse = SGT sCompare STrue STrue = SEQ ``` The only interesting bit here is the instance signature. It's not necessary in such a simple scenario, but more complicated functions need to refer to scoped type variables, which the instance signature can bring into scope. The defaults all just work. On names -------- The singletons library has to produce new names for the new constructs it generates. Here are some examples showing how this is done: 1. original datatype: `Nat` promoted kind: `Nat` singleton type: `SNat` (which is really a synonym for `Sing`) 2. original datatype: `/\` promoted kind: `/\` singleton type: `%/\` 3. original constructor: `Succ` promoted type: `'Succ` (you can use `Succ` when unambiguous) singleton constructor: `SSucc` symbols: `SuccSym0`, `SuccSym1` 4. original constructor: `:+:` promoted type: `':+:` singleton constructor: `:%+:` symbols: `:+:@#@$`, `:+:@#@$$`, `:+:@#@$$$` 5. original value: `pred` promoted type: `Pred` singleton value: `sPred` symbols: `PredSym0`, `PredSym1` 6. original value: `+` promoted type: `+` singleton value: `%+` symbols: `+@#@$`, `+@#@$$`, `+@#@$$$` 7. original class: `Num` promoted class: `PNum` singleton class: `SNum` 8. original class: `~>` promoted class: `#~>` singleton class: `%~>` Special names ------------- There are some special cases, listed below (with asterisks\* denoting special treatment): 1. original datatype: `[]` promoted kind: `[]` singleton type\*: `SList` 2. original constructor: `[]` promoted type: `'[]` singleton constructor\*: `SNil` symbols\*: `NilSym0` 3. original constructor: `:` promoted type: `':` singleton constructor\*: `SCons` symbols: `:@#@$`, `:@#@$$`, `:@#@$$$` 4. original datatype: `(,)` promoted kind: `(,)` singleton type\*: `STuple2` 5. original constructor: `(,)` promoted type: `'(,)` singleton constructor\*: `STuple2` symbols\*: `Tuple2Sym0`, `Tuple2Sym1`, `Tuple2Sym2` All tuples (including the 0-tuple, unit) are treated similarly. 6. original value: `(.)` promoted type\*: `(:.)` singleton value: `(%.)` symbols: `(.@#@$)`, `(.@#@$$)`, `(.@#@$$$)` The promoted type is special because GHC can't parse a type named `(.)`. 7. original value: `(!)` promoted type\*: `(:!)` singleton value: `(%!)` symbols: `(!@#@$)`, `(!@#@$$)`, `(!@#@$$$)` The promoted type is special because GHC can't parse a type named `(!)`. 8. original value: `___foo` promoted type\*: `US___foo` ("`US`" stands for "underscore") singleton value\*: `___sfoo` symbols\*: `US___fooSym0` All functions that begin with leading underscores are treated similarly. Supported Haskell constructs ---------------------------- The following constructs are fully supported: * variables * tuples * constructors * if statements * infix expressions and types * `_` patterns * aliased patterns * lists (including list comprehensions) * `do`-notation * sections * undefined * error * deriving `Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`, `Foldable`, and `Traversable`, as well as the `stock` and `anyclass` deriving strategies * class constraints (though these sometimes fail with `let`, `lambda`, and `case`) * literals (for `Nat` and `Symbol`), including overloaded number literals * unboxed tuples (which are treated as normal tuples) * records * pattern guards * case * let * lambda expressions * `!` and `~` patterns (silently but successfully ignored during promotion) * class and instance declarations * scoped type variables * signatures (e.g., `(x :: Maybe a)`) in expressions and patterns * `InstanceSigs` * higher-kinded type variables (see below) * finite arithmetic sequences (see below) * functional dependencies (with limitations -- see below) * type families (with limitations -- see below) Higher-kinded type variables in `class`/`data` declarations must be annotated explicitly. This is due to GHC's handling of *complete user-specified kind signatures*, or [CUSKs](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#complete-user-supplied-kind-signatures-and-polymorphic-recursion). Briefly, `singletons` has a hard time conforming to the precise rules that GHC imposes around CUSKs and so needs a little help around kind inference here. See [this pull request](https://github.com/goldfirere/singletons/pull/171) for more background. `singletons` is slightly more conservative with respect to `deriving` than GHC is. The stock classes listed above (`Eq`, `Ord`, `Show`, `Bounded`, `Enum`, `Functor`, `Foldable`, and `Traversable`) are the only ones that `singletons` will derive without an explicit deriving strategy. To do anything more exotic, one must explicitly indicate one's intentions by using the `DerivingStrategies` extension. `singletons` fully supports the `anyclass` strategy as well as the `stock` strategy (at least, for the classes listed above). `singletons` does not support the `newtype` strategy, as there is not an equivalent of `coerce` at the type level. `singletons` has partial support for arithmetic sequences (which desugar to methods from the `Enum` class under the hood). _Finite_ sequences (e.g., [0..42]) are fully supported. However, _infinite_ sequences (e.g., [0..]), which desugar to calls to `enumFromTo` or `enumFromThenTo`, are not supported, as these would require using infinite lists at the type level. The following constructs are supported for promotion but not singleton generation: * datatypes with constructors which have contexts. For example, the following datatype does not singletonize: ```haskell data T a where MkT :: Show a => a -> T a ``` Constructors like these do not interact well with the current design of the `SingKind` class. But see [this bug report](https://github.com/goldfirere/singletons/issues/150), which proposes a redesign for `SingKind` (in a future version of GHC with certain bugfixes) which could permit constructors with equality constraints. * overlapping patterns. Note that overlapping patterns are sometimes not obvious. For example, the `filter` function does not singletonize due to overlapping patterns: ```haskell filter :: (a -> Bool) -> [a] -> [a] filter _pred [] = [] filter pred (x:xs) | pred x = x : filter pred xs | otherwise = filter pred xs ``` Overlap is caused by `otherwise` catch-all guard, which is always true and thus overlaps with `pred x` guard. Another non-obvious source of overlapping patterns comes from partial pattern matches in `do`-notation. For example: ```haskell f :: [()] f = do Just () <- [Nothing] return () ``` This has overlap because the partial pattern match desugars to the following: ```haskell f :: [()] f = case [Nothing] of Just () -> return () _ -> fail "Partial pattern match in do notation" ``` Here, it is more evident that the catch-all pattern `_` overlaps with the one above it. The following constructs are not supported: * datatypes that store arrows, `Nat`, or `Symbol` * literals (limited support) Why are these out of reach? As described in the promotion paper, promotion of datatypes that store arrows is currently impossible. So if you have a declaration such as ```haskell data Foo = Bar (Bool -> Maybe Bool) ``` you will quickly run into errors. Literals are problematic because we rely on GHC's built-in support, which currently is limited. Functions that operate on strings will not work because type level strings are no longer considered lists of characters. Function working on integer literals can be promoted by rewriting them to use `Nat`. Since `Nat` does not exist at the term level it will only be possible to use the promoted definition, but not the original, term-level one. This is the same line of reasoning that forbids the use of `Nat` or `Symbol` in datatype definitions. But, see [this bug report](https://github.com/goldfirere/singletons/issues/76) for a workaround. Support for `*` --------------- The built-in Haskell promotion mechanism does not yet have a full story around the kind `*` (the kind of types that have values). Ideally, promoting some form of `TypeRep` would yield `*`, but the implementation of TypeRep would have to be updated for this to really work out. In the meantime, users who wish to experiment with this feature have two options: 1) The module `Data.Singletons.TypeRepTYPE` has all the definitions possible for making `*` the promoted version of `TypeRep`, as `TypeRep` is currently implemented. The singleton associated with `TypeRep` has one constructor: ```haskell newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a ``` (Recall that `type * = TYPE LiftedRep`.) Thus, a `TypeRep` is stored in the singleton constructor. However, any datatypes that store `TypeRep`s will not generally work as expected; the built-in promotion mechanism will not promote `TypeRep` to `*`. 2) The module `Data.Singletons.CustomStar` allows the programmer to define a subset of types with which to work. See the Haddock documentation for the function `singletonStar` for more info. Known bugs ---------- * Record updates don't singletonize * Inference dependent on functional dependencies is unpredictably bad. The problem is that a use of an associated type family tied to a class with fundeps doesn't provoke the fundep to kick in. This is GHC's problem, in the end. * Singled code that contains uses type families is likely to fail due to GHC Trac #12564. Note that singling type family declarations themselves is fine (and often desired, since that produces defunctionalization symbols for them). * Singling instances of poly-kinded type classes is likely to fail due to [#358](https://github.com/goldfirere/singletons/issues/358). However, one can often work around the issue by using `InstanceSigs`. For instance, the following code will not single: ```haskell class C (f :: k -> Type) where method :: f a instance C [] where method = [] ``` Adding a type signature for `method` in the `C []` is sufficient to work around the issue, though: ```haskell instance C [] where method :: [a] method = [] ``` singletons-2.5.1/Setup.hs0000644000000000000000000001242107346545000013531 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} module Main (main) where import Control.Monad import Data.List import Data.String import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.BuildPaths import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils import Distribution.Text import System.Directory import System.FilePath main :: IO () main = defaultMainWithHooks simpleUserHooks { buildHook = \pkg lbi hooks flags -> do generateBuildModule flags pkg lbi buildHook simpleUserHooks pkg lbi hooks flags , confHook = \(gpd, hbi) flags -> confHook simpleUserHooks (amendGPD gpd, hbi) flags , haddockHook = \pkg lbi hooks flags -> do generateBuildModule (haddockToBuildFlags flags) pkg lbi haddockHook simpleUserHooks pkg lbi hooks flags } -- | Convert only flags used by 'generateBuildModule'. haddockToBuildFlags :: HaddockFlags -> BuildFlags haddockToBuildFlags f = emptyBuildFlags { buildVerbosity = haddockVerbosity f , buildDistPref = haddockDistPref f } generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule flags pkg lbi = do rootDir <- getCurrentDirectory let verbosity = fromFlag (buildVerbosity flags) distPref = fromFlag (buildDistPref flags) distPref' | isRelative distPref = rootDir distPref | otherwise = distPref -- Package DBs dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref' "package.conf.inplace" ] dbFlags = "-hide-all-packages" : packageDbArgsDb dbStack ghc = case lookupProgram ghcProgram (withPrograms lbi) of Just fp -> locationPath $ programLocation fp Nothing -> error "Can't find GHC path" withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do let testAutogenDir = autogenComponentModulesDir lbi suitecfg createDirectoryIfMissingVerbose verbosity True testAutogenDir let buildSingletonsFile = testAutogenDir buildSingletonsModule <.> "hs" withLibLBI pkg lbi $ \_ libCLBI -> do let libDeps = map fst $ componentPackageDeps libCLBI pidx = case dependencyClosure (installedPkgs lbi) libDeps of Left p -> p Right _ -> error "Broken dependency closure" libTransDeps = map installedUnitId $ allPackages pidx singletonsUnitId = componentUnitId libCLBI deps = formatDeps (singletonsUnitId:libTransDeps) allFlags = dbFlags ++ deps writeFile buildSingletonsFile $ unlines [ "module Build_singletons where" , "" , "ghcPath :: FilePath" , "ghcPath = " ++ show ghc , "" , "ghcFlags :: [String]" , "ghcFlags = " ++ show allFlags , "" , "rootDir :: FilePath" , "rootDir = " ++ show rootDir ] where formatDeps = map formatOne formatOne installedPkgId = "-package-id=" ++ display installedPkgId -- GHC >= 7.6 uses the '-package-db' flag. See -- https://ghc.haskell.org/trac/ghc/ticket/5977. packageDbArgsDb :: [PackageDB] -> [String] -- special cases to make arguments prettier in common scenarios packageDbArgsDb dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) | all isSpecific dbs -> concatMap single dbs (GlobalPackageDB:dbs) | all isSpecific dbs -> "-no-user-package-db" : concatMap single dbs dbs -> "-clear-package-db" : concatMap single dbs where single (SpecificPackageDB db) = [ "-package-db=" ++ db ] single GlobalPackageDB = [ "-global-package-db" ] single UserPackageDB = [ "-user-package-db" ] isSpecific (SpecificPackageDB _) = True isSpecific _ = False buildSingletonsModule :: FilePath buildSingletonsModule = "Build_singletons" testSuiteName :: String testSuiteName = "singletons-test-suite" amendGPD :: GenericPackageDescription -> GenericPackageDescription amendGPD gpd = gpd { condTestSuites = map f (condTestSuites gpd) } where f (name, condTree) | name == fromString testSuiteName = (name, condTree') | otherwise = (name, condTree) where -- I miss 'lens' testSuite = condTreeData condTree bi = testBuildInfo testSuite om = otherModules bi am = autogenModules bi -- Cons the module to both other-modules and autogen-modules. -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have -- "all autogen-modules are other-modules if they aren't exposed-modules" -- rule. Hopefully cabal-spec-3.0 will have. -- -- Note: we `nub`, because it's unclear if that's ok to have duplicate -- modules in the lists. om' = nub $ mn : om am' = nub $ mn : am mn = fromString buildSingletonsModule bi' = bi { otherModules = om', autogenModules = am' } testSuite' = testSuite { testBuildInfo = bi' } condTree' = condTree { condTreeData = testSuite' } singletons-2.5.1/singletons.cabal0000644000000000000000000001551707346545000015257 0ustar0000000000000000name: singletons version: 2.5.1 -- Remember to bump version in the Makefile as well cabal-version: >= 1.10 synopsis: A framework for generating singleton types homepage: http://www.github.com/goldfirere/singletons category: Dependent Types author: Richard Eisenberg , Jan Stolarek maintainer: Ryan Scott bug-reports: https://github.com/goldfirere/singletons/issues stability: experimental tested-with: GHC == 8.6.2 extra-source-files: README.md, CHANGES.md, tests/compile-and-dump/buildGoldenFiles.awk, tests/compile-and-dump/GradingClient/*.hs, tests/compile-and-dump/InsertionSort/*.hs, tests/compile-and-dump/Promote/*.hs, tests/compile-and-dump/Singletons/*.hs tests/compile-and-dump/GradingClient/*.ghc86.template, tests/compile-and-dump/InsertionSort/*.ghc86.template, tests/compile-and-dump/Promote/*.ghc86.template, tests/compile-and-dump/Singletons/*.ghc86.template license: BSD3 license-file: LICENSE build-type: Custom description: This library generates singleton types, promoted functions, and singleton functions using Template Haskell. It is useful for programmers who wish to use dependently typed programming techniques. The library was originally presented in /Dependently Typed Programming with Singletons/, published at the Haskell Symposium, 2012. () Version 1.0 and onwards works a lot harder to promote functions. See the paper published at Haskell Symposium, 2014: . source-repository this type: git location: https://github.com/goldfirere/singletons.git tag: v2.5.1 source-repository head type: git location: https://github.com/goldfirere/singletons.git branch: master custom-setup setup-depends: base >= 4.12 && < 4.13, Cabal >= 2.3 && < 2.5, directory >= 1, filepath >= 1.3 library hs-source-dirs: src build-depends: base >= 4.12 && < 4.13, mtl >= 2.2.1, ghc-boot-th, template-haskell, containers >= 0.5, th-desugar >= 1.9 && < 1.10, pretty, syb >= 0.4, text >= 1.2, transformers >= 0.5.2 default-language: Haskell2010 other-extensions: TemplateHaskell -- TemplateHaskell must be listed in cabal file to work with -- ghc7.8+ exposed-modules: Data.Singletons Data.Singletons.CustomStar Data.Singletons.TypeRepTYPE Data.Singletons.TH Data.Singletons.Prelude Data.Singletons.Prelude.Applicative Data.Singletons.Prelude.Base Data.Singletons.Prelude.Bool Data.Singletons.Prelude.Const Data.Singletons.Prelude.Either Data.Singletons.Prelude.Enum Data.Singletons.Prelude.Eq Data.Singletons.Prelude.Foldable Data.Singletons.Prelude.Function Data.Singletons.Prelude.Functor Data.Singletons.Prelude.IsString Data.Singletons.Prelude.Identity Data.Singletons.Prelude.Ord Data.Singletons.Prelude.List Data.Singletons.Prelude.List.NonEmpty Data.Singletons.Prelude.Maybe Data.Singletons.Prelude.Monad Data.Singletons.Prelude.Monad.Zip Data.Singletons.Prelude.Monoid Data.Singletons.Prelude.Num Data.Singletons.Prelude.Semigroup Data.Singletons.Prelude.Show Data.Singletons.Prelude.Traversable Data.Singletons.Prelude.Tuple Data.Singletons.Prelude.Void Data.Singletons.TypeError Data.Singletons.TypeLits Data.Singletons.Decide Data.Singletons.ShowSing Data.Singletons.Sigma Data.Singletons.SuppressUnusedWarnings other-modules: Data.Singletons.Deriving.Infer Data.Singletons.Deriving.Bounded Data.Singletons.Deriving.Enum Data.Singletons.Deriving.Foldable Data.Singletons.Deriving.Functor Data.Singletons.Deriving.Ord Data.Singletons.Deriving.Show Data.Singletons.Deriving.Traversable Data.Singletons.Deriving.Util Data.Singletons.Internal Data.Singletons.Prelude.List.Internal Data.Singletons.Prelude.List.Internal.Disambiguation Data.Singletons.Prelude.Monad.Internal Data.Singletons.Prelude.Semigroup.Internal Data.Singletons.Promote Data.Singletons.Promote.Monad Data.Singletons.Promote.Eq Data.Singletons.Promote.Type Data.Singletons.Promote.Defun Data.Singletons.Util Data.Singletons.Partition Data.Singletons.Prelude.Instances Data.Singletons.Names Data.Singletons.Single.Monad Data.Singletons.Single.Type Data.Singletons.Single.Eq Data.Singletons.Single.Data Data.Singletons.Single.Defun Data.Singletons.Single.Fixity Data.Singletons.Single Data.Singletons.TypeLits.Internal Data.Singletons.Syntax ghc-options: -Wall -Wno-redundant-constraints test-suite singletons-test-suite type: exitcode-stdio-1.0 hs-source-dirs: tests ghc-options: -Wall default-language: Haskell2010 main-is: SingletonsTestSuite.hs other-modules: ByHand ByHand2 SingletonsTestSuiteUtils build-depends: base >= 4.12 && < 4.13, filepath >= 1.3, process >= 1.1, singletons, tasty >= 0.6, tasty-golden >= 2.2 singletons-2.5.1/src/Data/0000755000000000000000000000000007346545000013535 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons.hs0000644000000000000000000001546707346545000016233 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- This module exports the basic definitions to use singletons. For routine -- use, consider importing 'Data.Singletons.Prelude', which exports constructors -- for singletons based on types in the @Prelude@. -- -- You may also want to read -- the original papers presenting this library, available at -- -- and . -- ---------------------------------------------------------------------------- module Data.Singletons ( -- * Main singleton definitions Sing(SLambda, applySing), (@@), SingI(..), SingKind(..), -- * Working with singletons KindOf, SameKind, SingInstance(..), SomeSing(..), singInstance, pattern Sing, withSingI, withSomeSing, pattern FromSing, singByProxy, demote, singByProxy#, withSing, singThat, -- ** Defunctionalization TyFun, type (~>), TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8, TyCon, Apply, type (@@), -- ** Defunctionalized singletons -- | When calling a higher-order singleton function, you need to use a -- @singFun...@ function to wrap it. See 'singFun1'. singFun1, singFun2, singFun3, singFun4, singFun5, singFun6, singFun7, singFun8, unSingFun1, unSingFun2, unSingFun3, unSingFun4, unSingFun5, unSingFun6, unSingFun7, unSingFun8, -- $SLambdaPatternSynonyms pattern SLambda2, pattern SLambda3, pattern SLambda4, pattern SLambda5, pattern SLambda6, pattern SLambda7, pattern SLambda8, -- | These type synonyms are exported only to improve error messages; users -- should not have to mention them. SingFunction1, SingFunction2, SingFunction3, SingFunction4, SingFunction5, SingFunction6, SingFunction7, SingFunction8, -- * Auxiliary functions Proxy(..), -- * Defunctionalization symbols DemoteSym0, DemoteSym1, SameKindSym0, SameKindSym1, SameKindSym2, KindOfSym0, KindOfSym1, type (~>@#@$), type (~>@#@$$), type (~>@#@$$$), ApplySym0, ApplySym1, ApplySym2, type (@@@#@$), type (@@@#@$$), type (@@@#@$$$) ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.IsString import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Semigroup import Data.Singletons.Promote import Data.Singletons.ShowSing import Data.String import qualified Data.Text as T (pack) ---------------------------------------------------------------------- ---- SomeSing instances ---------------------------------------------- ---------------------------------------------------------------------- instance SEq k => Eq (SomeSing k) where SomeSing a == SomeSing b = fromSing (a %== b) SomeSing a /= SomeSing b = fromSing (a %/= b) instance SOrd k => Ord (SomeSing k) where SomeSing a `compare` SomeSing b = fromSing (a `sCompare` b) SomeSing a < SomeSing b = fromSing (a %< b) SomeSing a <= SomeSing b = fromSing (a %<= b) SomeSing a > SomeSing b = fromSing (a %> b) SomeSing a >= SomeSing b = fromSing (a %>= b) instance SBounded k => Bounded (SomeSing k) where minBound = SomeSing sMinBound maxBound = SomeSing sMaxBound instance (SEnum k, SingKind k) => Enum (SomeSing k) where succ (SomeSing a) = SomeSing (sSucc a) pred (SomeSing a) = SomeSing (sPred a) toEnum n = withSomeSing (fromIntegral n) (SomeSing . sToEnum) fromEnum (SomeSing a) = fromIntegral (fromSing (sFromEnum a)) enumFromTo (SomeSing from) (SomeSing to) = map toSing (fromSing (sEnumFromTo from to)) enumFromThenTo (SomeSing from) (SomeSing then_) (SomeSing to) = map toSing (fromSing (sEnumFromThenTo from then_ to)) instance SNum k => Num (SomeSing k) where SomeSing a + SomeSing b = SomeSing (a %+ b) SomeSing a - SomeSing b = SomeSing (a %- b) SomeSing a * SomeSing b = SomeSing (a %* b) negate (SomeSing a) = SomeSing (sNegate a) abs (SomeSing a) = SomeSing (sAbs a) signum (SomeSing a) = SomeSing (sSignum a) fromInteger n = withSomeSing (fromIntegral n) (SomeSing . sFromInteger) deriving instance ShowSing k => Show (SomeSing k) instance SSemigroup k => Semigroup (SomeSing k) where SomeSing a <> SomeSing b = SomeSing (a %<> b) instance SMonoid k => Monoid (SomeSing k) where mempty = SomeSing sMempty instance SIsString k => IsString (SomeSing k) where fromString s = withSomeSing (T.pack s) (SomeSing . sFromString) ---------------------------------------------------------------------- ---- Defunctionalization symbols ------------------------------------- ---------------------------------------------------------------------- $(genDefunSymbols [''Demote, ''SameKind, ''KindOf, ''(~>), ''Apply, ''(@@)]) -- SingFunction1 et al. are not defunctionalizable at the moment due to #198 {- $SLambdaPatternSynonyms @SLambda{2...8}@ are explicitly bidirectional pattern synonyms for defunctionalized singletons (@'Sing' (f :: k '~>' k' '~>' k'')@). As __constructors__: Same as @singFun{2..8}@. For example, one can turn a binary function on singletons @sTake :: 'SingFunction2' TakeSym0@ into a defunctionalized singleton @'Sing' (TakeSym :: Nat '~>' [a] '~>' [a])@: @ >>> import Data.Singletons.Prelude.List >>> :set -XTypeApplications >>> >>> :t 'SLambda2' 'SLambda2' :: 'SingFunction2' f -> 'Sing' f >>> :t 'SLambda2' \@TakeSym0 'SLambda2' :: 'SingFunction2' TakeSym0 -> 'Sing' TakeSym0 >>> :t 'SLambda2' \@TakeSym0 sTake 'SLambda2' :: 'Sing' TakeSym0 @ This is useful for functions on singletons that expect a defunctionalized singleton as an argument, such as @sZipWith :: 'SingFunction3' ZipWithSym0@: @ sZipWith :: Sing (f :: a '~>' b '~>' c) -> Sing (xs :: [a]) -> Sing (ys :: [b]) -> Sing (ZipWith f xs ys :: [c]) sZipWith ('SLambda2' \@TakeSym0 sTake) :: Sing (xs :: [Nat]) -> Sing (ys :: [[a]]) -> Sing (ZipWith TakeSym0 xs ys :: [[a]]) @ As __patterns__: Same as @unSingFun{2..8}@. Gets a binary term-level Haskell function on singletons @'Sing' (x :: k) -> 'Sing' (y :: k') -> 'Sing' (f \@\@ x \@\@ y)@ from a defunctionalised @'Sing' f@. Alternatively, as a record field accessor: @ applySing2 :: 'Sing' (f :: k '~>' k' '~>' k'') -> 'SingFunction2' f @ -} singletons-2.5.1/src/Data/Singletons/0000755000000000000000000000000007346545000015662 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/CustomStar.hs0000644000000000000000000001534707346545000020334 0ustar0000000000000000{-# LANGUAGE DataKinds, TypeFamilies, KindSignatures, TemplateHaskell, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.CustomStar -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- This file implements 'singletonStar', which generates a datatype @Rep@ and associated -- singleton from a list of types. The promoted version of @Rep@ is kind @*@ and the -- Haskell types themselves. This is still very experimental, so expect unusual -- results! -- ---------------------------------------------------------------------------- module Data.Singletons.CustomStar ( singletonStar, module Data.Singletons.Prelude.Eq, module Data.Singletons.Prelude.Bool, module Data.Singletons.TH ) where import Language.Haskell.TH import Data.Singletons.Util import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Show import Data.Singletons.Promote import Data.Singletons.Promote.Monad import Data.Singletons.Single.Monad import Data.Singletons.Single.Data import Data.Singletons.Single import Data.Singletons.Syntax import Data.Singletons.Names import Data.Singletons.TH import Control.Monad import Data.Maybe import Language.Haskell.TH.Desugar import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Bool -- | Produce a representation and singleton for the collection of types given. -- -- A datatype @Rep@ is created, with one constructor per type in the declared -- universe. When this type is promoted by the singletons library, the -- constructors become full types in @*@, not just promoted data constructors. -- -- For example, -- -- > $(singletonStar [''Nat, ''Bool, ''Maybe]) -- -- generates the following: -- -- > data Rep = Nat | Bool | Maybe Rep deriving (Eq, Ord, Read, Show) -- -- and its singleton. However, because @Rep@ is promoted to @*@, the singleton -- is perhaps slightly unexpected: -- -- > data instance Sing (a :: *) where -- > SNat :: Sing Nat -- > SBool :: Sing Bool -- > SMaybe :: Sing a -> Sing (Maybe a) -- -- The unexpected part is that @Nat@, @Bool@, and @Maybe@ above are the real @Nat@, -- @Bool@, and @Maybe@, not just promoted data constructors. -- -- Please note that this function is /very/ experimental. Use at your own risk. singletonStar :: DsMonad q => [Name] -- ^ A list of Template Haskell @Name@s for types -> q [Dec] singletonStar names = do kinds <- mapM getKind names ctors <- zipWithM (mkCtor True) names kinds let repDecl = DDataD Data [] repName [] (Just (DConT typeKindName)) ctors [DDerivClause Nothing (map DConPr [''Eq, ''Ord, ''Read, ''Show])] fakeCtors <- zipWithM (mkCtor False) names kinds let dataDecl = DataDecl repName [] fakeCtors -- Why do we need withLocalDeclarations here? It's because we end up -- expanding type synonyms when deriving instances for Rep, which requires -- reifying Rep itself. Since Rep hasn't been spliced in yet, we must put it -- into the local declarations. withLocalDeclarations (decToTH repDecl) $ do -- We opt to infer the constraints for the Eq instance here so that when it's -- promoted, Rep will be promoted to Type. dataDeclEqCxt <- inferConstraints (DConPr ''Eq) (DConT repName) fakeCtors let dataDeclEqInst = DerivedDecl (Just dataDeclEqCxt) (DConT repName) dataDecl ordInst <- mkOrdInstance Nothing (DConT repName) dataDecl showInst <- mkShowInstance Nothing (DConT repName) dataDecl (pInsts, promDecls) <- promoteM [] $ do promoteDataDec dataDecl promoteDerivedEqDec dataDeclEqInst traverse (promoteInstanceDec mempty) [ordInst, showInst] singletonDecls <- singDecsM [] $ do decs1 <- singDataD dataDecl decs2 <- singDerivedEqDecs dataDeclEqInst decs3 <- traverse singInstD pInsts return (decs1 ++ decs2 ++ decs3) return $ decsToTH $ repDecl : promDecls ++ singletonDecls where -- get the kinds of the arguments to the tycon with the given name getKind :: DsMonad q => Name -> q [DKind] getKind name = do info <- reifyWithLocals name dinfo <- dsInfo info case dinfo of DTyConI (DDataD _ (_:_) _ _ _ _ _) _ -> fail "Cannot make a representation of a constrained data type" DTyConI (DDataD _ [] _ tvbs mk _ _) _ -> do all_tvbs <- buildDataDTvbs tvbs mk return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) all_tvbs DTyConI (DTySynD _ tvbs _) _ -> return $ map (fromMaybe (DConT typeKindName) . extractTvbKind) tvbs DPrimTyConI _ n _ -> return $ replicate n $ DConT typeKindName _ -> fail $ "Invalid thing for representation: " ++ (show name) -- first parameter is whether this is a real ctor (with a fresh name) -- or a fake ctor (when the name is actually a Haskell type) mkCtor :: DsMonad q => Bool -> Name -> [DKind] -> q DCon mkCtor real name args = do (types, vars) <- evalForPair $ mapM (kindToType []) args dataName <- if real then mkDataName (nameBase name) else return name return $ DCon (map DPlainTV vars) [] dataName (DNormalC False (map (\ty -> (noBang, ty)) types)) (DConT repName) where noBang = Bang NoSourceUnpackedness NoSourceStrictness -- demote a kind back to a type, accumulating any unbound parameters kindToType :: DsMonad q => [DType] -> DKind -> QWithAux [Name] q DType kindToType _ (DForallT _ _ _) = fail "Explicit forall encountered in kind" kindToType args (DAppT f a) = do a' <- kindToType [] a kindToType (a' : args) f kindToType args (DSigT t k) = do t' <- kindToType [] t k' <- kindToType [] k return $ DSigT t' k' `foldType` args kindToType args (DVarT n) = do addElement n return $ DVarT n `foldType` args kindToType args (DConT n) = return $ DConT name `foldType` args where name | isTypeKindName n = repName | otherwise = n kindToType args DArrowT = return $ DArrowT `foldType` args kindToType args k@(DLitT {}) = return $ k `foldType` args kindToType args DWildCardT = return $ DWildCardT `foldType` args singletons-2.5.1/src/Data/Singletons/Decide.hs0000644000000000000000000000436207346545000017400 0ustar0000000000000000{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances, GADTs #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Decide -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the class 'SDecide', allowing for decidable equality over singletons. -- ---------------------------------------------------------------------------- module Data.Singletons.Decide ( -- * The SDecide class SDecide(..), -- * Supporting definitions (:~:)(..), Void, Refuted, Decision(..) ) where import Data.Kind (Type) import Data.Singletons.Internal import Data.Type.Coercion import Data.Type.Equality import Data.Void ---------------------------------------------------------------------- ---- SDecide --------------------------------------------------------- ---------------------------------------------------------------------- -- | Because we can never create a value of type 'Void', a function that type-checks -- at @a -> Void@ shows that objects of type @a@ can never exist. Thus, we say that -- @a@ is 'Refuted' type Refuted a = (a -> Void) -- | A 'Decision' about a type @a@ is either a proof of existence or a proof that @a@ -- cannot exist. data Decision a = Proved a -- ^ Witness for @a@ | Disproved (Refuted a) -- ^ Proof that no @a@ exists -- | Members of the 'SDecide' "kind" class support decidable equality. Instances -- of this class are generated alongside singleton definitions for datatypes that -- derive an 'Eq' instance. class SDecide k where -- | Compute a proof or disproof of equality, given two singletons. (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b) infix 4 %~ instance SDecide k => TestEquality (Sing :: k -> Type) where testEquality a b = case a %~ b of Proved Refl -> Just Refl Disproved _ -> Nothing instance SDecide k => TestCoercion (Sing :: k -> Type) where testCoercion a b = case a %~ b of Proved Refl -> Just Coercion Disproved _ -> Nothing singletons-2.5.1/src/Data/Singletons/Deriving/0000755000000000000000000000000007346545000017431 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Deriving/Bounded.hs0000644000000000000000000000471507346545000021354 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Bounded -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Bounded instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Bounded where import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Util import Data.Singletons.Syntax import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Control.Monad -- monadic only for failure and parallelism with other functions -- that make instances mkBoundedInstance :: DsMonad q => DerivDesc q mkBoundedInstance mb_ctxt ty (DataDecl _ _ cons) = do -- We can derive instance of Bounded if datatype is an enumeration (all -- constructors must be nullary) or has only one constructor. See Section 11 -- of Haskell 2010 Language Report. -- Note that order of conditions below is important. when (null cons || (any (\(DCon _ _ _ f _) -> not . null . tysOfConFields $ f) cons && (not . null . tail $ cons))) $ fail ("Can't derive Bounded instance for " ++ pprint (typeToTH ty) ++ ".") -- at this point we know that either we have a datatype that has only one -- constructor or a datatype where each constructor is nullary let (DCon _ _ minName fields _) = head cons (DCon _ _ maxName _ _) = last cons fieldsCount = length $ tysOfConFields fields (minRHS, maxRHS) = case fieldsCount of 0 -> (DConE minName, DConE maxName) _ -> let minEqnRHS = foldExp (DConE minName) (replicate fieldsCount (DVarE minBoundName)) maxEqnRHS = foldExp (DConE maxName) (replicate fieldsCount (DVarE maxBoundName)) in (minEqnRHS, maxEqnRHS) mk_rhs rhs = UFunction [DClause [] rhs] constraints <- inferConstraintsDef mb_ctxt (DConPr boundedName) ty cons return $ InstDecl { id_cxt = constraints , id_name = boundedName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [ (minBoundName, mk_rhs minRHS) , (maxBoundName, mk_rhs maxRHS) ] } singletons-2.5.1/src/Data/Singletons/Deriving/Enum.hs0000644000000000000000000000453507346545000020700 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Enum -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Enum instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Enum ( mkEnumInstance ) where import Language.Haskell.TH.Syntax import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar import Data.Singletons.Deriving.Util import Data.Singletons.Syntax import Data.Singletons.Util import Data.Singletons.Names import Control.Monad import Data.Maybe -- monadic for failure only mkEnumInstance :: DsMonad q => DerivDesc q mkEnumInstance mb_ctxt ty (DataDecl data_name tvbs cons) = do let data_ty = foldTypeTvbs (DConT data_name) tvbs non_vanilla <- isNonVanillaDataType data_ty cons when (null cons || any (\(DCon _ _ _ f _) -> non_vanilla || not (null $ tysOfConFields f)) cons) $ fail ("Can't derive Enum instance for " ++ pprint (typeToTH ty) ++ ".") n <- qNewName "n" let to_enum = UFunction [DClause [DVarPa n] (to_enum_rhs cons [0..])] to_enum_rhs [] _ = DVarE errorName `DAppE` DLitE (StringL "toEnum: bad argument") to_enum_rhs (DCon _ _ name _ _ : rest) (num:nums) = DCaseE (DVarE equalsName `DAppE` DVarE n `DAppE` DLitE (IntegerL num)) [ DMatch (DConPa trueName []) (DConE name) , DMatch (DConPa falseName []) (to_enum_rhs rest nums) ] to_enum_rhs _ _ = error "Internal error: exhausted infinite list in to_enum_rhs" from_enum = UFunction (zipWith (\i con -> DClause [DConPa (extractName con) []] (DLitE (IntegerL i))) [0..] cons) return (InstDecl { id_cxt = fromMaybe [] mb_ctxt , id_name = singletonsEnumName -- need to use singletons's Enum class to get the types -- to use Nat instead of Int , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [ (singletonsToEnumName, to_enum) , (singletonsFromEnumName, from_enum) ] }) singletons-2.5.1/src/Data/Singletons/Deriving/Foldable.hs0000644000000000000000000000736007346545000021503 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Foldable -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Foldable instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Foldable where import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Data.Singletons.Names import Data.Singletons.Syntax import Language.Haskell.TH.Desugar mkFoldableInstance :: forall q. DsMonad q => DerivDesc q mkFoldableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do functorLikeValidityChecks False dd f <- newUniqueName "_f" z <- newUniqueName "_z" let ft_foldMap :: FFoldType (q DExp) ft_foldMap = FT { ft_triv = mkSimpleLam $ \_ -> pure $ DVarE memptyName -- foldMap f = \x -> mempty , ft_var = pure $ DVarE f -- foldMap f = f , ft_ty_app = \_ g -> DAppE (DVarE foldMapName) <$> g -- foldMap f = foldMap g , ft_forall = \_ g -> g , ft_bad_app = error "in other argument in ft_foldMap" } ft_foldr :: FFoldType (q DExp) ft_foldr = FT { ft_triv = mkSimpleLam2 $ \_ z' -> pure z' -- foldr f = \x z -> z , ft_var = pure $ DVarE f -- foldr f = f , ft_ty_app = \_ g -> do gg <- g mkSimpleLam2 $ \x z' -> pure $ DVarE foldrName `DAppE` gg `DAppE` z' `DAppE` x -- foldr f = (\x z -> foldr g z x) , ft_forall = \_ g -> g , ft_bad_app = error "in other argument in ft_foldr" } clause_for_foldMap :: [DPat] -> DCon -> [DExp] -> q DClause clause_for_foldMap = mkSimpleConClause $ \_ -> mkFoldMap where -- mappend v1 (mappend v2 ..) mkFoldMap :: [DExp] -> DExp mkFoldMap [] = DVarE memptyName mkFoldMap xs = foldr1 (\x y -> DVarE mappendName `DAppE` x `DAppE` y) xs clause_for_foldr :: [DPat] -> DCon -> [DExp] -> q DClause clause_for_foldr = mkSimpleConClause $ \_ -> mkFoldr where -- g1 v1 (g2 v2 (.. z)) mkFoldr :: [DExp] -> DExp mkFoldr = foldr DAppE (DVarE z) mk_foldMap_clause :: DCon -> q DClause mk_foldMap_clause con = do parts <- foldDataConArgs ft_foldMap con clause_for_foldMap [DVarPa f] con =<< sequence parts mk_foldr_clause :: DCon -> q DClause mk_foldr_clause con = do parts <- foldDataConArgs ft_foldr con clause_for_foldr [DVarPa f, DVarPa z] con =<< sequence parts mk_foldMap :: q [DClause] mk_foldMap = case cons of [] -> pure [DClause [DWildPa, DWildPa] (DVarE memptyName)] _ -> traverse mk_foldMap_clause cons mk_foldr :: q [DClause] mk_foldr = traverse mk_foldr_clause cons foldMap_clauses <- mk_foldMap foldr_clauses <- mk_foldr let meths = (foldMapName, UFunction foldMap_clauses) : case cons of [] -> [] _ -> [(foldrName, UFunction foldr_clauses)] constraints <- inferConstraintsDef mb_ctxt (DConPr foldableName) ty cons return $ InstDecl { id_cxt = constraints , id_name = foldableName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = meths } singletons-2.5.1/src/Data/Singletons/Deriving/Functor.hs0000644000000000000000000000737207346545000021416 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Functor -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Functor instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Functor where import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Data.Singletons.Names import Data.Singletons.Syntax import Data.Singletons.Util import Language.Haskell.TH.Desugar mkFunctorInstance :: forall q. DsMonad q => DerivDesc q mkFunctorInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do functorLikeValidityChecks False dd f <- newUniqueName "_f" z <- newUniqueName "_z" let ft_fmap :: FFoldType (q DExp) ft_fmap = FT { ft_triv = mkSimpleLam pure -- fmap f = \x -> x , ft_var = pure $ DVarE f -- fmap f = f , ft_ty_app = \_ g -> DAppE (DVarE fmapName) <$> g -- fmap f = fmap g , ft_forall = \_ g -> g , ft_bad_app = error "in other argument in ft_fmap" } ft_replace :: FFoldType (q Replacer) ft_replace = FT { ft_triv = fmap Nested $ mkSimpleLam pure -- (p <$) = \x -> x , ft_var = fmap Immediate $ mkSimpleLam $ \_ -> pure $ DVarE z -- (p <$) = const p , ft_ty_app = \_ gm -> do g <- gm case g of Nested g' -> pure . Nested $ DVarE fmapName `DAppE` g' Immediate _ -> pure . Nested $ DVarE replaceName `DAppE` DVarE z -- (p <$) = fmap (p <$) , ft_forall = \_ g -> g , ft_bad_app = error "in other argument in ft_replace" } -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ... clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause clause_for_con = mkSimpleConClause $ \con_name -> foldExp (DConE con_name) -- Con x1 x2 ... mk_fmap_clause :: DCon -> q DClause mk_fmap_clause con = do parts <- foldDataConArgs ft_fmap con clause_for_con [DVarPa f] con =<< sequence parts mk_replace_clause :: DCon -> q DClause mk_replace_clause con = do parts <- foldDataConArgs ft_replace con clause_for_con [DVarPa z] con =<< traverse (fmap replace) parts mk_fmap :: q [DClause] mk_fmap = case cons of [] -> do v <- newUniqueName "v" pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] _ -> traverse mk_fmap_clause cons mk_replace :: q [DClause] mk_replace = case cons of [] -> do v <- newUniqueName "v" pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] _ -> traverse mk_replace_clause cons fmap_clauses <- mk_fmap replace_clauses <- mk_replace constraints <- inferConstraintsDef mb_ctxt (DConPr functorName) ty cons return $ InstDecl { id_cxt = constraints , id_name = functorName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [ (fmapName, UFunction fmap_clauses) , (replaceName, UFunction replace_clauses) ] } data Replacer = Immediate { replace :: DExp } | Nested { replace :: DExp } singletons-2.5.1/src/Data/Singletons/Deriving/Infer.hs0000644000000000000000000001652007346545000021034 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Infer -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Infers constraints for a `deriving` class -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Infer ( inferConstraints, inferConstraintsDef ) where import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax import Data.Singletons.Deriving.Util import Data.Singletons.Util import Data.List import Data.List.NonEmpty (NonEmpty(..)) import Data.Generics.Twins -- @inferConstraints cls inst_ty cons@ infers the instance context for a -- derived type class instance of @cls@ for @inst_ty@, using the constructors -- @cons@. For instance, if @cls@ is 'Ord' and @inst_ty@ is @Either a b@, then -- that means we are attempting to derive the instance: -- -- @ -- instance ??? => Ord (Either a b) -- @ -- -- The role of 'inferConstraints' is to determine what @???@ should be in that -- derived instance. To accomplish this, the list of @cons@ (in this example, -- @cons@ would be @[Left a, Right b]@) is used as follows: -- -- 1. For each @con@ in @cons@, find the types of each of its fields -- (call these @field_tys@), perhaps after renaming the type variables of -- @field_tys@. -- 2. For each @field_ty@ in @field_tys@, apply @cls@ to @field_ty@ to obtain -- a constraint. -- 3. The final instance context is the set of all such constraints obtained -- in step 2. -- -- To complete the running example, this algorithm would produce the instance -- context @(Ord a, Ord b)@, since @Left a@ has one field of type @a@, and -- @Right b@ has one field of type @b@. -- -- This algorithm is a crude approximation of what GHC actually does when -- deriving instances. It is crude in the sense that one can end up with -- redundant constraints. For instance, if the data type for which an 'Ord' -- instance is being derived is @data Foo = MkFoo Bool Foo@, then the -- inferred constraints would be @(Ord Bool, Ord Foo)@. Technically, neither -- constraint is necessary, but it is not simple in general to eliminate -- redundant constraints like these, so we do not attept to do so. (This is -- one reason why @singletons@ requires the use of the @UndecidableInstances@ -- GHC extension.) -- -- Observant readers will notice that the phrase \"perhaps afer renaming the -- type variables\" was casually dropped in step 1 of the above algorithm. -- For more information on what this means, refer to the documentation for -- infer_ct below. inferConstraints :: forall q. DsMonad q => DPred -> DType -> [DCon] -> q DCxt inferConstraints pr inst_ty = fmap (nubBy geq) . concatMapM infer_ct where -- A thorny situation arises when attempting to infer an instance context -- for a GADT. Consider the following example: -- -- newtype Bar a where -- MkBar :: b -> Bar b -- deriving Show -- -- If we blindly apply 'Show' to the field type of @MkBar@, we will end up -- with a derived instance of: -- -- instance Show b => Show (Bar a) -- -- This is completely wrong, since the type variable @b@ is never used in -- the instance head! This reveals that we need a slightly more nuanced -- strategy for gathering constraints for GADT constructors. To account -- for this, when gathering @field_tys@ (from step 1 in the above algorithm) -- we perform the following extra steps: -- -- 1(a). Take the return type of @con@ and match it with @inst_ty@ (e.g., -- match @Bar b@ with @Bar a@). Doing so will produce a substitution -- that maps the universally quantified type variables in the GADT -- (i.e., @b@) to the corresponding type variables in the data type -- constructor (i.e., @a@). -- 1(b). Use the resulting substitution to rename the universally -- quantified type variables of @con@ as necessary. -- -- After this renaming, the algorithm will produce an instance context of -- @Show a@ (since @b@ was renamed to @a@), as expected. infer_ct :: DCon -> q DCxt infer_ct (DCon _ _ _ fields res_ty) = do let field_tys = tysOfConFields fields -- We need to match the constructor's result type with the type given -- in the generated instance. But if we have: -- -- data Foo a where -- MkFoo :: a -> Foo a -- deriving Functor -- -- Then the generated instance will be: -- -- instance Functor Foo where ... -- -- Which means that if we're not careful, we might try to match the -- types (Foo a) and (Foo), which will fail. -- -- To avoid this, we employ a grimy hack where we pad the instance -- type with an extra (dummy) type variable. It doesn't matter what -- we name it, since none of the inferred constraints will mention -- it anyway. eta_expanded_inst_ty | is_functor_like = inst_ty `DAppT` DVarT (mkName "dummy") | otherwise = inst_ty res_ty' <- expandType res_ty inst_ty' <- expandType eta_expanded_inst_ty field_tys' <- case matchTy YesIgnore res_ty' inst_ty' of Nothing -> fail $ showString "Unable to match type " . showsPrec 11 res_ty' . showString " with " . showsPrec 11 inst_ty' $ "" Just subst -> traverse (substTy subst) field_tys if is_functor_like then mk_functor_like_constraints field_tys' res_ty' else pure $ map (pr `DAppPr`) field_tys' -- If we derive a Functor-like class, e.g., -- -- data Foo f g h a = MkFoo (f a) (g (h a)) deriving Functor -- -- Then we infer constraints by sticking Functor on the subtypes of kind -- (Type -> Type). In the example above, that would give us -- (Functor f, Functor g, Functor h). mk_functor_like_constraints :: [DType] -> DType -> q DCxt mk_functor_like_constraints fields res_ty = do -- This function is partial. But that's OK, because -- functorLikeValidityChecks ensures that this is total by the time -- we invoke this. let _ :| res_ty_args = unfoldType res_ty (_, last_res_ty_arg) = snocView res_ty_args Just last_tv = getDVarTName_maybe last_res_ty_arg deep_subtypes <- concatMapM (deepSubtypesContaining last_tv) fields pure $ map (pr `DAppPr`) deep_subtypes is_functor_like :: Bool is_functor_like | DConT pr_class_name :| _ <- unfoldType (predToType pr) = isFunctorLikeClassName pr_class_name | otherwise = False -- For @inferConstraintsDef mb_cxt@, if @mb_cxt@ is 'Just' a context, then it will -- simply return that context. Otherwise, if @mb_cxt@ is 'Nothing', then -- 'inferConstraintsDef' will infer an instance context (using 'inferConstraints'). inferConstraintsDef :: DsMonad q => Maybe DCxt -> DPred -> DType -> [DCon] -> q DCxt inferConstraintsDef mb_ctxt pr inst_ty cons = maybe (inferConstraints pr inst_ty cons) pure mb_ctxt singletons-2.5.1/src/Data/Singletons/Deriving/Ord.hs0000644000000000000000000000611207346545000020511 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Ord -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Ord instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Ord ( mkOrdInstance ) where import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Util import Language.Haskell.TH.Syntax import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Data.Singletons.Syntax -- | Make a *non-singleton* Ord instance mkOrdInstance :: DsMonad q => DerivDesc q mkOrdInstance mb_ctxt ty (DataDecl _ _ cons) = do constraints <- inferConstraintsDef mb_ctxt (DConPr ordName) ty cons compare_eq_clauses <- mapM mk_equal_clause cons let compare_noneq_clauses = map (uncurry mk_nonequal_clause) [ (con1, con2) | con1 <- zip cons [1..] , con2 <- zip cons [1..] , extractName (fst con1) /= extractName (fst con2) ] clauses | null cons = [mk_empty_clause] | otherwise = compare_eq_clauses ++ compare_noneq_clauses return (InstDecl { id_cxt = constraints , id_name = ordName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [(compareName, UFunction clauses)] }) mk_equal_clause :: Quasi q => DCon -> q DClause mk_equal_clause (DCon _tvbs _cxt name fields _rty) = do let tys = tysOfConFields fields a_names <- mapM (const $ newUniqueName "a") tys b_names <- mapM (const $ newUniqueName "b") tys let pat1 = DConPa name (map DVarPa a_names) pat2 = DConPa name (map DVarPa b_names) return $ DClause [pat1, pat2] (DVarE foldlName `DAppE` DVarE thenCmpName `DAppE` DConE cmpEQName `DAppE` mkListE (zipWith (\a b -> DVarE compareName `DAppE` DVarE a `DAppE` DVarE b) a_names b_names)) mk_nonequal_clause :: (DCon, Int) -> (DCon, Int) -> DClause mk_nonequal_clause (DCon _tvbs1 _cxt1 name1 fields1 _rty1, n1) (DCon _tvbs2 _cxt2 name2 fields2 _rty2, n2) = DClause [pat1, pat2] (case n1 `compare` n2 of LT -> DConE cmpLTName EQ -> DConE cmpEQName GT -> DConE cmpGTName) where pat1 = DConPa name1 (map (const DWildPa) (tysOfConFields fields1)) pat2 = DConPa name2 (map (const DWildPa) (tysOfConFields fields2)) -- A variant of mk_equal_clause tailored to empty datatypes mk_empty_clause :: DClause mk_empty_clause = DClause [DWildPa, DWildPa] (DConE cmpEQName) singletons-2.5.1/src/Data/Singletons/Deriving/Show.hs0000644000000000000000000001554107346545000020713 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Show -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Show instances -- ---------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables #-} module Data.Singletons.Deriving.Show ( mkShowInstance , mkShowSingContext ) where import Language.Haskell.TH.Syntax hiding (showName) import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Util import Data.Singletons.Syntax import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Data.Maybe (fromMaybe) import GHC.Lexeme (startsConSym, startsVarSym) import GHC.Show (appPrec, appPrec1) mkShowInstance :: DsMonad q => DerivDesc q mkShowInstance mb_ctxt ty (DataDecl _ _ cons) = do clauses <- mk_showsPrec cons constraints <- inferConstraintsDef mb_ctxt (DConPr showName) ty cons return $ InstDecl { id_cxt = constraints , id_name = showName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [ (showsPrecName, UFunction clauses) ] } mk_showsPrec :: DsMonad q => [DCon] -> q [DClause] mk_showsPrec cons = do p <- newUniqueName "p" -- The precedence argument (not always used) if null cons then do v <- newUniqueName "v" pure [DClause [DWildPa, DVarPa v] (DCaseE (DVarE v) [])] else mapM (mk_showsPrec_clause p) cons mk_showsPrec_clause :: forall q. DsMonad q => Name -> DCon -> q DClause mk_showsPrec_clause p (DCon _ _ con_name con_fields _) = go con_fields where go :: DConFields -> q DClause -- No fields: print just the constructor name, with no parentheses go (DNormalC _ []) = return $ DClause [DWildPa, DConPa con_name []] $ DVarE showStringName `DAppE` dStringE (parenInfixConName con_name "") -- Infix constructors have special Show treatment. go (DNormalC True [_, _]) = do argL <- newUniqueName "argL" argR <- newUniqueName "argR" fi <- fromMaybe defaultFixity <$> reifyFixityWithLocals con_name let con_prec = case fi of Fixity prec _ -> prec op_name = nameBase con_name infixOpE = DAppE (DVarE showStringName) . dStringE $ if isInfixDataCon op_name then " " ++ op_name ++ " " -- Make sure to handle infix data constructors -- like (Int `Foo` Int) else " `" ++ op_name ++ "` " return $ DClause [DVarPa p, DConPa con_name [DVarPa argL, DVarPa argR]] $ (DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE con_prec)) `DAppE` (DVarE composeName `DAppE` showsPrecE (con_prec + 1) argL `DAppE` (DVarE composeName `DAppE` infixOpE `DAppE` showsPrecE (con_prec + 1) argR)) go (DNormalC _ tys) = do args <- mapM (const $ newUniqueName "arg") tys let show_args = map (showsPrecE appPrec1) args composed_args = foldr1 (\v q -> DVarE composeName `DAppE` v `DAppE` (DVarE composeName `DAppE` DVarE showSpaceName `DAppE` q)) show_args named_args = DVarE composeName `DAppE` (DVarE showStringName `DAppE` dStringE (parenInfixConName con_name " ")) `DAppE` composed_args return $ DClause [DVarPa p, DConPa con_name $ map DVarPa args] $ DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec) `DAppE` named_args -- We show a record constructor with no fields the same way we'd show a -- normal constructor with no fields. go (DRecC []) = go (DNormalC False []) go (DRecC tys) = do args <- mapM (const $ newUniqueName "arg") tys let show_args = concatMap (\((arg_name, _, _), arg) -> let arg_nameBase = nameBase arg_name infix_rec = showParen (isSym arg_nameBase) (showString arg_nameBase) "" in [ DVarE showStringName `DAppE` dStringE (infix_rec ++ " = ") , showsPrecE 0 arg , DVarE showCommaSpaceName ]) (zip tys args) brace_comma_args = (DVarE showCharName `DAppE` dCharE '{') : take (length show_args - 1) show_args composed_args = foldr (\x y -> DVarE composeName `DAppE` x `DAppE` y) (DVarE showCharName `DAppE` dCharE '}') brace_comma_args named_args = DVarE composeName `DAppE` (DVarE showStringName `DAppE` dStringE (parenInfixConName con_name " ")) `DAppE` composed_args return $ DClause [DVarPa p, DConPa con_name $ map DVarPa args] $ DVarE showParenName `DAppE` (DVarE gtName `DAppE` DVarE p `DAppE` dIntegerE appPrec) `DAppE` named_args -- | Parenthesize an infix constructor name if it is being applied as a prefix -- function (e.g., data Amp a = (:&) a a) parenInfixConName :: Name -> ShowS parenInfixConName conName = let conNameBase = nameBase conName in showParen (isInfixDataCon conNameBase) $ showString conNameBase showsPrecE :: Int -> Name -> DExp showsPrecE prec n = DVarE showsPrecName `DAppE` dIntegerE prec `DAppE` DVarE n dCharE :: Char -> DExp dCharE c = DLitE $ StringL [c] -- There aren't type-level characters yet, -- so fake it with a string dStringE :: String -> DExp dStringE = DLitE . StringL dIntegerE :: Int -> DExp dIntegerE = DLitE . IntegerL . fromIntegral isSym :: String -> Bool isSym "" = False isSym (c : _) = startsVarSym c || startsConSym c -- | Turn a context like @('Show' a, 'Show' b)@ into @('ShowSing' a, 'ShowSing' b)@. -- This is necessary for standalone-derived 'Show' instances for singleton types. mkShowSingContext :: DCxt -> DCxt mkShowSingContext = map show_to_SingShow where show_to_SingShow :: DPred -> DPred show_to_SingShow = modifyConNameDPred $ \n -> if n == showName then showSingName else n singletons-2.5.1/src/Data/Singletons/Deriving/Traversable.hs0000644000000000000000000000536207346545000022245 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Traversable -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Implements deriving of Traversable instances -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Traversable where import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Util import Data.Singletons.Names import Data.Singletons.Syntax import Language.Haskell.TH.Desugar mkTraversableInstance :: forall q. DsMonad q => DerivDesc q mkTraversableInstance mb_ctxt ty dd@(DataDecl _ _ cons) = do functorLikeValidityChecks False dd f <- newUniqueName "_f" let ft_trav :: FFoldType (q DExp) ft_trav = FT { ft_triv = pure $ DVarE pureName -- traverse f = pure x , ft_var = pure $ DVarE f -- traverse f = f x , ft_ty_app = \_ g -> DAppE (DVarE traverseName) <$> g -- traverse f = traverse g , ft_forall = \_ g -> g , ft_bad_app = error "in other argument in ft_trav" } -- Con a1 a2 ... -> Con <$> g1 a1 <*> g2 a2 <*> ... clause_for_con :: [DPat] -> DCon -> [DExp] -> q DClause clause_for_con = mkSimpleConClause $ \con_name -> mkApCon (DConE con_name) where -- ((Con <$> x1) <*> x2) <*> ... mkApCon :: DExp -> [DExp] -> DExp mkApCon con [] = DVarE pureName `DAppE` con mkApCon con [x] = DVarE fmapName `DAppE` con `DAppE` x mkApCon con (x1:x2:xs) = foldl appAp (DVarE liftA2Name `DAppE` con `DAppE` x1 `DAppE` x2) xs where appAp x y = DVarE apName `DAppE` x `DAppE` y mk_trav_clause :: DCon -> q DClause mk_trav_clause con = do parts <- foldDataConArgs ft_trav con clause_for_con [DVarPa f] con =<< sequence parts mk_trav :: q [DClause] mk_trav = case cons of [] -> do v <- newUniqueName "v" pure [DClause [DWildPa, DVarPa v] (DVarE pureName `DAppE` DCaseE (DVarE v) [])] _ -> traverse mk_trav_clause cons trav_clauses <- mk_trav constraints <- inferConstraintsDef mb_ctxt (DConPr traversableName) ty cons return $ InstDecl { id_cxt = constraints , id_name = traversableName , id_arg_tys = [ty] , id_sigs = mempty , id_meths = [ (traverseName, UFunction trav_clauses) ] } singletons-2.5.1/src/Data/Singletons/Deriving/Util.hs0000644000000000000000000002671207346545000020712 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Deriving.Util -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Utilities used by the `deriving` machinery in singletons. -- ---------------------------------------------------------------------------- module Data.Singletons.Deriving.Util where import Control.Monad import Data.List import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Set as Set import Data.Singletons.Names import Data.Singletons.Syntax import Data.Singletons.Util import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax -- A generic type signature for describing how to produce a derived instance. type DerivDesc q = Maybe DCxt -- (Just ctx) if ctx was provided via StandaloneDeriving. -- Nothing if using a deriving clause. -> DType -- The data type argument to the class. -> DataDecl -- The original data type information. -> q UInstDecl -- The derived instance. -- | Is this data type a non-vanilla data type? Here, \"non-vanilla\" refers to -- any data type that cannot be expressed using Haskell98 syntax. For instance, -- this GADT: -- -- @ -- data Foo :: Type -> Type where -- MkFoo :: forall a. a -> Foo a -- @ -- -- Is equivalent to this Haskell98 data type: -- -- @ -- data Foo a = MkFoo a -- @ -- -- However, the following GADT is non-vanilla: -- -- @ -- data Bar :: Type -> Type where -- MkBar :: Int -> Bar Int -- @ -- -- Since there is no equivalent Haskell98 data type. The closest you could get -- is this: -- -- @ -- data Bar a = (a ~ Int) => MkBar Int -- @ -- -- Which requires language extensions to write. -- -- A data type is a non-vanilla if one of the following conditions are met: -- -- 1. A constructor has any existentially quantified type variables. -- -- 2. A constructor has a context. -- -- We care about this because some derivable stock classes, such as 'Enum', -- forbid derived instances for non-vanilla data types. isNonVanillaDataType :: forall q. DsMonad q => DType -> [DCon] -> q Bool isNonVanillaDataType data_ty = anyM $ \con@(DCon _ ctxt _ _ _) -> do ex_tvbs <- conExistentialTvbs data_ty con return $ not $ null ex_tvbs && null ctxt where anyM :: (a -> q Bool) -> [a] -> q Bool anyM _ [] = return False anyM p (x:xs) = do b <- p x if b then return True else anyM p xs ----- -- Utilities for deriving Functor-like classes. -- Much of this was cargo-culted from the GHC source code. ----- data FFoldType a -- Describes how to fold over a DType in a functor like way = FT { ft_triv :: a -- ^ Does not contain variable , ft_var :: a -- ^ The variable itself , ft_ty_app :: DType -> a -> a -- ^ Type app, variable only in last argument , ft_bad_app :: a -- ^ Type app, variable other than in last argument , ft_forall :: [DTyVarBndr] -> a -> a -- ^ Forall type } -- Note that in GHC, this function is pure. It must be monadic here since we: -- -- (1) Expand type synonyms -- (2) Detect type family applications -- -- Which require reification in Template Haskell, but are pure in Core. functorLikeTraverse :: forall q a. DsMonad q => Name -- ^ Variable to look for -> FFoldType a -- ^ How to fold -> DType -- ^ Type to process -> q a functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar , ft_ty_app = caseTyApp, ft_bad_app = caseWrongArg , ft_forall = caseForAll }) ty = do ty' <- expandType ty (res, _) <- go ty' pure res where go :: DType -> q (a, Bool) -- (result of type a, does type contain var) go (DAppT f x) = do (_, fc) <- go f if fc then pure (caseWrongArg, True) else do (xr, xc) <- go x if xc then let tyApp :: q (a, Bool) tyApp = pure (caseTyApp f xr, True) inspect :: DType -> q (a, Bool) inspect (DConT n) = do itf <- isTyFamilyName n if itf -- We can't decompose type families, so -- error if we encounter one here. then pure (caseWrongArg, True) else tyApp inspect (DForallT _ _ t) = inspect t inspect (DSigT t _) = inspect t inspect (DAppT t _) = inspect t inspect (DVarT {}) = tyApp inspect DArrowT = tyApp inspect (DLitT {}) = tyApp inspect DWildCardT = tyApp in case unfoldType f of f_head :| _ -> inspect f_head else trivial go (DSigT t k) = do (_, kc) <- go k if kc then pure (caseWrongArg, True) else go t go (DVarT v) | v == var = pure (caseVar, True) | otherwise = trivial go (DForallT tvbs _ t) = do (tr, tc) <- go t if var `notElem` map extractTvbName tvbs && tc then pure (caseForAll tvbs tr, True) else trivial go (DConT {}) = trivial go DArrowT = trivial go (DLitT {}) = trivial go DWildCardT = trivial trivial :: q (a, Bool) trivial = pure (caseTrivial, False) isTyFamilyName :: DsMonad q => Name -> q Bool isTyFamilyName n = do info <- dsReify n pure $ case info of Just (DTyConI dec _) | DOpenTypeFamilyD{} <- dec -> True | DClosedTypeFamilyD{} <- dec -> True _ -> False -- A crude approximation of cond_functorOK from GHC. This checks that: -- -- (1) There's at least one type variable in the data type. -- (2) It doesn't use the last type variable in the wrong place, e.g. data T a = MkT (X a a) -- (3) It doesn't constrain the last type variable, e.g., data T a = Eq a => MkT a functorLikeValidityChecks :: forall q. DsMonad q => Bool -> DataDecl -> q () functorLikeValidityChecks allowConstrainedLastTyVar (DataDecl n data_tvbs cons) | null data_tvbs -- (1) = fail $ "Data type " ++ nameBase n ++ " must have some type parameters" | otherwise = mapM_ check_con cons where check_con :: DCon -> q () check_con con = do check_universal con checks <- foldDataConArgs (ft_check (extractName con)) con sequence_ checks -- (2) check_universal :: DCon -> q () check_universal con@(DCon con_tvbs con_theta con_name _ res_ty) | allowConstrainedLastTyVar = pure () | _ :| res_ty_args <- unfoldType res_ty , (_, last_res_ty_arg) <- snocView res_ty_args , Just last_tv <- getDVarTName_maybe last_res_ty_arg = do ex_tvbs <- conExistentialTvbs (foldTypeTvbs (DConT n) data_tvbs) con let univ_tvb_names = map extractTvbName con_tvbs \\ map extractTvbName ex_tvbs if last_tv `elem` univ_tvb_names && last_tv `Set.notMember` foldMap (fvDType . predToType) con_theta then pure () else fail $ badCon con_name existential | otherwise = fail $ badCon con_name existential -- (3) ft_check :: Name -> FFoldType (q ()) ft_check con_name = FT { ft_triv = pure () , ft_var = pure () , ft_ty_app = \_ x -> x , ft_bad_app = fail $ badCon con_name wrong_arg , ft_forall = \_ x -> x } badCon :: Name -> String -> String badCon con_name msg = "Constructor " ++ nameBase con_name ++ " " ++ msg existential, wrong_arg :: String existential = "must be truly polymorphic in the last argument of the data type" wrong_arg = "must use the type variable only as the last argument of a data type" -- Return all syntactic subterms of a type that contain the given variable somewhere. -- These are the things that should appear in Functor-like instance constraints. deepSubtypesContaining :: DsMonad q => Name -> DType -> q [DType] deepSubtypesContaining tv = functorLikeTraverse tv (FT { ft_triv = [] , ft_var = [] , ft_ty_app = (:) , ft_bad_app = error "in other argument in deepSubtypesContaining" , ft_forall = \tvbs xs -> filter (\x -> all (not_in_ty x) tvbs) xs }) where not_in_ty :: DType -> DTyVarBndr -> Bool not_in_ty ty tvb = extractTvbName tvb `Set.notMember` fvDType ty -- Fold over the arguments of a data constructor in a Functor-like way. foldDataConArgs :: forall q a. DsMonad q => FFoldType a -> DCon -> q [a] foldDataConArgs ft (DCon _ _ _ fields res_ty) = do field_tys <- traverse expandType $ tysOfConFields fields traverse foldArg field_tys where foldArg :: DType -> q a foldArg | _ :| res_ty_args <- unfoldType res_ty , (_, last_res_ty_arg) <- snocView res_ty_args , Just last_tv <- getDVarTName_maybe last_res_ty_arg = functorLikeTraverse last_tv ft | otherwise = const (return (ft_triv ft)) -- If a type is a type variable (or a variable with a kind signature), return -- 'Just' that. Otherwise, return 'Nothing'. getDVarTName_maybe :: DType -> Maybe Name getDVarTName_maybe (DSigT t _) = getDVarTName_maybe t getDVarTName_maybe (DVarT n) = Just n getDVarTName_maybe _ = Nothing -- Make a 'DLamE' using a fresh variable. mkSimpleLam :: Quasi q => (DExp -> q DExp) -> q DExp mkSimpleLam lam = do n <- newUniqueName "n" body <- lam (DVarE n) return $ DLamE [n] body -- Make a 'DLamE' using two fresh variables. mkSimpleLam2 :: Quasi q => (DExp -> DExp -> q DExp) -> q DExp mkSimpleLam2 lam = do n1 <- newUniqueName "n1" n2 <- newUniqueName "n2" body <- lam (DVarE n1) (DVarE n2) return $ DLamE [n1, n2] body -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" -- -- @mkSimpleConClause fold extra_pats con insides@ produces a match clause in -- which the LHS pattern-matches on @extra_pats@, followed by a match on the -- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@ -- and its arguments, applying an expression (from @insides@) to each of the -- respective arguments of @con@. mkSimpleConClause :: Quasi q => (Name -> [DExp] -> DExp) -> [DPat] -> DCon -> [DExp] -> q DClause mkSimpleConClause fold extra_pats (DCon _ _ con_name _ _) insides = do vars_needed <- replicateM (length insides) $ newUniqueName "a" let pat = DConPa con_name (map DVarPa vars_needed) rhs = fold con_name (zipWith (\i v -> i `DAppE` DVarE v) insides vars_needed) pure $ DClause (extra_pats ++ [pat]) rhs -- 'True' if the derived class's last argument is of kind (Type -> Type), -- and thus needs a different constraint inference approach. -- -- Really, we should be determining this information by inspecting the kind -- of the class being used. But that comes dangerously close to kind -- inference territory, so for now we simply hardcode which stock derivable -- classes are Functor-like. isFunctorLikeClassName :: Name -> Bool isFunctorLikeClassName class_name = class_name `elem` [functorName, foldableName, traversableName] singletons-2.5.1/src/Data/Singletons/Internal.hs0000644000000000000000000004154107346545000017777 0ustar0000000000000000{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds, FlexibleContexts, FlexibleInstances, TypeFamilies, TypeOperators, TypeFamilyDependencies, UndecidableInstances, ConstraintKinds, ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes, PatternSynonyms, ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Internal -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- This module exports the basic definitions to use singletons. This module -- exists since we need to define instances for 'SomeSing' in -- "Data.Singletons", as defining them elsewhere would almost inevitably lead -- to import cycles. -- ---------------------------------------------------------------------------- module Data.Singletons.Internal ( module Data.Singletons.Internal , Proxy(..) ) where import Data.Kind (Type) import Unsafe.Coerce import Data.Proxy ( Proxy(..) ) import GHC.Exts ( Proxy#, Constraint ) -- | Convenient synonym to refer to the kind of a type variable: -- @type KindOf (a :: k) = k@ type KindOf (a :: k) = k -- | Force GHC to unify the kinds of @a@ and @b@. Note that @SameKind a b@ is -- different from @KindOf a ~ KindOf b@ in that the former makes the kinds -- unify immediately, whereas the latter is a proposition that GHC considers -- as possibly false. type SameKind (a :: k) (b :: k) = (() :: Constraint) ---------------------------------------------------------------------- ---- Sing & friends -------------------------------------------------- ---------------------------------------------------------------------- -- | The singleton kind-indexed data family. data family Sing :: k -> Type -- | A 'SingI' constraint is essentially an implicitly-passed singleton. -- If you need to satisfy this constraint with an explicit singleton, please -- see 'withSingI' or the 'Sing' pattern synonym. class SingI a where -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ -- extension to use this method the way you want. sing :: Sing a -- | An explicitly bidirectional pattern synonym for implicit singletons. -- -- As an __expression__: Constructs a singleton @Sing a@ given a -- implicit singleton constraint @SingI a@. -- -- As a __pattern__: Matches on an explicit @Sing a@ witness bringing -- an implicit @SingI a@ constraint into scope. {-# COMPLETE Sing #-} pattern Sing :: forall k (a :: k). () => SingI a => Sing a pattern Sing <- (singInstance -> SingInstance) where Sing = sing -- | The 'SingKind' class is a /kind/ class. It classifies all kinds -- for which singletons are defined. The class supports converting between a singleton -- type and the base (unrefined) type which it is built from. -- -- For a 'SingKind' instance to be well behaved, it should obey the following laws: -- -- @ -- 'toSing' . 'fromSing' ≡ 'SomeSing' -- (\\x -> 'withSomeSing' x 'fromSing') ≡ 'id' -- @ -- -- The final law can also be expressed in terms of the 'FromSing' pattern -- synonym: -- -- @ -- (\\('FromSing' sing) -> 'FromSing' sing) ≡ 'id' -- @ class SingKind k where -- | Get a base type from the promoted kind. For example, -- @Demote Bool@ will be the type @Bool@. Rarely, the type and kind do not -- match. For example, @Demote Nat@ is @Natural@. type Demote k = (r :: Type) | r -> k -- | Convert a singleton to its unrefined version. fromSing :: Sing (a :: k) -> Demote k -- | Convert an unrefined type to an existentially-quantified singleton type. toSing :: Demote k -> SomeSing k -- | An /existentially-quantified/ singleton. This type is useful when you want a -- singleton type, but there is no way of knowing, at compile-time, what the type -- index will be. To make use of this type, you will generally have to use a -- pattern-match: -- -- > foo :: Bool -> ... -- > foo b = case toSing b of -- > SomeSing sb -> {- fancy dependently-typed code with sb -} -- -- An example like the one above may be easier to write using 'withSomeSing'. data SomeSing k where SomeSing :: Sing (a :: k) -> SomeSing k -- | An explicitly bidirectional pattern synonym for going between a -- singleton and the corresponding demoted term. -- -- As an __expression__: this takes a singleton to its demoted (base) -- type. -- -- >>> :t FromSing \@Bool -- FromSing \@Bool :: Sing a -> Bool -- >>> FromSing SFalse -- False -- -- As a __pattern__: It extracts a singleton from its demoted (base) -- type. -- -- @ -- singAnd :: 'Bool' -> 'Bool' -> 'SomeSing' 'Bool' -- singAnd ('FromSing' singBool1) ('FromSing' singBool2) = -- 'SomeSing' (singBool1 %&& singBool2) -- @ -- -- instead of writing it with 'withSomeSing': -- -- @ -- singAnd bool1 bool2 = -- 'withSomeSing' bool1 $ \singBool1 -> -- 'withSomeSing' bool2 $ \singBool2 -> -- 'SomeSing' (singBool1 %&& singBool2) -- @ {-# COMPLETE FromSing #-} pattern FromSing :: SingKind k => forall (a :: k). Sing a -> Demote k pattern FromSing sng <- ((\demotedVal -> withSomeSing demotedVal SomeSing) -> SomeSing sng) where FromSing sng = fromSing sng ---------------------------------------------------------------------- ---- SingInstance ---------------------------------------------------- ---------------------------------------------------------------------- -- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling. data SingInstance (a :: k) where SingInstance :: SingI a => SingInstance a -- dirty implementation of explicit-to-implicit conversion newtype DI a = Don'tInstantiate (SingI a => SingInstance a) -- | Get an implicit singleton (a 'SingI' instance) from an explicit one. singInstance :: forall k (a :: k). Sing a -> SingInstance a singInstance s = with_sing_i SingInstance where with_sing_i :: (SingI a => SingInstance a) -> SingInstance a with_sing_i si = unsafeCoerce (Don'tInstantiate si) s ---------------------------------------------------------------------- ---- Defunctionalization --------------------------------------------- ---------------------------------------------------------------------- -- | Representation of the kind of a type-level function. The difference -- between term-level arrows and this type-level arrow is that at the term -- level applications can be unsaturated, whereas at the type level all -- applications have to be fully saturated. data TyFun :: Type -> Type -> Type -- | Something of kind `a ~> b` is a defunctionalized type function that is -- not necessarily generative or injective. type a ~> b = TyFun a b -> Type infixr 0 ~> -- | Type level function application type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 -- | An infix synonym for `Apply` type a @@ b = Apply a b infixl 9 @@ -- | Workhorse for the 'TyCon1', etc., types. This can be used directly -- in place of any of the @TyConN@ types, but it will work only with -- /monomorphic/ types. When GHC#14645 is fixed, this should fully supersede -- the @TyConN@ types. data family TyCon :: (k1 -> k2) -> unmatchable_fun -- That unmatchable_fun should really be a function of k1 and k2, -- but GHC 8.4 doesn't support type family calls in the result kind -- of a data family. It should. See GHC#14645. -- The result kind of this is also a bit wrong; it should line -- up with unmatchable_fun above. However, we can't do that -- because GHC is too stupid to remember that f's kind can't -- have more than one argument when kind-checking the RHS of -- the second equation. Note that this infelicity is independent -- of the problem in the kind of TyCon. There is no GHC ticket -- here because dealing with inequality like this is hard, and -- I (Richard) wasn't sure what concrete value the ticket would -- have, given that we don't know how to begin fixing it. type family ApplyTyCon (f :: k1 -> k2) (x :: k1) :: k3 where ApplyTyCon (f :: k1 -> k2 -> k3) x = TyCon (f x) ApplyTyCon f x = f x type instance Apply (TyCon f) x = ApplyTyCon f x -- | Wrapper for converting the normal type-level arrow into a '~>'. -- For example, given: -- -- > data Nat = Zero | Succ Nat -- > type family Map (a :: a ~> b) (a :: [a]) :: [b] -- > Map f '[] = '[] -- > Map f (x ': xs) = Apply f x ': Map f xs -- -- We can write: -- -- > Map (TyCon1 Succ) [Zero, Succ Zero] type TyCon1 = (TyCon :: (k1 -> k2) -> (k1 ~> k2)) -- | Similar to 'TyCon1', but for two-parameter type constructors. type TyCon2 = (TyCon :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3)) type TyCon3 = (TyCon :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4)) type TyCon4 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5)) type TyCon5 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6)) type TyCon6 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7)) type TyCon7 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8)) type TyCon8 = (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9)) ---------------------------------------------------------------------- ---- Defunctionalized Sing instance and utilities -------------------- ---------------------------------------------------------------------- newtype instance Sing (f :: k1 ~> k2) = SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } -- | An infix synonym for `applySing` (@@) :: forall k1 k2 (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t) (@@) = applySing -- | Note that this instance's 'toSing' implementation crucially relies on the fact -- that the 'SingKind' instances for 'k1' and 'k2' both satisfy the 'SingKind' laws. -- If they don't, 'toSing' might produce strange results! instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where type Demote (k1 ~> k2) = Demote k1 -> Demote k2 fromSing sFun x = withSomeSing x (fromSing . applySing sFun) toSing f = SomeSing slam where -- Here, we are essentially "manufacturing" a type-level version of the -- function f. As long as k1 and k2 obey the SingKind laws, this is a -- perfectly fine thing to do, since the computational content of Sing f -- will be isomorphic to that of the function f. slam :: forall (f :: k1 ~> k2). Sing f slam = singFun1 @f lam where -- Here's the tricky part. We need to demote the argument Sing, apply the -- term-level function f to it, and promote it back to a Sing. However, -- we don't have a way to convince the typechecker that for all argument -- types t, f @@ t should be the same thing as res, which motivates the -- use of unsafeCoerce. lam :: forall (t :: k1). Sing t -> Sing (f @@ t) lam x = withSomeSing (f (fromSing x)) (\(r :: Sing res) -> unsafeCoerce r) type SingFunction1 f = forall t. Sing t -> Sing (f @@ t) -- | Use this function when passing a function on singletons as -- a higher-order function. You will need visible type application -- to get this to work. For example: -- -- > falses = sMap (singFun1 @NotSym0 sNot) -- > (STrue `SCons` STrue `SCons` SNil) -- -- There are a family of @singFun...@ functions, keyed by the number -- of parameters of the function. singFun1 :: forall f. SingFunction1 f -> Sing f singFun1 f = SLambda f type SingFunction2 f = forall t. Sing t -> SingFunction1 (f @@ t) singFun2 :: forall f. SingFunction2 f -> Sing f singFun2 f = SLambda (\x -> singFun1 (f x)) type SingFunction3 f = forall t. Sing t -> SingFunction2 (f @@ t) singFun3 :: forall f. SingFunction3 f -> Sing f singFun3 f = SLambda (\x -> singFun2 (f x)) type SingFunction4 f = forall t. Sing t -> SingFunction3 (f @@ t) singFun4 :: forall f. SingFunction4 f -> Sing f singFun4 f = SLambda (\x -> singFun3 (f x)) type SingFunction5 f = forall t. Sing t -> SingFunction4 (f @@ t) singFun5 :: forall f. SingFunction5 f -> Sing f singFun5 f = SLambda (\x -> singFun4 (f x)) type SingFunction6 f = forall t. Sing t -> SingFunction5 (f @@ t) singFun6 :: forall f. SingFunction6 f -> Sing f singFun6 f = SLambda (\x -> singFun5 (f x)) type SingFunction7 f = forall t. Sing t -> SingFunction6 (f @@ t) singFun7 :: forall f. SingFunction7 f -> Sing f singFun7 f = SLambda (\x -> singFun6 (f x)) type SingFunction8 f = forall t. Sing t -> SingFunction7 (f @@ t) singFun8 :: forall f. SingFunction8 f -> Sing f singFun8 f = SLambda (\x -> singFun7 (f x)) -- | This is the inverse of 'singFun1', and likewise for the other -- @unSingFun...@ functions. unSingFun1 :: forall f. Sing f -> SingFunction1 f unSingFun1 sf = applySing sf unSingFun2 :: forall f. Sing f -> SingFunction2 f unSingFun2 sf x = unSingFun1 (sf @@ x) unSingFun3 :: forall f. Sing f -> SingFunction3 f unSingFun3 sf x = unSingFun2 (sf @@ x) unSingFun4 :: forall f. Sing f -> SingFunction4 f unSingFun4 sf x = unSingFun3 (sf @@ x) unSingFun5 :: forall f. Sing f -> SingFunction5 f unSingFun5 sf x = unSingFun4 (sf @@ x) unSingFun6 :: forall f. Sing f -> SingFunction6 f unSingFun6 sf x = unSingFun5 (sf @@ x) unSingFun7 :: forall f. Sing f -> SingFunction7 f unSingFun7 sf x = unSingFun6 (sf @@ x) unSingFun8 :: forall f. Sing f -> SingFunction8 f unSingFun8 sf x = unSingFun7 (sf @@ x) {-# COMPLETE SLambda2 #-} pattern SLambda2 :: forall f. SingFunction2 f -> Sing f pattern SLambda2 {applySing2} <- (unSingFun2 -> applySing2) where SLambda2 lam2 = singFun2 lam2 {-# COMPLETE SLambda3 #-} pattern SLambda3 :: forall f. SingFunction3 f -> Sing f pattern SLambda3 {applySing3} <- (unSingFun3 -> applySing3) where SLambda3 lam3 = singFun3 lam3 {-# COMPLETE SLambda4 #-} pattern SLambda4 :: forall f. SingFunction4 f -> Sing f pattern SLambda4 {applySing4} <- (unSingFun4 -> applySing4) where SLambda4 lam4 = singFun4 lam4 {-# COMPLETE SLambda5 #-} pattern SLambda5 :: forall f. SingFunction5 f -> Sing f pattern SLambda5 {applySing5} <- (unSingFun5 -> applySing5) where SLambda5 lam5 = singFun5 lam5 {-# COMPLETE SLambda6 #-} pattern SLambda6 :: forall f. SingFunction6 f -> Sing f pattern SLambda6 {applySing6} <- (unSingFun6 -> applySing6) where SLambda6 lam6 = singFun6 lam6 {-# COMPLETE SLambda7 #-} pattern SLambda7 :: forall f. SingFunction7 f -> Sing f pattern SLambda7 {applySing7} <- (unSingFun7 -> applySing7) where SLambda7 lam7 = singFun7 lam7 {-# COMPLETE SLambda8 #-} pattern SLambda8 :: forall f. SingFunction8 f -> Sing f pattern SLambda8 {applySing8} <- (unSingFun8 -> applySing8) where SLambda8 lam8 = singFun8 lam8 ---------------------------------------------------------------------- ---- Convenience ----------------------------------------------------- ---------------------------------------------------------------------- -- | Convenience function for creating a context with an implicit singleton -- available. withSingI :: Sing n -> (SingI n => r) -> r withSingI sn r = case singInstance sn of SingInstance -> r -- | Convert a normal datatype (like 'Bool') to a singleton for that datatype, -- passing it into a continuation. withSomeSing :: forall k r . SingKind k => Demote k -- ^ The original datatype -> (forall (a :: k). Sing a -> r) -- ^ Function expecting a singleton -> r withSomeSing x f = case toSing x of SomeSing x' -> f x' -- | A convenience function useful when we need to name a singleton value -- multiple times. Without this function, each use of 'sing' could potentially -- refer to a different singleton, and one has to use type signatures (often -- with @ScopedTypeVariables@) to ensure that they are the same. withSing :: SingI a => (Sing a -> b) -> b withSing f = f sing -- | A convenience function that names a singleton satisfying a certain -- property. If the singleton does not satisfy the property, then the function -- returns 'Nothing'. The property is expressed in terms of the underlying -- representation of the singleton. singThat :: forall k (a :: k). (SingKind k, SingI a) => (Demote k -> Bool) -> Maybe (Sing a) singThat p = withSing $ \x -> if p (fromSing x) then Just x else Nothing -- | Allows creation of a singleton when a proxy is at hand. singByProxy :: SingI a => proxy a -> Sing a singByProxy _ = sing -- | Allows creation of a singleton when a @proxy#@ is at hand. singByProxy# :: SingI a => Proxy# a -> Sing a singByProxy# _ = sing -- | A convenience function that takes a type as input and demotes it to its -- value-level counterpart as output. This uses 'SingKind' and 'SingI' behind -- the scenes, so @'demote' = 'fromSing' 'sing'@. -- -- This function is intended to be used with @TypeApplications@. For example: -- -- >>> demote @True -- True -- -- >>> demote @(Nothing :: Maybe Ordering) -- Nothing demote :: forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a) demote = fromSing (sing @a) singletons-2.5.1/src/Data/Singletons/Names.hs0000644000000000000000000003041607346545000017265 0ustar0000000000000000{- Data/Singletons/Names.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu Defining names and manipulations on names for use in promotion and singling. -} {-# LANGUAGE TemplateHaskell #-} module Data.Singletons.Names where import Data.Singletons.Internal import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.Decide import Language.Haskell.TH.Syntax import Language.Haskell.TH.Desugar import GHC.TypeLits ( Nat, Symbol ) import GHC.Exts ( Constraint ) import GHC.Show ( showCommaSpace, showSpace ) import Data.Typeable ( TypeRep ) import Data.Singletons.Util import Control.Applicative import Control.Monad boolName, andName, tyEqName, compareName, minBoundName, maxBoundName, repName, nilName, consName, listName, tyFunArrowName, applyName, natName, symbolName, typeRepName, stringName, eqName, ordName, boundedName, orderingName, singFamilyName, singIName, singMethName, demoteName, singKindClassName, sEqClassName, sEqMethName, sconsName, snilName, strueName, sIfName, someSingTypeName, someSingDataName, sListName, sDecideClassName, sDecideMethName, provedName, disprovedName, reflName, toSingName, fromSingName, equalityName, applySingName, suppressClassName, suppressMethodName, thenCmpName, sameKindName, tyFromIntegerName, tyNegateName, sFromIntegerName, sNegateName, errorName, foldlName, cmpEQName, cmpLTName, cmpGTName, singletonsToEnumName, singletonsFromEnumName, enumName, singletonsEnumName, equalsName, constraintName, showName, showCharName, showCommaSpaceName, showParenName, showsPrecName, showSpaceName, showStringName, showSingName, composeName, gtName, tyFromStringName, sFromStringName, foldableName, foldMapName, memptyName, mappendName, foldrName, functorName, fmapName, replaceName, traversableName, traverseName, pureName, apName, liftA2Name :: Name boolName = ''Bool andName = '(&&) compareName = 'compare minBoundName = 'minBound maxBoundName = 'maxBound tyEqName = mk_name_tc "Data.Singletons.Prelude.Eq" "==" repName = mkName "Rep" -- this is actually defined in client code! nilName = '[] consName = '(:) listName = ''[] tyFunArrowName = ''(~>) applyName = ''Apply symbolName = ''Symbol natName = ''Nat typeRepName = ''TypeRep stringName = ''String eqName = ''Eq ordName = ''Ord boundedName = ''Bounded orderingName = ''Ordering singFamilyName = ''Sing singIName = ''SingI singMethName = 'sing toSingName = 'toSing fromSingName = 'fromSing demoteName = ''Demote singKindClassName = ''SingKind sEqClassName = mk_name_tc "Data.Singletons.Prelude.Eq" "SEq" sEqMethName = mk_name_v "Data.Singletons.Prelude.Eq" "%==" sIfName = mk_name_v "Data.Singletons.Prelude.Bool" "sIf" sconsName = mk_name_d "Data.Singletons.Prelude.Instances" "SCons" snilName = mk_name_d "Data.Singletons.Prelude.Instances" "SNil" strueName = mk_name_d "Data.Singletons.Prelude.Instances" "STrue" someSingTypeName = ''SomeSing someSingDataName = 'SomeSing sListName = mk_name_tc "Data.Singletons.Prelude.Instances" "SList" sDecideClassName = ''SDecide sDecideMethName = '(%~) provedName = 'Proved disprovedName = 'Disproved reflName = 'Refl equalityName = ''(~) applySingName = 'applySing suppressClassName = ''SuppressUnusedWarnings suppressMethodName = 'suppressUnusedWarnings thenCmpName = mk_name_v "Data.Singletons.Prelude.Ord" "thenCmp" sameKindName = ''SameKind tyFromIntegerName = mk_name_tc "Data.Singletons.Prelude.Num" "FromInteger" tyNegateName = mk_name_tc "Data.Singletons.Prelude.Num" "Negate" sFromIntegerName = mk_name_v "Data.Singletons.Prelude.Num" "sFromInteger" sNegateName = mk_name_v "Data.Singletons.Prelude.Num" "sNegate" errorName = 'error foldlName = 'foldl cmpEQName = 'EQ cmpLTName = 'LT cmpGTName = 'GT singletonsToEnumName = mk_name_v "Data.Singletons.Prelude.Enum" "toEnum" singletonsFromEnumName = mk_name_v "Data.Singletons.Prelude.Enum" "fromEnum" enumName = ''Enum singletonsEnumName = mk_name_tc "Data.Singletons.Prelude.Enum" "Enum" equalsName = '(==) constraintName = ''Constraint showName = ''Show showCharName = 'showChar showParenName = 'showParen showSpaceName = 'showSpace showsPrecName = 'showsPrec showStringName = 'showString showSingName = mk_name_tc "Data.Singletons.ShowSing" "ShowSing" composeName = '(.) gtName = '(>) showCommaSpaceName = 'showCommaSpace tyFromStringName = mk_name_tc "Data.Singletons.Prelude.IsString" "FromString" sFromStringName = mk_name_v "Data.Singletons.Prelude.IsString" "sFromString" foldableName = ''Foldable foldMapName = 'foldMap memptyName = 'mempty mappendName = 'mappend foldrName = 'foldr functorName = ''Functor fmapName = 'fmap replaceName = '(<$) traversableName = ''Traversable traverseName = 'traverse pureName = 'pure apName = '(<*>) liftA2Name = 'liftA2 singPkg :: String singPkg = $( (LitE . StringL . loc_package) `liftM` location ) mk_name_tc :: String -> String -> Name mk_name_tc = mkNameG_tc singPkg mk_name_d :: String -> String -> Name mk_name_d = mkNameG_d singPkg mk_name_v :: String -> String -> Name mk_name_v = mkNameG_v singPkg mkTupleTypeName :: Int -> Name mkTupleTypeName n = mk_name_tc "Data.Singletons.Prelude.Instances" $ "STuple" ++ (show n) mkTupleDataName :: Int -> Name mkTupleDataName n = mk_name_d "Data.Singletons.Prelude.Instances" $ "STuple" ++ (show n) -- used when a value name appears in a pattern context -- works only for proper variables (lower-case names) promoteValNameLhs :: Name -> Name promoteValNameLhs = promoteValNameLhsPrefix noPrefix -- like promoteValNameLhs, but adds a prefix to the promoted name promoteValNameLhsPrefix :: (String, String) -> Name -> Name promoteValNameLhsPrefix pres@(alpha, symb) n | nameBase n == "." = mkName $ symb ++ ":." | nameBase n == "!" = mkName $ symb ++ ":!" -- See Note [Special cases for (.) and (!)] -- We can't promote promote idenitifers beginning with underscores to -- type names, so we work around the issue by prepending "US" at the -- front of the name (#229). | Just (us, rest) <- splitUnderscores (nameBase n) = mkName $ alpha ++ "US" ++ us ++ rest | otherwise = mkName $ toUpcaseStr pres n -- used when a value name appears in an expression context -- works for both variables and datacons promoteValRhs :: Name -> DType promoteValRhs name | name == nilName = DConT nilName -- workaround for #21 | otherwise = DConT $ promoteTySym name 0 -- generates type-level symbol for a given name. Int parameter represents -- saturation: 0 - no parameters passed to the symbol, 1 - one parameter -- passed to the symbol, and so on. Works on both promoted and unpromoted -- names. promoteTySym :: Name -> Int -> Name promoteTySym name sat | nameBase name == ":." = default_case (mkName ".") | nameBase name == ":!" = default_case (mkName "!") -- Although (:.) and (:!) are special cases, we need not have a colon in -- front of their defunctionalization symbols, since only the names -- (.) and (!) are problematic for the parser. -- See Note [Special cases for (.) and (!)] -- We can't promote promote idenitifers beginning with underscores to -- type names, so we work around the issue by prepending "US" at the -- front of the name (#229). | Just (us, rest) <- splitUnderscores (nameBase name) = default_case (mkName $ "US" ++ us ++ rest) | name == nilName = mkName $ "NilSym" ++ (show sat) -- treat unboxed tuples like tuples | Just degree <- tupleNameDegree_maybe name `mplus` unboxedTupleNameDegree_maybe name = mk_name_tc "Data.Singletons.Prelude.Instances" $ "Tuple" ++ show degree ++ "Sym" ++ (show sat) | otherwise = default_case name where default_case :: Name -> Name default_case name' = let capped = toUpcaseStr noPrefix name' in if isHsLetter (head capped) then mkName (capped ++ "Sym" ++ (show sat)) else mkName (capped ++ "@#@" -- See Note [Defunctionalization symbol suffixes] ++ (replicate (sat + 1) '$')) promoteClassName :: Name -> Name promoteClassName = prefixName "P" "#" mkTyName :: Quasi q => Name -> q Name mkTyName tmName = do let nameStr = nameBase tmName symbolic = not (isHsLetter (head nameStr)) qNewName (if symbolic then "ty" else nameStr) mkTyConName :: Int -> Name mkTyConName i = mk_name_tc "Data.Singletons.Internal" $ "TyCon" ++ show i falseTySym :: DType falseTySym = promoteValRhs falseName trueTySym :: DType trueTySym = promoteValRhs trueName boolKi :: DKind boolKi = DConT boolName andTySym :: DType andTySym = promoteValRhs andName -- Singletons singDataConName :: Name -> Name singDataConName nm | nm == nilName = snilName | nm == consName = sconsName | Just degree <- tupleNameDegree_maybe nm = mkTupleDataName degree | Just degree <- unboxedTupleNameDegree_maybe nm = mkTupleDataName degree | otherwise = prefixConName "S" "%" nm singTyConName :: Name -> Name singTyConName name | name == listName = sListName | Just degree <- tupleNameDegree_maybe name = mkTupleTypeName degree | Just degree <- unboxedTupleNameDegree_maybe name = mkTupleTypeName degree | otherwise = prefixName "S" "%" name singClassName :: Name -> Name singClassName = singTyConName singValName :: Name -> Name singValName n -- Push the 's' past the underscores, as this lets us avoid some unused -- variable warnings (#229). | Just (us, rest) <- splitUnderscores (nameBase n) = prefixName (us ++ "s") "%" $ mkName rest | otherwise = prefixName "s" "%" $ upcase n singFamily :: DType singFamily = DConT singFamilyName singKindConstraint :: DKind -> DPred singKindConstraint = DAppPr (DConPr singKindClassName) demote :: DType demote = DConT demoteName apply :: DType -> DType -> DType apply t1 t2 = DAppT (DAppT (DConT applyName) t1) t2 mkListE :: [DExp] -> DExp mkListE = foldr (\h t -> DConE consName `DAppE` h `DAppE` t) (DConE nilName) -- apply a type to a list of types using Apply type family -- This is defined here, not in Utils, to avoid cyclic dependencies foldApply :: DType -> [DType] -> DType foldApply = foldl apply -- make and equality predicate mkEqPred :: DType -> DType -> DPred mkEqPred ty1 ty2 = foldPred (DConPr equalityName) [ty1, ty2] -- | If a 'String' begins with one or more underscores, return -- @'Just' (us, rest)@, where @us@ contain all of the underscores at the -- beginning of the 'String' and @rest@ contains the remainder of the 'String'. -- Otherwise, return 'Nothing'. splitUnderscores :: String -> Maybe (String, String) splitUnderscores s = case span (== '_') s of ([], _) -> Nothing res -> Just res -- Walk a DPred, applying a function to all occurrences of constructor names. modifyConNameDPred :: (Name -> Name) -> DPred -> DPred modifyConNameDPred mod_con_name = go where go (DForallPr tvbs cxt p) = DForallPr tvbs (map go cxt) (go p) go (DAppPr p t) = DAppPr (go p) t go (DSigPr p k) = DSigPr (go p) k go p@(DVarPr _) = p go (DConPr n) = DConPr (mod_con_name n) go p@DWildCardPr = p {- Note [Defunctionalization symbol suffixes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before, we used to denote defunctionalization symbols by simply appending dollar signs at the end (e.g., (+$) and (+$$)). But this can lead to ambiguity when you have function names that consist of solely $ characters. For instance, if you tried to promote ($) and ($$) simultaneously, you'd get these promoted types: $ $$ And these defunctionalization symbols: $$ $$$ But now there's a name clash between the promoted type for ($) and the defunctionalization symbol for ($$)! The solution is to use a precede these defunctionalization dollar signs with another string (we choose @#@). So now the new defunctionalization symbols would be: $@#@$ $@#@$$ And there is no conflict. Note [Special cases for (.) and (!)] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Almost every infix value name can be promoted trivially. For example, (+) works both at the value- and type-level. The two exceptions to this rule are (.) and (!), which we promote to the special type names (:.) and (:!), respectively. This is necessary since one cannot define or apply (.) or (!) at the type level -- they simply won't parse. Bummer. -} singletons-2.5.1/src/Data/Singletons/Partition.hs0000644000000000000000000003365607346545000020204 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Partition -- Copyright : (C) 2015 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Partitions a list of declarations into its bits -- ---------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Data.Singletons.Partition where import Prelude hiding ( exp ) import Data.Singletons.Syntax import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum import Data.Singletons.Deriving.Foldable import Data.Singletons.Deriving.Functor import Data.Singletons.Deriving.Show import Data.Singletons.Deriving.Traversable import Data.Singletons.Deriving.Util import Data.Singletons.Names import Language.Haskell.TH.Syntax hiding (showName) import Language.Haskell.TH.Ppr import Language.Haskell.TH.Desugar import Data.Singletons.Util import Control.Monad import Data.Bifunctor (bimap) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe import Data.Semigroup (Semigroup(..)) data PartitionedDecs = PDecs { pd_let_decs :: [DLetDec] , pd_class_decs :: [UClassDecl] , pd_instance_decs :: [UInstDecl] , pd_data_decs :: [DataDecl] , pd_ty_syn_decs :: [TySynDecl] , pd_open_type_family_decs :: [OpenTypeFamilyDecl] , pd_closed_type_family_decs :: [ClosedTypeFamilyDecl] , pd_derived_eq_decs :: [DerivedEqDecl] , pd_derived_show_decs :: [DerivedShowDecl] } instance Semigroup PartitionedDecs where PDecs a1 b1 c1 d1 e1 f1 g1 h1 i1 <> PDecs a2 b2 c2 d2 e2 f2 g2 h2 i2 = PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) (e1 <> e2) (f1 <> f2) (g1 <> g2) (h1 <> h2) (i1 <> i2) instance Monoid PartitionedDecs where mempty = PDecs [] [] [] [] [] [] [] [] [] mappend = (<>) -- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances -- from deriving clauses partitionDecs :: DsMonad m => [DDec] -> m PartitionedDecs partitionDecs = concatMapM partitionDec partitionDec :: DsMonad m => DDec -> m PartitionedDecs partitionDec (DLetDec (DPragmaD {})) = return mempty partitionDec (DLetDec letdec) = return $ mempty { pd_let_decs = [letdec] } partitionDec (DDataD _nd _cxt name tvbs mk cons derivings) = do all_tvbs <- buildDataDTvbs tvbs mk let data_decl = DataDecl name all_tvbs cons derived_dec = mempty { pd_data_decs = [data_decl] } derived_decs <- mapM (\(strat, deriv_pred) -> let etad_tvbs | DConT pred_name :| _ <- unfoldType deriv_pred , isFunctorLikeClassName pred_name -- If deriving Functor, Foldable, or Traversable, -- we need to use one less type variable than we normally do. = take (length all_tvbs - 1) all_tvbs | otherwise = all_tvbs ty = foldTypeTvbs (DConT name) etad_tvbs in partitionDeriving strat deriv_pred Nothing ty data_decl) $ concatMap flatten_clause derivings return $ mconcat $ derived_dec : derived_decs where flatten_clause :: DDerivClause -> [(Maybe DDerivStrategy, DType)] flatten_clause (DDerivClause strat preds) = map (\p -> (strat, predToType p)) preds partitionDec (DClassD cxt name tvbs fds decs) = do (lde, otfs) <- concatMapM partitionClassDec decs return $ mempty { pd_class_decs = [ClassDecl { cd_cxt = cxt , cd_name = name , cd_tvbs = tvbs , cd_fds = fds , cd_lde = lde }] , pd_open_type_family_decs = otfs } partitionDec (DInstanceD _ cxt ty decs) = do (defns, sigs) <- liftM (bimap catMaybes mconcat) $ mapAndUnzipM partitionInstanceDec decs (name, tys) <- split_app_tys [] ty return $ mempty { pd_instance_decs = [InstDecl { id_cxt = cxt , id_name = name , id_arg_tys = tys , id_sigs = sigs , id_meths = defns }] } where split_app_tys acc (DAppT t1 t2) = split_app_tys (t2:acc) t1 split_app_tys acc (DConT name) = return (name, acc) split_app_tys acc (DSigT t _) = split_app_tys acc t split_app_tys _ _ = fail $ "Illegal instance head: " ++ show ty partitionDec (DRoleAnnotD {}) = return mempty -- ignore these partitionDec (DTySynD name tvbs _type) = -- See Note [Partitioning, type synonyms, and type families] pure $ mempty { pd_ty_syn_decs = [TySynDecl name tvbs] } partitionDec (DClosedTypeFamilyD tf_head _) = -- See Note [Partitioning, type synonyms, and type families] pure $ mempty { pd_closed_type_family_decs = [TypeFamilyDecl tf_head] } partitionDec (DOpenTypeFamilyD tf_head) = -- See Note [Partitioning, type synonyms, and type families] pure $ mempty { pd_open_type_family_decs = [TypeFamilyDecl tf_head] } partitionDec (DTySynInstD {}) = pure mempty -- There's no need to track type family instances, since -- we already record the type family itself separately. partitionDec (DStandaloneDerivD mb_strat ctxt ty) = case unfoldType ty of cls_pred_ty :| cls_tys | not (null cls_tys) -- We can't handle zero-parameter type classes , let cls_arg_tys = init cls_tys data_ty = last cls_tys data_ty_head = case unfoldType data_ty of ty_head :| _ -> ty_head , DConT data_tycon <- data_ty_head -- We can't handle deriving an instance for something -- other than a type constructor application -> do let cls_pred = foldType cls_pred_ty cls_arg_tys dinfo <- dsReify data_tycon case dinfo of Just (DTyConI (DDataD _ _ dn dtvbs dk dcons _) _) -> do all_tvbs <- buildDataDTvbs dtvbs dk let data_decl = DataDecl dn all_tvbs dcons partitionDeriving mb_strat cls_pred (Just ctxt) data_ty data_decl Just _ -> fail $ "Standalone derived instance for something other than a datatype: " ++ show data_ty _ -> fail $ "Cannot find " ++ show data_ty _ -> return mempty partitionDec dec = fail $ "Declaration cannot be promoted: " ++ pprint (decToTH dec) partitionClassDec :: Monad m => DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl]) partitionClassDec (DLetDec (DSigD name ty)) = pure (typeBinding name ty, mempty) partitionClassDec (DLetDec (DValD (DVarPa name) exp)) = pure (valueBinding name (UValue exp), mempty) partitionClassDec (DLetDec (DFunD name clauses)) = pure (valueBinding name (UFunction clauses), mempty) partitionClassDec (DLetDec (DInfixD fixity name)) = pure (infixDecl fixity name, mempty) partitionClassDec (DLetDec (DPragmaD {})) = pure (mempty, mempty) partitionClassDec (DOpenTypeFamilyD tf_head) = -- See Note [Partitioning, type synonyms, and type families] pure (mempty, [TypeFamilyDecl tf_head]) partitionClassDec (DTySynInstD {}) = -- There's no need to track associated type family default equations, since -- we already record the type family itself separately. pure (mempty, mempty) partitionClassDec _ = fail "Only method declarations can be promoted within a class." partitionInstanceDec :: Monad m => DDec -> m ( Maybe (Name, ULetDecRHS) -- right-hand sides of methods , Map Name DType -- method type signatures ) partitionInstanceDec (DLetDec (DValD (DVarPa name) exp)) = pure (Just (name, UValue exp), mempty) partitionInstanceDec (DLetDec (DFunD name clauses)) = pure (Just (name, UFunction clauses), mempty) partitionInstanceDec (DLetDec (DSigD name ty)) = pure (Nothing, Map.singleton name ty) partitionInstanceDec (DLetDec (DPragmaD {})) = pure (Nothing, mempty) partitionInstanceDec (DTySynInstD {}) = pure (Nothing, mempty) -- There's no need to track associated type family instances, since -- we already record the type family itself separately. partitionInstanceDec _ = fail "Only method bodies can be promoted within an instance." partitionDeriving :: forall m. DsMonad m => Maybe DDerivStrategy -- ^ The deriving strategy, if present. -> DType -- ^ The class being derived (e.g., 'Eq'), possibly applied to -- some number of arguments (e.g., @C Int Bool@). -> Maybe DCxt -- ^ @'Just' ctx@ if @ctx@ was provided via @StandaloneDeriving@. -- 'Nothing' if using a @deriving@ clause. -> DType -- ^ The data type argument to the class. -> DataDecl -- ^ The original data type information (e.g., its constructors). -> m PartitionedDecs partitionDeriving mb_strat deriv_pred mb_ctxt ty data_decl = case unfoldType deriv_pred of DConT deriv_name :| arg_tys -- Here, we are more conservative than GHC: DeriveAnyClass only kicks -- in if the user explicitly chooses to do so with the anyclass -- deriving strategy | Just DAnyclassStrategy <- mb_strat -> return $ mk_derived_inst InstDecl { id_cxt = fromMaybe [] mb_ctxt -- For now at least, there's no point in attempting to -- infer an instance context for DeriveAnyClass, since -- the other language feature that requires it, -- DefaultSignatures, can't be singled. Thus, inferring an -- empty context will Just Work for all currently supported -- default implementations. -- -- (Of course, if a user specifies a context with -- StandaloneDeriving, use that.) , id_name = deriv_name , id_arg_tys = arg_tys ++ [ty] , id_sigs = mempty , id_meths = [] } | Just DNewtypeStrategy <- mb_strat -> do qReportWarning "GeneralizedNewtypeDeriving is ignored by `singletons`." return mempty | Just (DViaStrategy {}) <- mb_strat -> do qReportWarning "DerivingVia is ignored by `singletons`." return mempty -- Stock classes. These are derived only if `singletons` supports them -- (and, optionally, if an explicit stock deriving strategy is used) DConT deriv_name :| [] -- For now, all stock derivable class supported in -- singletons take just one argument (the data -- type itself) | stock_or_default , Just decs <- Map.lookup deriv_name stock_map -> decs -- If we can't find a stock class, but the user bothered to use an -- explicit stock keyword, we can at least warn them about it. | Just DStockStrategy <- mb_strat -> do qReportWarning $ "`singletons` doesn't recognize the stock class " ++ nameBase deriv_name return mempty _ -> return mempty -- singletons doesn't support deriving this instance where mk_instance :: DerivDesc m -> m UInstDecl mk_instance maker = maker mb_ctxt ty data_decl mk_derived_inst dec = mempty { pd_instance_decs = [dec] } mk_derived_eq_inst dec = mempty { pd_derived_eq_decs = [dec] } derived_decl = DerivedDecl { ded_mb_cxt = mb_ctxt , ded_type = ty , ded_decl = data_decl } stock_or_default = isStockOrDefault mb_strat -- A mapping from all stock derivable classes (that singletons supports) -- to to derived code that they produce. stock_map :: Map Name (m PartitionedDecs) stock_map = Map.fromList [ ( ordName, mk_derived_inst <$> mk_instance mkOrdInstance ) , ( boundedName, mk_derived_inst <$> mk_instance mkBoundedInstance ) , ( enumName, mk_derived_inst <$> mk_instance mkEnumInstance ) , ( functorName, mk_derived_inst <$> mk_instance mkFunctorInstance ) , ( foldableName, mk_derived_inst <$> mk_instance mkFoldableInstance ) , ( traversableName, mk_derived_inst <$> mk_instance mkTraversableInstance ) -- See Note [DerivedDecl] in Data.Singletons.Syntax , ( eqName, return $ mk_derived_eq_inst derived_decl ) -- See Note [DerivedDecl] in Data.Singletons.Syntax , ( showName, do -- These will become PShow/SShow instances... inst_for_promotion <- mk_instance mkShowInstance -- ...and this will become a Show instance. let inst_for_show = derived_decl pure $ mempty { pd_instance_decs = [inst_for_promotion] , pd_derived_show_decs = [inst_for_show] } ) ] -- Is this being used with an explicit stock strategy, or no strategy at all? isStockOrDefault :: Maybe DDerivStrategy -> Bool isStockOrDefault Nothing = True isStockOrDefault (Just DStockStrategy) = True isStockOrDefault (Just _) = False {- Note [Partitioning, type synonyms, and type families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The process of singling does not produce any new declarations corresponding to type synonyms or type families, so they are "ignored" in a sense. Nevertheless, we explicitly track them during partitioning, since we want to create defunctionalization symbols for them. Also note that: 1. Other uses of type synonyms in singled code will be expanded away. 2. Other uses of type families in singled code are unlikely to work at present due to Trac #12564. -} singletons-2.5.1/src/Data/Singletons/Prelude.hs0000644000000000000000000002336507346545000017627 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Mimics the Haskell Prelude, but with singleton types. Includes the basic -- singleton definitions. Note: This is currently very incomplete! -- -- Because many of these definitions are produced by Template Haskell, it is -- not possible to create proper Haddock documentation. Also, please excuse -- the apparent repeated variable names. This is due to an interaction between -- Template Haskell and Haddock. -- ---------------------------------------------------------------------------- {-# LANGUAGE ExplicitNamespaces #-} module Data.Singletons.Prelude ( -- * Basic singleton definitions module Data.Singletons, Sing(SFalse, STrue, SNil, SCons, SJust, SNothing, SLeft, SRight, SLT, SEQ, SGT, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7), -- * Singleton type synonyms -- | These synonyms are all kind-restricted synonyms of 'Sing'. -- For example 'SBool' requires an argument of kind 'Bool'. SBool, SList, SMaybe, SEither, SOrdering, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, -- * Functions working with 'Bool' If, sIf, Not, sNot, type (&&), type (||), (%&&), (%||), Otherwise, sOtherwise, -- * Error reporting Error, sError, ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, -- * Singleton equality module Data.Singletons.Prelude.Eq, -- * Singleton comparisons POrd(..), SOrd(..), -- * Singleton Enum and Bounded -- | As a matter of convenience, the singletons Prelude does /not/ export -- promoted/singletonized @succ@ and @pred@, due to likely conflicts with -- unary numbers. Please import 'Data.Singletons.Prelude.Enum' directly if -- you want these. module Data.Singletons.Prelude.Enum, -- * Singletons numbers module Data.Singletons.Prelude.Num, type (^), (%^), -- * Singleton 'Show' PShow(..), SShow(..), ShowS, SChar, Shows, sShows, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen, -- * Singleton 'Semigroup' and 'Monoid' PSemigroup(type (<>)), SSemigroup((%<>)), PMonoid(..), SMonoid(..), -- * Singleton 'Functor', 'Applicative', and 'Monad' PFunctor(Fmap, type (<$)), SFunctor(sFmap, (%<$)), type (<$>), (%<$>), PApplicative(Pure, type (<*>), type (*>), type (<*)), SApplicative(sPure, (%<*>), (%*>), (%<*)), PMonad(type (>>=), type (>>), Return, Fail), SMonad((%>>=), (%>>), sReturn, sFail), MapM_, sMapM_, Sequence_, sSequence_, type (=<<), (%=<<), -- * Singleton 'Foldable' and 'Traversable' PFoldable(Elem, FoldMap, Foldr, Foldl, Foldr1, Foldl1, Maximum, Minimum, Product, Sum), SFoldable(sElem, sFoldMap, sFoldr, sFoldl, sFoldr1, sFoldl1, sMaximum, sMinimum, sProduct, sSum), PTraversable(Traverse, SequenceA, MapM, Sequence), STraversable(sTraverse, sSequenceA, sMapM, sSequence), -- ** Miscellaneous functions Id, sId, Const, sConst, (:.), (%.), type ($), (%$), type ($!), (%$!), Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * List operations Map, sMap, type (++), (%++), Filter, sFilter, Head, sHead, Last, sLast, Tail, sTail, Init, sInit, Null, sNull, Reverse, sReverse, -- *** Special folds And, sAnd, Or, sOr, Any, sAny, All, sAll, Concat, sConcat, ConcatMap, sConcatMap, -- *** Scans Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1, -- *** Infinite lists Replicate, sReplicate, -- ** Sublists Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, Span, sSpan, Break, sBreak, -- ** Searching lists NotElem, sNotElem, Lookup, sLookup, -- ** Zipping and unzipping lists Zip, sZip, Zip3, sZip3, ZipWith, sZipWith, ZipWith3, sZipWith3, Unzip, sUnzip, Unzip3, sUnzip3, -- ** Functions on 'Symbol's Unlines, sUnlines, Unwords, sUnwords, -- * Other datatypes Maybe_, sMaybe_, Either_, sEither_, Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry, Symbol, -- * Other functions either_, -- reimplementation of either to be used with singletons library maybe_, bool_, show_, -- * Defunctionalization symbols FalseSym0, TrueSym0, NotSym0, NotSym1, type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), type (||@#@$), type (||@#@$$), type (||@#@$$$), OtherwiseSym0, NothingSym0, JustSym0, JustSym1, Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3, LeftSym0, LeftSym1, RightSym0, RightSym1, Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3, Tuple0Sym0, Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, FstSym0, FstSym1, SndSym0, SndSym1, CurrySym0, CurrySym1, CurrySym2, CurrySym3, UncurrySym0, UncurrySym1, UncurrySym2, ErrorSym0, ErrorSym1, ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, UndefinedSym0, LTSym0, EQSym0, GTSym0, CompareSym0, CompareSym1, CompareSym2, type (<@#@$), type (<@#@$$), type (<@#@$$$), type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), type (>@#@$), type (>@#@$$), type (>@#@$$$), type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), MaxSym0, MaxSym1, MaxSym2, MinSym0, MinSym1, MinSym2, type (^@#@$), type (^@#@$$), type (^@#@$$$), ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, Show_Sym0, Show_Sym1, ShowListSym0, ShowListSym1, ShowListSym2, ShowsSym0, ShowsSym1, ShowsSym2, ShowCharSym0, ShowCharSym1, ShowCharSym2, ShowStringSym0, ShowStringSym1, ShowStringSym2, ShowParenSym0, ShowParenSym1, ShowParenSym2, type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), MemptySym0, MappendSym0, MappendSym1, MappendSym2, MconcatSym0, MconcatSym1, FmapSym0, FmapSym1, FmapSym2, type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), PureSym0, PureSym1, type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), type (*>@#@$), type (*>@#@$$), type (*>@#@$$$), type (<*@#@$), type (<*@#@$$), type (<*@#@$$$), type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$), type (>>@#@$), type (>>@#@$$), type (>>@#@$$$), ReturnSym0, ReturnSym1, FailSym0, FailSym1, MapM_Sym0, MapM_Sym1, MapM_Sym2, Sequence_Sym0, Sequence_Sym1, type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$), ElemSym0, ElemSym1, ElemSym2, FoldMapSym0, FoldMapSym1, FoldMapSym2, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, MaximumSym0, MaximumSym1, MinimumSym0, MinimumSym1, SumSym0, SumSym1, ProductSym0, ProductSym1, TraverseSym0, TraverseSym1, TraverseSym2, SequenceASym0, SequenceASym1, MapMSym0, MapMSym1, MapMSym2, SequenceSym0, SequenceSym1, IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, type (.@#@$), type (.@#@$$), type (.@#@$$$), type ($@#@$), type ($@#@$$), type ($@#@$$$), type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), FlipSym0, FlipSym1, FlipSym2, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2, (:@#@$), (:@#@$$), (:@#@$$$), NilSym0, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, type (++@#@$$), type (++@#@$), FilterSym0, FilterSym1, FilterSym2, HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, ReplicateSym0, ReplicateSym1, ReplicateSym2, TakeSym0, TakeSym1, TakeSym2, DropSym0, DropSym1, DropSym2, SplitAtSym0, SplitAtSym1, SplitAtSym2, TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, DropWhileSym0, DropWhileSym1, DropWhileSym2, DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, SpanSym0, SpanSym1, SpanSym2, BreakSym0, BreakSym1, BreakSym2, NotElemSym0, NotElemSym1, NotElemSym2, ZipSym0, ZipSym1, ZipSym2, Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, UnzipSym0, UnzipSym1, UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1 ) where import Data.Singletons import Data.Singletons.Prelude.Applicative hiding (Const, ConstSym0, ConstSym1) import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Either import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.List import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Monad import Data.Singletons.Prelude.Tuple import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Enum hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred) import Data.Singletons.Prelude.Monoid ( PMonoid(..), SMonoid(..), MemptySym0, MappendSym0 , MappendSym1, MappendSym2, MconcatSym0, MconcatSym1 ) import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Semigroup ( PSemigroup(..), SSemigroup(..) , type (<>@#@$), type (<>@#@$$), type (<>@#@$$$) ) import Data.Singletons.Prelude.Show import Data.Singletons.Prelude.Traversable import Data.Singletons.TypeLits singletons-2.5.1/src/Data/Singletons/Prelude/0000755000000000000000000000000007346545000017262 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Prelude/Applicative.hs0000644000000000000000000000475407346545000022071 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Applicative -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'Applicative' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Applicative ( PApplicative(..), SApplicative(..), PAlternative(..), SAlternative(..), Sing (SConst, sGetConst), SConst, Const, GetConst, type (<$>), (%<$>), type (<$), (%<$), type (<**>), (%<**>), LiftA, sLiftA, LiftA3, sLiftA3, Optional, sOptional, -- * Defunctionalization symbols PureSym0, PureSym1, type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), type (*>@#@$), type (*>@#@$$), type (*>@#@$$$), type (<*@#@$), type (<*@#@$$), type (<*@#@$$$), EmptySym0, type (<|>@#@$), type (<|>@#@$$), type (<|>@#@$$$), ConstSym0, ConstSym1, GetConstSym0, GetConstSym1, type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), type (<**>@#@$), type (<**>@#@$$), type (<**>@#@$$$), LiftASym0, LiftASym1, LiftASym2, LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, LiftA3Sym0, LiftA3Sym1, LiftA3Sym2, LiftA3Sym3, OptionalSym0, OptionalSym1 ) where import Control.Applicative import Data.Ord (Down(..)) import Data.Singletons.Prelude.Const import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Ord import Data.Singletons.Single $(singletonsOnly [d| -- -| One or none. optional :: Alternative f => f a -> f (Maybe a) optional v = Just <$> v <|> pure Nothing instance Monoid a => Applicative ((,) a) where pure x = (mempty, x) (u, f) <*> (v, x) = (u `mappend` v, f x) liftA2 f (u, x) (v, y) = (u `mappend` v, f x y) instance Applicative Down where pure = Down Down f <*> Down x = Down (f x) |]) singletons-2.5.1/src/Data/Singletons/Prelude/Base.hs0000644000000000000000000000710607346545000020474 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, TypeOperators, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, GADTs, UndecidableInstances, BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Base -- Copyright : (C) 2014 Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) -- Stability : experimental -- Portability : non-portable -- -- Implements singletonized versions of functions from @GHC.Base@ module. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Tuple@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Base ( -- * Basic functions Foldr, sFoldr, Map, sMap, type (++), (%++), Otherwise, sOtherwise, Id, sId, Const, sConst, (:.), (%.), type ($), type ($!), (%$), (%$!), Until, sUntil, Flip, sFlip, AsTypeOf, sAsTypeOf, Seq, sSeq, -- * Defunctionalization symbols FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, MapSym0, MapSym1, MapSym2, type (++@#@$), type (++@#@$$), type (++@#@$$$), OtherwiseSym0, IdSym0, IdSym1, ConstSym0, ConstSym1, ConstSym2, type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), type ($@#@$), type ($@#@$$), type ($@#@$$$), type ($!@#@$), type ($!@#@$$), type ($!@#@$$$), UntilSym0, UntilSym1, UntilSym2, UntilSym3, FlipSym0, FlipSym1, FlipSym2, FlipSym3, AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2, SeqSym0, SeqSym1, SeqSym2 ) where import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Singletons.Prelude.Bool -- Promoted and singletonized versions of "otherwise" are imported and -- re-exported from Data.Singletons.Prelude.Bool. This is done to avoid cyclic -- module dependencies. $(singletonsOnly [d| foldr :: (a -> b -> b) -> b -> [a] -> b foldr k z = go where go [] = z go (y:ys) = y `k` go ys map :: (a -> b) -> [a] -> [b] map _ [] = [] map f (x:xs) = f x : map f xs (++) :: [a] -> [a] -> [a] (++) [] ys = ys (++) (x:xs) ys = x : xs ++ ys infixr 5 ++ id :: a -> a id x = x const :: a -> b -> a const x _ = x (.) :: (b -> c) -> (a -> b) -> a -> c (.) f g = \x -> f (g x) infixr 9 . flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x asTypeOf :: a -> a -> a asTypeOf = const ($) :: (a -> b) -> a -> b f $ x = f x infixr 0 $ ($!) :: (a -> b) -> a -> b f $! x = let {-!-}vx = x in f vx infixr 0 $! until :: (a -> Bool) -> (a -> a) -> a -> a until p f = go where -- Does not singletonize due to overlapping patterns. {- go x | p x = x | otherwise = go (f x) -} go x = if p x then x else go (f x) -- This is not part of GHC.Base, but we need to emulate seq and this is a good -- place to do it. seq :: a -> b -> b seq _ x = x infixr 0 `seq` |]) -- Workaround for #326 infixr 5 ++ infixr 0 $ infixr 0 $! singletons-2.5.1/src/Data/Singletons/Prelude/Bool.hs0000644000000000000000000000630507346545000020515 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, TypeApplications, TypeFamilies, TypeOperators, GADTs, ScopedTypeVariables, DeriveDataTypeable, UndecidableInstances, DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Bool -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for 'Bool', -- including a singletons version of all the definitions in @Data.Bool@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Bool@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Bool ( -- * The 'Bool' singleton Sing(SFalse, STrue), -- | Though Haddock doesn't show it, the 'Sing' instance above declares -- constructors -- -- > SFalse :: Sing False -- > STrue :: Sing True SBool, -- | 'SBool' is a kind-restricted synonym for 'Sing': @type SBool (a :: Bool) = Sing a@ -- * Conditionals If, sIf, -- * Singletons from @Data.Bool@ Not, sNot, type (&&), type (||), (%&&), (%||), -- | The following are derived from the function 'bool' in @Data.Bool@. The extra -- underscore is to avoid name clashes with the type 'Bool'. bool_, Bool_, sBool_, Otherwise, sOtherwise, -- * Defunctionalization symbols TrueSym0, FalseSym0, NotSym0, NotSym1, type (&&@#@$), type (&&@#@$$), type (&&@#@$$$), type (||@#@$), type (||@#@$$), type (||@#@$$$), Bool_Sym0, Bool_Sym1, Bool_Sym2, Bool_Sym3, OtherwiseSym0 ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Instances import Data.Singletons.Promote import Data.Singletons.Single import Data.Type.Bool ( If, type (&&), type (||), Not ) $(singletons [d| bool_ :: a -> a -> Bool -> a bool_ fls _tru False = fls bool_ _fls tru True = tru |]) $(singletonsOnly [d| otherwise :: Bool otherwise = True |]) -- | Conjunction of singletons (%&&) :: Sing a -> Sing b -> Sing (a && b) SFalse %&& _ = SFalse STrue %&& a = a infixr 3 %&& $(genDefunSymbols [''(&&)]) instance SingI (&&@#@$) where sing = singFun2 (%&&) instance SingI x => SingI ((&&@#@$$) x) where sing = singFun1 (sing @x %&&) -- | Disjunction of singletons (%||) :: Sing a -> Sing b -> Sing (a || b) SFalse %|| a = a STrue %|| _ = STrue infixr 2 %|| $(genDefunSymbols [''(||)]) instance SingI (||@#@$) where sing = singFun2 (%||) instance SingI x => SingI ((||@#@$$) x) where sing = singFun1 (sing @x %||) -- | Negation of a singleton sNot :: Sing a -> Sing (Not a) sNot SFalse = STrue sNot STrue = SFalse $(genDefunSymbols [''Not]) instance SingI NotSym0 where sing = singFun1 sNot -- | Conditional over singletons sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c) sIf STrue b _ = b sIf SFalse _ c = c singletons-2.5.1/src/Data/Singletons/Prelude/Const.hs0000644000000000000000000001165607346545000020715 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Const -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) -- Stability : experimental -- Portability : non-portable -- -- Exports the promoted and singled versions of the 'Const' data type. -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Const ( -- * The 'Const' singleton Sing(SConst, sGetConst), SConst, GetConst, -- * Defunctionalization symbols ConstSym0, ConstSym1, GetConstSym0, GetConstSym1 ) where import Control.Applicative import Data.Kind (Type) import Data.Singletons.Internal import Data.Singletons.Prelude.Base hiding ( Const, ConstSym0, ConstSym1 , Foldr, FoldrSym0, sFoldr ) import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Instances hiding (FoldlSym0, sFoldl) import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Semigroup.Internal import Data.Singletons.Prelude.Show import Data.Singletons.Promote import Data.Singletons.Single {- Const's argument `b` is poly-kinded, and as a result, we have a choice as to what Sing instance to give it. We could use either 1. data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type 2. data instance Sing :: forall (a :: Type) (b :: Type). Const a b -> Type Option (1) is the more permissive one, so we opt for that. However, singletons' TH machinery does not jive with this option, since the SingKind instance it tries to generate: instance (SingKind a, SingKind b) => SingKind (Const a b) where type Demote (Const a b) = Const (Demote a) (Demote b) Assumes that `b` is of kind Type. Until we get a more reliable story for poly-kinded Sing instances (see #150), we simply write the Sing instance by hand. -} data instance Sing :: forall (k :: Type) (a :: Type) (b :: k). Const a b -> Type where SConst :: { sGetConst :: Sing a } -> Sing ('Const a) type SConst = (Sing :: Const a b -> Type) instance SingKind a => SingKind (Const a b) where type Demote (Const a b) = Const (Demote a) b fromSing (SConst sa) = Const (fromSing sa) toSing (Const a) = withSomeSing a $ SomeSing . SConst instance SingI a => SingI ('Const a) where sing = SConst sing $(genDefunSymbols [''Const]) instance SingI ConstSym0 where sing = singFun1 SConst instance SingI (TyCon1 'Const) where sing = singFun1 SConst $(singletons [d| type family GetConst (x :: Const a b) :: a where GetConst ('Const x) = x |]) $(singletonsOnly [d| deriving instance Bounded a => Bounded (Const a b) deriving instance Eq a => Eq (Const a b) deriving instance Ord a => Ord (Const a b) -- deriving instance Enum a => Enum (Const a b) instance Enum a => Enum (Const a b) where succ (Const x) = Const (succ x) pred (Const x) = Const (pred x) toEnum i = Const (toEnum i) fromEnum (Const x) = fromEnum x enumFromTo (Const x) (Const y) = map Const (enumFromTo x y) enumFromThenTo (Const x) (Const y) (Const z) = map Const (enumFromThenTo x y z) -- deriving instance Monoid a => Monoid (Const a b) instance Monoid a => Monoid (Const a b) where mempty = Const mempty -- deriving instance Num a => Num (Const a b) instance Num a => Num (Const a b) where Const x + Const y = Const (x + y) Const x - Const y = Const (x - y) Const x * Const y = Const (x * y) negate (Const x) = Const (negate x) abs (Const x) = Const (abs x) signum (Const x) = Const (signum x) fromInteger n = Const (fromInteger n) -- deriving instance Semigroup a => Semigroup (Const a b) instance Semigroup a => Semigroup (Const a b) where Const x <> Const y = Const (x <> y) -- -| This instance would be equivalent to the derived instances of the -- 'Const' newtype if the 'runConst' field were removed instance Show a => Show (Const a b) where showsPrec d (Const x) = showParen (d > 10) $ showString "Const " . showsPrec 11 x deriving instance Functor (Const m) deriving instance Foldable (Const m) instance Monoid m => Applicative (Const m) where pure _ = Const mempty liftA2 _ (Const x) (Const y) = Const (x `mappend` y) Const x <*> Const y = Const (x `mappend` y) |]) singletons-2.5.1/src/Data/Singletons/Prelude/Either.hs0000644000000000000000000000764207346545000021047 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, GADTs, RankNTypes, UndecidableInstances, DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Either -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for 'Either', -- including a singletons version of all the definitions in @Data.Either@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Either@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Either ( -- * The 'Either' singleton Sing(SLeft, SRight), -- | Though Haddock doesn't show it, the 'Sing' instance above declares -- constructors -- -- > SLeft :: Sing a -> Sing (Left a) -- > SRight :: Sing b -> Sing (Right b) SEither, -- | 'SEither' is a kind-restricted synonym for 'Sing': -- @type SEither (a :: Either x y) = Sing a@ -- * Singletons from @Data.Either@ either_, Either_, sEither_, -- | The preceding two definitions are derived from the function 'either' in -- @Data.Either@. The extra underscore is to avoid name clashes with the type -- 'Either'. Lefts, sLefts, Rights, sRights, PartitionEithers, sPartitionEithers, IsLeft, sIsLeft, IsRight, sIsRight, -- * Defunctionalization symbols LeftSym0, LeftSym1, RightSym0, RightSym1, Either_Sym0, Either_Sym1, Either_Sym2, Either_Sym3, LeftsSym0, LeftsSym1, RightsSym0, RightsSym1, IsLeftSym0, IsLeftSym1, IsRightSym0, IsRightSym1 ) where import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Base import Data.Singletons.Single -- NB: The haddock comments are disabled because TH can't deal with them. $(singletons [d| -- Renamed to avoid name clash -- -| Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@; -- if it is @'Right' b@, apply the second function to @b@. either_ :: (a -> c) -> (b -> c) -> Either a b -> c either_ f _ (Left x) = f x either_ _ g (Right y) = g y |]) $(singletonsOnly [d| -- -| Extracts from a list of 'Either' all the 'Left' elements -- All the 'Left' elements are extracted in order. -- Modified to avoid list comprehensions lefts :: [Either a b] -> [a] lefts [] = [] lefts (Left x : xs) = x : lefts xs lefts (Right _ : xs) = lefts xs -- -| Extracts from a list of 'Either' all the 'Right' elements -- All the 'Right' elements are extracted in order. -- Modified to avoid list comprehensions rights :: [Either a b] -> [b] rights [] = [] rights (Left _ : xs) = rights xs rights (Right x : xs) = x : rights xs -- -| Partitions a list of 'Either' into two lists -- All the 'Left' elements are extracted, in order, to the first -- component of the output. Similarly the 'Right' elements are extracted -- to the second component of the output. partitionEithers :: [Either a b] -> ([a],[b]) partitionEithers = foldr (either_ left right) ([],[]) where left a (l, r) = (a:l, r) right a (l, r) = (l, a:r) -- -| Return `True` if the given value is a `Left`-value, `False` otherwise. -- -- /Since: 4.7.0.0/ isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False -- -| Return `True` if the given value is a `Right`-value, `False` otherwise. -- -- /Since: 4.7.0.0/ isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True |]) singletons-2.5.1/src/Data/Singletons/Prelude/Enum.hs0000644000000000000000000001125707346545000020530 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, TypeOperators, GADTs, UndecidableInstances, FlexibleContexts, DefaultSignatures, BangPatterns, InstanceSigs #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Enum -- Copyright : (C) 2014 Jan Stolarek, Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Jan Stolarek (jan.stolarek@p.lodz.pl) -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singleton version of Bounded, 'PBounded' -- and 'SBounded' -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Enum ( PBounded(..), SBounded(..), PEnum(..), SEnum(..), -- ** Defunctionalization symbols MinBoundSym0, MaxBoundSym0, SuccSym0, SuccSym1, PredSym0, PredSym1, ToEnumSym0, ToEnumSym1, FromEnumSym0, FromEnumSym1, EnumFromToSym0, EnumFromToSym1, EnumFromToSym2, EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2, EnumFromThenToSym3 ) where import Data.Singletons.Single import Data.Singletons.Util import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances import Data.Singletons.TypeLits $(singletonsOnly [d| class Bounded a where minBound, maxBound :: a |]) $(singBoundedInstances boundedBasicTypes) $(singletonsOnly [d| class Enum a where -- | the successor of a value. For numeric types, 'succ' adds 1. succ :: a -> a -- | the predecessor of a value. For numeric types, 'pred' subtracts 1. pred :: a -> a -- | Convert from a 'Nat'. toEnum :: Nat -> a -- | Convert to a 'Nat'. fromEnum :: a -> Nat -- The following use infinite lists, and are not promotable: -- -- | Used in Haskell's translation of @[n..]@. -- enumFrom :: a -> [a] -- -- | Used in Haskell's translation of @[n,n'..]@. -- enumFromThen :: a -> a -> [a] -- | Used in Haskell's translation of @[n..m]@. enumFromTo :: a -> a -> [a] -- | Used in Haskell's translation of @[n,n'..m]@. enumFromThenTo :: a -> a -> a -> [a] succ = toEnum . (+1) . fromEnum pred = toEnum . (subtract 1) . fromEnum -- enumFrom x = map toEnum [fromEnum x ..] -- enumFromThen x y = map toEnum [fromEnum x, fromEnum y ..] enumFromTo x y = map toEnum [fromEnum x .. fromEnum y] enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y] -- Nat instance for Enum eftNat :: Nat -> Nat -> [Nat] -- [x1..x2] eftNat x0 y | (x0 > y) = [] | otherwise = go x0 where go x = x : if (x == y) then [] else go (x + 1) efdtNat :: Nat -> Nat -> Nat -> [Nat] -- [x1,x2..y] efdtNat x1 x2 y | x2 >= x1 = efdtNatUp x1 x2 y | otherwise = efdtNatDn x1 x2 y -- Requires x2 >= x1 efdtNatUp :: Nat -> Nat -> Nat -> [Nat] efdtNatUp x1 x2 y -- Be careful about overflow! | y < x2 = if y < x1 then [] else [x1] | otherwise = -- Common case: x1 <= x2 <= y let delta = x2 - x1 -- >= 0 y' = y - delta -- x1 <= y' <= y; hence y' is representable -- Invariant: x <= y -- Note that: z <= y' => z + delta won't overflow -- so we are guaranteed not to overflow if/when we recurse go_up x | x > y' = [x] | otherwise = x : go_up (x + delta) in x1 : go_up x2 -- Requires x2 <= x1 efdtNatDn :: Nat -> Nat -> Nat -> [Nat] efdtNatDn x1 x2 y -- Be careful about underflow! | y > x2 = if y > x1 then [] else [x1] | otherwise = -- Common case: x1 >= x2 >= y let delta = x2 - x1 -- <= 0 y' = y - delta -- y <= y' <= x1; hence y' is representable -- Invariant: x >= y -- Note that: z >= y' => z + delta won't underflow -- so we are guaranteed not to underflow if/when we recurse go_dn x | x < y' = [x] | otherwise = x : go_dn (x + delta) in x1 : go_dn x2 instance Enum Nat where succ x = x + 1 pred x = x - 1 toEnum x = x fromEnum x = x enumFromTo = eftNat enumFromThenTo = efdtNat |]) $(singEnumInstances enumBasicTypes) singletons-2.5.1/src/Data/Singletons/Prelude/Eq.hs0000644000000000000000000000637607346545000020177 0ustar0000000000000000{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, RankNTypes, FlexibleContexts, TemplateHaskell, UndecidableInstances, GADTs, DefaultSignatures, ScopedTypeVariables, TypeApplications #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Eq -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the SEq singleton version of the Eq type class. -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Eq ( PEq(..), SEq(..), DefaultEq, -- * Defunctionalization symbols type (==@#@$), type (==@#@$$), type (==@#@$$$), type (/=@#@$), type (/=@#@$$), type (/=@#@$$$), DefaultEqSym0, DefaultEqSym1, DefaultEqSym2 ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Bool import Data.Singletons.Single import Data.Singletons.Prelude.Instances import Data.Singletons.Util import Data.Singletons.Promote import qualified Data.Type.Equality as DTE () -- NB: These must be defined by hand because of the custom handling of the -- default for (==) to use DefaultEq -- | The promoted analogue of 'Eq'. If you supply no definition for '(==)', -- then it defaults to a use of 'DefaultEq'. class PEq a where type (==) (x :: a) (y :: a) :: Bool type (/=) (x :: a) (y :: a) :: Bool type (x :: a) == (y :: a) = x `DefaultEq` y type (x :: a) /= (y :: a) = Not (x == y) infix 4 == infix 4 /= -- | A sensible way to compute Boolean equality for types of any kind. Note -- that this definition is slightly different from the '(DTE.==)' type family -- from "Data.Type.Equality" in @base@, as '(DTE.==)' attempts to distinguish -- applications of type constructors from other types. As a result, -- @a == a@ does not reduce to 'True' for every @a@, but @'DefaultEq' a a@ -- /does/ reduce to 'True' for every @a@. The latter behavior is more desirable -- for @singletons@' purposes, so we use it instead of '(DTE.==)'. type family DefaultEq (a :: k) (b :: k) :: Bool where DefaultEq a a = 'True DefaultEq a b = 'False $(genDefunSymbols [''(==), ''(/=), ''DefaultEq]) -- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is required -- that instances define a body for '(%==)'. You may also supply a body for '(%/=)'. class SEq k where -- | Boolean equality on singletons (%==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a == b) infix 4 %== -- | Boolean disequality on singletons (%/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a /= b) default (%/=) :: forall (a :: k) (b :: k). ((a /= b) ~ Not (a == b)) => Sing a -> Sing b -> Sing (a /= b) a %/= b = sNot (a %== b) infix 4 %/= $(singEqInstances basicTypes) instance SEq a => SingI ((==@#@$) :: a ~> a ~> Bool) where sing = singFun2 (%==) instance (SEq a, SingI x) => SingI ((==@#@$$) x :: a ~> Bool) where sing = singFun1 (sing @x %==) instance SEq a => SingI ((/=@#@$) :: a ~> a ~> Bool) where sing = singFun2 (%/=) instance (SEq a, SingI x) => SingI ((/=@#@$$) x :: a ~> Bool) where sing = singFun1 (sing @x %/=) singletons-2.5.1/src/Data/Singletons/Prelude/Foldable.hs0000644000000000000000000005415507346545000021340 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Foldable -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'Foldable' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Foldable ( PFoldable(..), SFoldable(..), FoldrM, sFoldrM, FoldlM, sFoldlM, Traverse_, sTraverse_, For_, sFor_, SequenceA_, sSequenceA_, Asum, sAsum, MapM_, sMapM_, ForM_, sForM_, Sequence_, sSequence_, Msum, sMsum, Concat, sConcat, ConcatMap, sConcatMap, And, sAnd, Or, sOr, Any, sAny, All, sAll, MaximumBy, sMaximumBy, MinimumBy, sMinimumBy, NotElem, sNotElem, Find, sFind, -- * Defunctionalization symbols FoldSym0, FoldSym1, FoldMapSym0, FoldMapSym1, FoldMapSym2, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, Foldr'Sym0, Foldr'Sym1, Foldr'Sym2, Foldr'Sym3, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, ToListSym0, ToListSym1, NullSym0, NullSym1, LengthSym0, LengthSym1, ElemSym0, ElemSym1, ElemSym2, MaximumSym0, MaximumSym1, MinimumSym0, MinimumSym1, SumSym0, SumSym1, ProductSym0, ProductSym1, FoldrMSym0, FoldrMSym1, FoldrMSym2, FoldrMSym3, FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3, Traverse_Sym0, Traverse_Sym1, Traverse_Sym2, For_Sym0, For_Sym1, For_Sym2, SequenceA_Sym0, SequenceA_Sym1, AsumSym0, AsumSym1, MapM_Sym0, MapM_Sym1, MapM_Sym2, ForM_Sym0, ForM_Sym1, ForM_Sym2, Sequence_Sym0, Sequence_Sym1, MsumSym0, MsumSym1, ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, MaximumBySym0, MaximumBySym1, MaximumBySym2, MinimumBySym0, MinimumBySym1, MinimumBySym2, NotElemSym0, NotElemSym1, NotElemSym2, FindSym0, FindSym1, FindSym2 ) where import Control.Applicative import Control.Monad import Data.Kind import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..)) import qualified Data.Monoid as Monoid (All(..), Any(..), Product(..), Sum(..)) import Data.Singletons.Internal import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Either import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances (Sing(..), type (:@#@$)) import Data.Singletons.Prelude.List.Internal.Disambiguation import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid hiding ( AllSym0, AllSym1 , AnySym0, AnySym1 , ProductSym0, ProductSym1 , SumSym0, SumSym1 ) import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax , Min, MinSym0, MinSym1, MinSym2, sMin ) import Data.Singletons.Prelude.Semigroup.Internal hiding ( AllSym0(..), AllSym1, SAll , AnySym0(..), AnySym1, SAny , FirstSym0, FirstSym1, SFirst , LastSym0, LastSym1, SLast , ProductSym0(..), ProductSym1, SProduct , SumSym0(..), SumSym1, SSum ) import Data.Singletons.Promote import Data.Singletons.Single import Data.Singletons.TypeLits.Internal newtype Endo a = Endo (a ~> a) data instance Sing :: forall a. Endo a -> Type where SEndo :: Sing x -> Sing ('Endo x) data EndoSym0 :: forall a. (a ~> a) ~> Endo a type instance Apply EndoSym0 x = 'Endo x $(singletonsOnly [d| instance Semigroup (Endo a) where Endo x <> Endo y = Endo (x . y) instance Monoid (Endo a) where mempty = Endo id |]) newtype MaxInternal a = MaxInternal (Maybe a) data instance Sing :: forall a. MaxInternal a -> Type where SMaxInternal :: Sing x -> Sing ('MaxInternal x) $(genDefunSymbols [''MaxInternal]) newtype MinInternal a = MinInternal (Maybe a) data instance Sing :: forall a. MinInternal a -> Type where SMinInternal :: Sing x -> Sing ('MinInternal x) $(genDefunSymbols [''MinInternal]) $(singletonsOnly [d| instance Ord a => Semigroup (MaxInternal a) where m <> MaxInternal Nothing = m MaxInternal Nothing <> n = n (MaxInternal m@(Just x)) <> (MaxInternal n@(Just y)) = if x >= y then MaxInternal m else MaxInternal n instance Ord a => Monoid (MaxInternal a) where mempty = MaxInternal Nothing instance Ord a => Semigroup (MinInternal a) where m <> MinInternal Nothing = m MinInternal Nothing <> n = n (MinInternal m@(Just x)) <> (MinInternal n@(Just y)) = if x <= y then MinInternal m else MinInternal n instance Ord a => Monoid (MinInternal a) where mempty = MinInternal Nothing |]) $(singletonsOnly [d| -- -| Data structures that can be folded. -- -- For example, given a data type -- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) -- -- a suitable instance would be -- -- > instance Foldable Tree where -- > foldMap f Empty = mempty -- > foldMap f (Leaf x) = f x -- > foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r -- -- This is suitable even for abstract types, as the monoid is assumed -- to satisfy the monoid laws. Alternatively, one could define @foldr@: -- -- > instance Foldable Tree where -- > foldr f z Empty = z -- > foldr f z (Leaf x) = f x z -- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l -- -- @Foldable@ instances are expected to satisfy the following laws: -- -- > foldr f z t = appEndo (foldMap (Endo . f) t ) z -- -- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z -- -- > fold = foldMap id -- -- > length = getSum . foldMap (Sum . const 1) -- -- @sum@, @product@, @maximum@, and @minimum@ should all be essentially -- equivalent to @foldMap@ forms, such as -- -- > sum = getSum . foldMap Sum -- -- but may be less defined. -- -- If the type is also a 'Functor' instance, it should satisfy -- -- > foldMap f = fold . fmap f -- -- which implies that -- -- > foldMap f . fmap g = foldMap (f . g) class Foldable (t :: Type -> Type) where -- {-# MINIMAL foldMap | foldr #-} -- -| Combine the elements of a structure using a monoid. fold :: Monoid m => t m -> m fold = foldMap id -- -| Map each element of the structure to a monoid, -- and combine the results. foldMap :: Monoid m => (a -> m) -> t a -> m foldMap f = foldr (mappend . f) mempty -- -| Right-associative fold of a structure. -- -- In the case of lists, 'foldr', when applied to a binary operator, a -- starting value (typically the right-identity of the operator), and a -- list, reduces the list using the binary operator, from right to left: -- -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) -- -- Note that, since the head of the resulting expression is produced by -- an application of the operator to the first element of the list, -- 'foldr' can produce a terminating expression from an infinite list. -- -- For a general 'Foldable' structure this should be semantically identical -- to, -- -- @foldr f z = 'List.foldr' f z . 'toList'@ -- foldr :: (a -> b -> b) -> b -> t a -> b foldr f z t = case foldMap (Endo . f) t of Endo g -> g z -- -| Right-associative fold of a structure, but with strict application of -- the operator. -- foldr' :: (a -> b -> b) -> b -> t a -> b foldr' f z0 xs = foldl f' id xs z0 where f' k x z = k $! f x z -- -| Left-associative fold of a structure. -- -- In the case of lists, 'foldl', when applied to a binary -- operator, a starting value (typically the left-identity of the operator), -- and a list, reduces the list using the binary operator, from left to -- right: -- -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn -- -- Note that to produce the outermost application of the operator the -- entire input list must be traversed. This means that 'foldl'' will -- diverge if given an infinite list. -- -- Also note that if you want an efficient left-fold, you probably want to -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does -- not force the "inner" results (e.g. @z `f` x1@ in the above example) -- before applying them to the operator (e.g. to @(`f` x2)@). This results -- in a thunk chain @O(n)@ elements long, which then must be evaluated from -- the outside-in. -- -- For a general 'Foldable' structure this should be semantically identical -- to, -- -- @foldl f z = 'List.foldl' f z . 'toList'@ -- foldl :: (b -> a -> b) -> b -> t a -> b foldl f z t = case foldMap (Dual . Endo . flip f) t of Dual (Endo g) -> g z -- There's no point mucking around with coercions here, -- because flip forces us to build a new function anyway. -- -| Left-associative fold of a structure but with strict application of -- the operator. -- -- This ensures that each step of the fold is forced to weak head normal -- form before being applied, avoiding the collection of thunks that would -- otherwise occur. This is often what you want to strictly reduce a finite -- list to a single, monolithic result (e.g. 'length'). -- -- For a general 'Foldable' structure this should be semantically identical -- to, -- -- @foldl f z = 'List.foldl'' f z . 'toList'@ -- foldl' :: (b -> a -> b) -> b -> t a -> b foldl' f z0 xs = foldr f' id xs z0 where f' x k z = k $! f z x -- -| A variant of 'foldr' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @'foldr1' f = 'List.foldr1' f . 'toList'@ foldr1 :: (a -> a -> a) -> t a -> a foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") (foldr mf Nothing xs) where mf x m = Just (case m of Nothing -> x Just y -> f x y) -- -| A variant of 'foldl' that has no base case, -- and thus may only be applied to non-empty structures. -- -- @'foldl1' f = 'List.foldl1' f . 'toList'@ foldl1 :: (a -> a -> a) -> t a -> a foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") (foldl mf Nothing xs) where mf m y = Just (case m of Nothing -> y Just x -> f x y) -- -| List of elements of a structure, from left to right. toList :: t a -> [a] toList = foldr (:) [] -- -| Test whether the structure is empty. The default implementation is -- optimized for structures that are similar to cons-lists, because there -- is no general way to do better. null :: t a -> Bool null = foldr (\_ _ -> False) True -- -| Returns the size/length of a finite structure as an 'Int'. The -- default implementation is optimized for structures that are similar to -- cons-lists, because there is no general way to do better. length :: t a -> Nat length = foldl' (\c _ -> c+1) 0 -- -| Does the element occur in the structure? elem :: Eq a => a -> t a -> Bool elem = any . (==) -- -| The largest element of a non-empty structure. maximum :: forall a . Ord a => t a -> a maximum x = case foldMap (MaxInternal . Just) x of MaxInternal y -> fromMaybe (errorWithoutStackTrace "maximum: empty structure") y -- -| The least element of a non-empty structure. minimum :: forall a . Ord a => t a -> a minimum x = case foldMap (MinInternal . Just) x of MinInternal y -> fromMaybe (errorWithoutStackTrace "minimum: empty structure") y -- -| The 'sum' function computes the sum of the numbers of a structure. sum :: Num a => t a -> a sum x = case foldMap sum_ x of Monoid.Sum y -> y -- -| The 'product' function computes the product of the numbers of a -- structure. product :: Num a => t a -> a product x = case foldMap product_ x of Monoid.Product y -> y -- instances for Prelude types instance Foldable Maybe where foldMap = maybe_ mempty foldr _ z Nothing = z foldr f z (Just x) = f x z foldl _ z Nothing = z foldl f z (Just x) = f z x instance Foldable [] where elem = listelem foldl = listfoldl foldl' = listfoldl' foldl1 = listfoldl1 foldr = listfoldr foldr1 = listfoldr1 length = listlength maximum = listmaximum minimum = listminimum null = listnull product = listproduct sum = listsum toList = id instance Foldable NonEmpty where foldr f z (a :| as) = f a (listfoldr f z as) foldl f z (a :| as) = listfoldl f (f z a) as foldl1 f (a :| as) = listfoldl f a as -- GHC isn't clever enough to transform the default definition -- into anything like this, so we'd end up shuffling a bunch of -- Maybes around. foldr1 f (p :| ps) = foldr go id ps p where go x r prev = f prev (r x) -- We used to say -- -- length (_ :| as) = 1 + length as -- -- but the default definition is better, counting from 1. -- -- The default definition also works great for null and foldl'. -- As usual for cons lists, foldr' is basically hopeless. foldMap f (a :| as) = f a `mappend` foldMap f as fold (m :| ms) = m `mappend` fold ms toList (a :| as) = a : as instance Foldable (Either a) where foldMap _ (Left _) = mempty foldMap f (Right y) = f y foldr _ z (Left _) = z foldr f z (Right y) = f y z length (Left _) = 0 length (Right _) = 1 null = isLeft instance Foldable Dual where foldMap f (Dual x) = f x elem x (Dual y) = x == y foldl f z (Dual x) = f z x foldl' f z (Dual x) = f z x foldl1 _ (Dual x) = x foldr f z (Dual x) = f x z foldr' = foldr foldr1 _ (Dual x) = x length _ = 1 maximum (Dual x) = x minimum (Dual x) = x null _ = False product (Dual x) = x sum (Dual x) = x toList (Dual x) = [x] instance Foldable Monoid.Sum where foldMap f (Monoid.Sum x) = f x elem x (Monoid.Sum y) = x == y foldl f z (Monoid.Sum x) = f z x foldl' f z (Monoid.Sum x) = f z x foldl1 _ (Monoid.Sum x) = x foldr f z (Monoid.Sum x) = f x z foldr' = foldr foldr1 _ (Monoid.Sum x) = x length _ = 1 maximum (Monoid.Sum x) = x minimum (Monoid.Sum x) = x null _ = False product (Monoid.Sum x) = x sum (Monoid.Sum x) = x toList (Monoid.Sum x) = [x] instance Foldable Monoid.Product where foldMap f (Monoid.Product x) = f x elem x (Monoid.Product y) = x == y foldl f z (Monoid.Product x) = f z x foldl' f z (Monoid.Product x) = f z x foldl1 _ (Monoid.Product x) = x foldr f z (Monoid.Product x) = f x z foldr' = foldr foldr1 _ (Monoid.Product x) = x length _ = 1 maximum (Monoid.Product x) = x minimum (Monoid.Product x) = x null _ = False product (Monoid.Product x) = x sum (Monoid.Product x) = x toList (Monoid.Product x) = [x] -- -| Monadic fold over the elements of a structure, -- associating to the right, i.e. from right to left. foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b foldrM f z0 xs = foldl f' return xs z0 where f' k x z = f x z >>= k -- -| Monadic fold over the elements of a structure, -- associating to the left, i.e. from left to right. foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldlM f z0 xs = foldr f' return xs z0 where f' x k z = f z x >>= k -- -| Map each element of a structure to an action, evaluate these -- actions from left to right, and ignore the results. For a version -- that doesn't ignore the results see 'Data.Traversable.traverse'. traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f () traverse_ f = foldr ((*>) . f) (pure ()) -- -| 'for_' is 'traverse_' with its arguments flipped. For a version -- that doesn't ignore the results see 'Data.Traversable.for'. -- -- >>> for_ [1..4] print -- 1 -- 2 -- 3 -- 4 for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f () for_ = flip traverse_ -- -| Map each element of a structure to a monadic action, evaluate -- these actions from left to right, and ignore the results. For a -- version that doesn't ignore the results see -- 'Data.Traversable.mapM'. -- -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to -- 'Monad'. mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ f= foldr ((>>) . f) (return ()) -- -| 'forM_' is 'mapM_' with its arguments flipped. For a version that -- doesn't ignore the results see 'Data.Traversable.forM'. -- -- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'. forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ = flip mapM_ -- -| Evaluate each action in the structure from left to right, and -- ignore the results. For a version that doesn't ignore the results -- see 'Data.Traversable.sequenceA'. sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f () sequenceA_ = foldr (*>) (pure ()) -- -| Evaluate each monadic action in the structure from left to right, -- and ignore the results. For a version that doesn't ignore the -- results see 'Data.Traversable.sequence'. -- -- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized -- to 'Monad'. sequence_ :: (Foldable t, Monad m) => t (m a) -> m () sequence_ = foldr (>>) (return ()) -- -| The sum of a collection of actions, generalizing 'concat'. -- -- asum [Just "Hello", Nothing, Just "World"] -- Just "Hello" asum :: (Foldable t, Alternative f) => t (f a) -> f a asum = foldr (<|>) empty -- -| The sum of a collection of actions, generalizing 'concat'. -- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'. msum :: (Foldable t, MonadPlus m) => t (m a) -> m a msum = asum -- -| The concatenation of all the elements of a container of lists. concat :: Foldable t => t [a] -> [a] concat xs = foldr (\x y -> foldr (:) y x) [] xs -- -| Map a function over all the elements of a container and concatenate -- the resulting lists. concatMap :: Foldable t => (a -> [b]) -> t a -> [b] concatMap f xs = foldr (\x b -> foldr (:) b (f x)) [] xs -- These use foldr rather than foldMap to avoid repeated concatenation. -- -| 'and' returns the conjunction of a container of Bools. For the -- result to be 'True', the container must be finite; 'False', however, -- results from a 'False' value finitely far from the left end. and :: Foldable t => t Bool -> Bool and x = case foldMap all_ x of Monoid.All y -> y -- -| 'or' returns the disjunction of a container of Bools. For the -- result to be 'False', the container must be finite; 'True', however, -- results from a 'True' value finitely far from the left end. or :: Foldable t => t Bool -> Bool or x = case foldMap any_ x of Monoid.Any y -> y -- -| Determines whether any element of the structure satisfies the predicate. any :: Foldable t => (a -> Bool) -> t a -> Bool any p x = case foldMap (any_ . p) x of Monoid.Any y -> y -- -| Determines whether all elements of the structure satisfy the predicate. all :: Foldable t => (a -> Bool) -> t a -> Bool all p x = case foldMap (all_ . p) x of Monoid.All y -> y -- -| The largest element of a non-empty structure with respect to the -- given comparison function. -- See Note [maximumBy/minimumBy space usage] maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1 max' where max' x y = case cmp x y of GT -> x LT -> y EQ -> y -- -| The least element of a non-empty structure with respect to the -- given comparison function. -- See Note [maximumBy/minimumBy space usage] minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1 min' where min' x y = case cmp x y of GT -> y LT -> x EQ -> x -- -| 'notElem' is the negation of 'elem'. notElem :: (Foldable t, Eq a) => a -> t a -> Bool notElem x = not . elem x -- -| The 'find' function takes a predicate and a structure and returns -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element. find :: Foldable t => (a -> Bool) -> t a -> Maybe a find p y = case foldMap (\ x -> First (if p x then Just x else Nothing)) y of First z -> z |]) $(singletonsOnly [d| -- instances for Prelude types (part 2) deriving instance Foldable ((,) a) deriving instance Foldable First deriving instance Foldable Last |]) singletons-2.5.1/src/Data/Singletons/Prelude/Function.hs0000644000000000000000000000655507346545000021416 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Function -- Copyright : (C) 2016 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines singleton versions of the definitions in @Data.Function@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Function@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances, GADTs, DataKinds, PolyKinds #-} module Data.Singletons.Prelude.Function ( -- * "Prelude" re-exports Id, sId, Const, sConst, (:.), (%.), Flip, sFlip, type ($), (%$) -- * Other combinators , type (&), (%&), On, sOn -- * Defunctionalization symbols , IdSym0, IdSym1 , ConstSym0, ConstSym1, ConstSym2 , type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$) , FlipSym0, FlipSym1, FlipSym2, FlipSym3 , type ($@#@$), type ($@#@$$), type ($@#@$$$) , type (&@#@$), type (&@#@$$), type (&@#@$$$) , OnSym0, OnSym1, OnSym2, OnSym3, OnSym4 ) where import Data.Singletons.Prelude.Base import Data.Singletons.Single $(singletonsOnly [d| {- GHC falls into a loop here. Not really a surprise. -- | @'fix' f@ is the least fixed point of the function @f@, -- i.e. the least defined @x@ such that @f x = x@. fix :: (a -> a) -> a fix f = let x = f x in x -} -- -| @(*) \`on\` f = \\x y -> f x * f y@. -- -- Typical usage: @'Data.List.sortBy' ('compare' \`on\` 'fst')@. -- -- Algebraic properties: -- -- -* @(*) \`on\` 'id' = (*)@ (if @(*) ∉ {⊥, 'const' ⊥}@) -- -- -* @((*) \`on\` f) \`on\` g = (*) \`on\` (f . g)@ -- -- -* @'flip' on f . 'flip' on g = 'flip' on (g . f)@ -- Proofs (so that I don't have to edit the test-suite): -- (*) `on` id -- = -- \x y -> id x * id y -- = -- \x y -> x * y -- = { If (*) /= _|_ or const _|_. } -- (*) -- (*) `on` f `on` g -- = -- ((*) `on` f) `on` g -- = -- \x y -> ((*) `on` f) (g x) (g y) -- = -- \x y -> (\x y -> f x * f y) (g x) (g y) -- = -- \x y -> f (g x) * f (g y) -- = -- \x y -> (f . g) x * (f . g) y -- = -- (*) `on` (f . g) -- = -- (*) `on` f . g -- flip on f . flip on g -- = -- (\h (*) -> (*) `on` h) f . (\h (*) -> (*) `on` h) g -- = -- (\(*) -> (*) `on` f) . (\(*) -> (*) `on` g) -- = -- \(*) -> (*) `on` g `on` f -- = { See above. } -- \(*) -> (*) `on` g . f -- = -- (\h (*) -> (*) `on` h) (g . f) -- = -- flip on (g . f) on :: (b -> b -> c) -> (a -> b) -> a -> a -> c (.*.) `on` f = \x y -> f x .*. f y infixl 0 `on` -- -| '&' is a reverse application operator. This provides notational -- convenience. Its precedence is one higher than that of the forward -- application operator '$', which allows '&' to be nested in '$'. -- -- @since 4.8.0.0 (&) :: a -> (a -> b) -> b x & f = f x infixl 1 & |]) -- Workaround for #326 infixl 1 & singletons-2.5.1/src/Data/Singletons/Prelude/Functor.hs0000644000000000000000000001142007346545000021234 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Functor -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'Functor' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Functor ( PFunctor(..), SFunctor(..), type ($>), (%$>), type (<$>), (%<$>), type (<&>), (%<&>), Void, sVoid, -- * Defunctionalization symbols FmapSym0, FmapSym1, FmapSym2, type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), type ($>@#@$), type ($>@#@$$), type ($>@#@$$$), type (<$>@#@$), type (<$>@#@$$), type (<$>@#@$$$), type (<&>@#@$), type (<&>@#@$$), type (<&>@#@$$$), VoidSym0, VoidSym1 ) where import Data.Ord (Down(..)) import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Ord import Data.Singletons.Single $(singletonsOnly [d| infixl 4 <$> -- -| An infix synonym for 'fmap'. -- -- The name of this operator is an allusion to '$'. -- Note the similarities between their types: -- -- > ($) :: (a -> b) -> a -> b -- > (<$>) :: Functor f => (a -> b) -> f a -> f b -- -- Whereas '$' is function application, '<$>' is function -- application lifted over a 'Functor'. -- -- ==== __Examples__ -- -- Convert from a @'Maybe' 'Int'@ to a @'Maybe' 'String'@ using 'show': -- -- >>> show <$> Nothing -- Nothing -- >>> show <$> Just 3 -- Just "3" -- -- Convert from an @'Either' 'Int' 'Int'@ to an @'Either' 'Int'@ -- 'String' using 'show': -- -- >>> show <$> Left 17 -- Left 17 -- >>> show <$> Right 17 -- Right "17" -- -- Double each element of a list: -- -- >>> (*2) <$> [1,2,3] -- [2,4,6] -- -- Apply 'even' to the second element of a pair: -- -- >>> even <$> (2,2) -- (2,True) -- (<$>) :: Functor f => (a -> b) -> f a -> f b (<$>) = fmap infixl 4 $> -- -| Flipped version of '<$>'. -- -- @ -- ('<&>') = 'flip' 'fmap' -- @ -- -- @since 4.11.0.0 -- -- ==== __Examples__ -- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right': -- -- >>> Just 2 <&> (+1) -- Just 3 -- -- >>> [1,2,3] <&> (+1) -- [2,3,4] -- -- >>> Right 3 <&> (+1) -- Right 4 -- (<&>) :: Functor f => f a -> (a -> b) -> f b as <&> f = f <$> as infixl 1 <&> -- -| Flipped version of '<$'. -- -- @since 4.7.0.0 -- -- ==== __Examples__ -- -- Replace the contents of a @'Maybe' 'Int'@ with a constant 'String': -- -- >>> Nothing $> "foo" -- Nothing -- >>> Just 90210 $> "foo" -- Just "foo" -- -- Replace the contents of an @'Either' 'Int' 'Int'@ with a constant -- 'String', resulting in an @'Either' 'Int' 'String'@: -- -- >>> Left 8675309 $> "foo" -- Left 8675309 -- >>> Right 8675309 $> "foo" -- Right "foo" -- -- Replace each element of a list with a constant 'String': -- -- >>> [1,2,3] $> "foo" -- ["foo","foo","foo"] -- -- Replace the second element of a pair with a constant 'String': -- -- >>> (1,2) $> "foo" -- (1,"foo") -- ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) -- -| @'void' value@ discards or ignores the result of evaluation, such -- as the return value of an 'System.IO.IO' action. -- -- ==== __Examples__ -- -- Replace the contents of a @'Maybe' 'Int'@ with unit: -- -- >>> void Nothing -- Nothing -- >>> void (Just 3) -- Just () -- -- Replace the contents of an @'Either' 'Int' 'Int'@ with unit, -- resulting in an @'Either' 'Int' '()'@: -- -- >>> void (Left 8675309) -- Left 8675309 -- >>> void (Right 8675309) -- Right () -- -- Replace every element of a list with unit: -- -- >>> void [1,2,3] -- [(),(),()] -- -- Replace the second element of a pair with unit: -- -- >>> void (1,2) -- (1,()) -- -- Discard the result of an 'System.IO.IO' action: -- -- >>> mapM print [1,2] -- 1 -- 2 -- [(),()] -- >>> void $ mapM print [1,2] -- 1 -- 2 -- void :: Functor f => f a -> f () void x = () <$ x deriving instance Functor ((,) a) deriving instance Functor Down |]) -- Workaround for #326 infixl 4 <$> infixl 4 $> infixl 1 <&> singletons-2.5.1/src/Data/Singletons/Prelude/Identity.hs0000644000000000000000000000767307346545000021424 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Identity -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Richard Eisenberg (rae@cs.brynmawr.edu) -- Stability : experimental -- Portability : non-portable -- -- Exports the promoted and singled versions of the 'Identity' data type. -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Identity ( -- * The 'Identity' singleton Sing(SIdentity, sRunIdentity), SIdentity, RunIdentity, -- * Defunctionalization symbols IdentitySym0, IdentitySym1, RunIdentitySym0, RunIdentitySym1 ) where import Control.Applicative import Data.Foldable (Foldable(..)) import Data.Functor.Identity import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr) import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Instances hiding (Foldl, sFoldl) import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Semigroup.Internal import Data.Singletons.Prelude.Show import Data.Singletons.Single $(singletonsOnly [d| -- deriving instance Enum a => Enum (Identity a) instance Enum a => Enum (Identity a) where succ (Identity x) = Identity (succ x) pred (Identity x) = Identity (pred x) toEnum i = Identity (toEnum i) fromEnum (Identity x) = fromEnum x enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y) enumFromThenTo (Identity x) (Identity y) (Identity z) = map Identity (enumFromThenTo x y z) -- deriving instance Monoid a => Monoid (Identity a) instance Monoid a => Monoid (Identity a) where mempty = Identity mempty -- deriving instance Num a => Num (Identity a) instance Num a => Num (Identity a) where Identity x + Identity y = Identity (x + y) Identity x - Identity y = Identity (x - y) Identity x * Identity y = Identity (x * y) negate (Identity x) = Identity (negate x) abs (Identity x) = Identity (abs x) signum (Identity x) = Identity (signum x) fromInteger n = Identity (fromInteger n) -- deriving instance Semigroup a => Semigroup (Identity a) instance Semigroup a => Semigroup (Identity a) where Identity x <> Identity y = Identity (x <> y) -- -| This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed instance Show a => Show (Identity a) where showsPrec d (Identity x) = showParen (d > 10) $ showString "Identity " . showsPrec 11 x deriving instance Functor Identity instance Foldable Identity where foldMap f (Identity x) = f x elem x (Identity y) = x == y foldl f z (Identity x) = f z x foldl' f z (Identity x) = f z x foldl1 _ (Identity x) = x foldr f z (Identity x) = f x z foldr' = foldr foldr1 _ (Identity x) = x length _ = 1 maximum (Identity x) = x minimum (Identity x) = x null _ = False product (Identity x) = x sum (Identity x) = x toList (Identity x) = [x] instance Applicative Identity where pure = Identity Identity f <*> Identity x = Identity (f x) liftA2 f (Identity x) (Identity y) = Identity (f x y) instance Monad Identity where Identity m >>= k = k m |]) singletons-2.5.1/src/Data/Singletons/Prelude/Instances.hs0000644000000000000000000000166007346545000021550 0ustar0000000000000000{- Data/Singletons/Instances.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu This (internal) module contains the main class definitions for singletons, re-exported from various places. -} {-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs, TypeFamilies, EmptyCase, FlexibleContexts, TemplateHaskell, ScopedTypeVariables, UndecidableInstances, TypeOperators, FlexibleInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.Prelude.Instances where import Data.Singletons.Single import Data.Singletons.Util -- some useful singletons $(genSingletons basicTypes) $(singDecideInstances basicTypes) -- basic definitions we need right away $(singletonsOnly [d| foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b foldl f z0 xs0 = lgo z0 xs0 where lgo :: b -> [a] -> b lgo z [] = z lgo z (x:xs) = lgo (f z x) xs |]) singletons-2.5.1/src/Data/Singletons/Prelude/IsString.hs0000644000000000000000000000345307346545000021365 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.IsString -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines and exports a promoted and singled version of the 'IsString' -- type class from "Data.String". ---------------------------------------------------------------------------- module Data.Singletons.Prelude.IsString ( PIsString(..), SIsString(..), -- ** Defunctionalization symbols FromStringSym0, FromStringSym1 ) where import Data.Functor.Const import Data.Functor.Identity import Data.Singletons.Prelude.Const import Data.Singletons.Prelude.Identity import Data.Singletons.Single import Data.Singletons.TypeLits () -- for the IsString instance! import GHC.TypeLits (Symbol) $(singletonsOnly [d| -- -| Class for string-like datastructures; used by the overloaded string -- extension (-XOverloadedStrings in GHC). class IsString a where fromString :: Symbol -> a -- deriving instance IsString a => IsString (Const a (b :: k)) instance IsString a => IsString (Const a (b :: k)) where fromString x = Const (fromString x) -- deriving instance IsString a => IsString (Identity a) instance IsString a => IsString (Identity a) where fromString x = Identity (fromString x) |]) -- PIsString instance instance PIsString Symbol where type FromString a = a -- SIsString instance instance SIsString Symbol where sFromString x = x singletons-2.5.1/src/Data/Singletons/Prelude/List.hs0000644000000000000000000002501507346545000020534 0ustar0000000000000000{-# LANGUAGE ExplicitNamespaces #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for '[]', -- including a singletons version of a few of the definitions in @Data.List@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.List@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.List ( -- * The singleton for lists Sing(SNil, SCons), -- | Though Haddock doesn't show it, the 'Sing' instance above declares -- constructors -- -- > SNil :: Sing '[] -- > SCons :: Sing (h :: k) -> Sing (t :: [k]) -> Sing (h ': t) SList, -- | 'SList' is a kind-restricted synonym for 'Sing': @type SList (a :: [k]) = Sing a@ -- * Basic functions type (++), (%++), Head, sHead, Last, sLast, Tail, sTail, Init, sInit, Null, sNull, Length, sLength, -- * List transformations Map, sMap, Reverse, sReverse, Intersperse, sIntersperse, Intercalate, sIntercalate, Transpose, sTranspose, Subsequences, sSubsequences, Permutations, sPermutations, -- * Reducing lists (folds) Foldl, sFoldl, Foldl', sFoldl', Foldl1, sFoldl1, Foldl1', sFoldl1', Foldr, sFoldr, Foldr1, sFoldr1, -- ** Special folds Concat, sConcat, ConcatMap, sConcatMap, And, sAnd, Or, sOr, Any, sAny, All, sAll, Sum, sSum, Product, sProduct, Maximum, sMaximum, Minimum, sMinimum, -- * Building lists -- ** Scans Scanl, sScanl, Scanl1, sScanl1, Scanr, sScanr, Scanr1, sScanr1, -- ** Accumulating maps MapAccumL, sMapAccumL, MapAccumR, sMapAccumR, -- ** Cyclical lists Replicate, sReplicate, -- ** Unfolding Unfoldr, sUnfoldr, -- * Sublists -- ** Extracting sublists Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, DropWhile, sDropWhile, DropWhileEnd, sDropWhileEnd, Span, sSpan, Break, sBreak, StripPrefix, Group, sGroup, Inits, sInits, Tails, sTails, -- ** Predicates IsPrefixOf, sIsPrefixOf, IsSuffixOf, sIsSuffixOf, IsInfixOf, sIsInfixOf, -- * Searching lists -- ** Searching by equality Elem, sElem, NotElem, sNotElem, Lookup, sLookup, -- ** Searching with a predicate Find, sFind, Filter, sFilter, Partition, sPartition, -- * Indexing lists type (!!), (%!!), ElemIndex, sElemIndex, ElemIndices, sElemIndices, FindIndex, sFindIndex, FindIndices, sFindIndices, -- * Zipping and unzipping lists Zip, sZip, Zip3, sZip3, Zip4, Zip5, Zip6, Zip7, ZipWith, sZipWith, ZipWith3, sZipWith3, ZipWith4, ZipWith5, ZipWith6, ZipWith7, Unzip, sUnzip, Unzip3, sUnzip3, Unzip4, sUnzip4, Unzip5, sUnzip5, Unzip6, sUnzip6, Unzip7, sUnzip7, -- * Special lists -- ** Functions on 'Symbol's Unlines, sUnlines, Unwords, sUnwords, -- ** \"Set\" operations Nub, sNub, Delete, sDelete, type (\\), (%\\), Union, sUnion, Intersect, sIntersect, -- ** Ordered lists Insert, sInsert, Sort, sSort, -- * Generalized functions -- ** The \"@By@\" operations -- *** User-supplied equality (replacing an @Eq@ context) -- | The predicate is assumed to define an equivalence. NubBy, sNubBy, DeleteBy, sDeleteBy, DeleteFirstsBy, sDeleteFirstsBy, UnionBy, sUnionBy, IntersectBy, sIntersectBy, GroupBy, sGroupBy, -- *** User-supplied comparison (replacing an @Ord@ context) -- | The function is assumed to define a total ordering. SortBy, sSortBy, InsertBy, sInsertBy, MaximumBy, sMaximumBy, MinimumBy, sMinimumBy, -- ** The \"@generic@\" operations -- | The prefix \`@generic@\' indicates an overloaded function that -- is a generalized version of a "Prelude" function. GenericLength, sGenericLength, GenericTake, GenericDrop, GenericSplitAt, GenericIndex, GenericReplicate, -- * Defunctionalization symbols NilSym0, (:@#@$), (:@#@$$), (:@#@$$$), type (++@#@$$$), type (++@#@$$), type (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1, TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1, LengthSym0, LengthSym1, MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1, IntersperseSym0, IntersperseSym1, IntersperseSym2, IntercalateSym0, IntercalateSym1, IntercalateSym2, TransposeSym0, TransposeSym1, SubsequencesSym0, SubsequencesSym1, PermutationsSym0, PermutationsSym1, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, Foldl1'Sym0, Foldl1'Sym1, Foldl1'Sym2, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, ConcatSym0, ConcatSym1, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, AndSym0, AndSym1, OrSym0, OrSym1, AnySym0, AnySym1, AnySym2, AllSym0, AllSym1, AllSym2, SumSym0, SumSym1, ProductSym0, ProductSym1, MaximumSym0, MaximumSym1, MinimumSym0, MinimumSym1, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, ReplicateSym0, ReplicateSym1, ReplicateSym2, UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, TakeSym0, TakeSym1, TakeSym2, DropSym0, DropSym1, DropSym2, SplitAtSym0, SplitAtSym1, SplitAtSym2, TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, DropWhileSym0, DropWhileSym1, DropWhileSym2, DropWhileEndSym0, DropWhileEndSym1, DropWhileEndSym2, SpanSym0, SpanSym1, SpanSym2, BreakSym0, BreakSym1, BreakSym2, StripPrefixSym0, StripPrefixSym1, StripPrefixSym2, GroupSym0, GroupSym1, InitsSym0, InitsSym1, TailsSym0, TailsSym1, IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, IsSuffixOfSym0, IsSuffixOfSym1, IsSuffixOfSym2, IsInfixOfSym0, IsInfixOfSym1, IsInfixOfSym2, ElemSym0, ElemSym1, ElemSym2, NotElemSym0, NotElemSym1, NotElemSym2, LookupSym0, LookupSym1, LookupSym2, FindSym0, FindSym1, FindSym2, FilterSym0, FilterSym1, FilterSym2, PartitionSym0, PartitionSym1, PartitionSym2, type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ElemIndexSym0, ElemIndexSym1, ElemIndexSym2, ElemIndicesSym0, ElemIndicesSym1, ElemIndicesSym2, FindIndexSym0, FindIndexSym1, FindIndexSym2, FindIndicesSym0, FindIndicesSym1, FindIndicesSym2, ZipSym0, ZipSym1, ZipSym2, Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3, Zip4Sym0, Zip4Sym1, Zip4Sym2, Zip4Sym3, Zip4Sym4, Zip5Sym0, Zip5Sym1, Zip5Sym2, Zip5Sym3, Zip5Sym4, Zip5Sym5, Zip6Sym0, Zip6Sym1, Zip6Sym2, Zip6Sym3, Zip6Sym4, Zip6Sym5, Zip6Sym6, Zip7Sym0, Zip7Sym1, Zip7Sym2, Zip7Sym3, Zip7Sym4, Zip7Sym5, Zip7Sym6, Zip7Sym7, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4, ZipWith4Sym0, ZipWith4Sym1, ZipWith4Sym2, ZipWith4Sym3, ZipWith4Sym4, ZipWith4Sym5, ZipWith5Sym0, ZipWith5Sym1, ZipWith5Sym2, ZipWith5Sym3, ZipWith5Sym4, ZipWith5Sym5, ZipWith5Sym6, ZipWith6Sym0, ZipWith6Sym1, ZipWith6Sym2, ZipWith6Sym3, ZipWith6Sym4, ZipWith6Sym5, ZipWith6Sym6, ZipWith6Sym7, ZipWith7Sym0, ZipWith7Sym1, ZipWith7Sym2, ZipWith7Sym3, ZipWith7Sym4, ZipWith7Sym5, ZipWith7Sym6, ZipWith7Sym7, ZipWith7Sym8, UnzipSym0, UnzipSym1, Unzip3Sym0, Unzip3Sym1, Unzip4Sym0, Unzip4Sym1, Unzip5Sym0, Unzip5Sym1, Unzip6Sym0, Unzip6Sym1, Unzip7Sym0, Unzip7Sym1, UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1, NubSym0, NubSym1, DeleteSym0, DeleteSym1, DeleteSym2, type (\\@#@$), type (\\@#@$$), type (\\@#@$$$), UnionSym0, UnionSym1, UnionSym2, IntersectSym0, IntersectSym1, IntersectSym2, InsertSym0, InsertSym1, InsertSym2, SortSym0, SortSym1, NubBySym0, NubBySym1, NubBySym2, DeleteBySym0, DeleteBySym1, DeleteBySym2, DeleteBySym3, DeleteFirstsBySym0, DeleteFirstsBySym1, DeleteFirstsBySym2, DeleteFirstsBySym3, UnionBySym0, UnionBySym1, UnionBySym2, UnionBySym3, IntersectBySym0, IntersectBySym1, IntersectBySym2, IntersectBySym3, GroupBySym0, GroupBySym1, GroupBySym2, SortBySym0, SortBySym1, SortBySym2, InsertBySym0, InsertBySym1, InsertBySym2, InsertBySym3, MaximumBySym0, MaximumBySym1, MaximumBySym2, MinimumBySym0, MinimumBySym1, MinimumBySym2, GenericLengthSym0, GenericLengthSym1, GenericTakeSym0, GenericTakeSym1, GenericTakeSym2, GenericDropSym0, GenericDropSym1, GenericDropSym2, GenericSplitAtSym0, GenericSplitAtSym1, GenericSplitAtSym2, GenericIndexSym0, GenericIndexSym1, GenericIndexSym2, GenericReplicateSym0, GenericReplicateSym1, GenericReplicateSym2, ) where import Data.Singletons.Prelude.Base ( Map, MapSym0, MapSym1, MapSym2, sMap , type (++), type (++@#@$), type (++@#@$$), type (++@#@$$$), (%++) ) import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Instances (Sing(..), SList, NilSym0, type (:@#@$), type (:@#@$$), type (:@#@$$$)) import Data.Singletons.Prelude.Traversable import Data.Singletons.Prelude.List.Internal hiding ( All, AllSym0, AllSym1, AllSym2, sAll , And, AndSym0, AndSym1, sAnd , Any, AnySym0, AnySym1, AnySym2, sAny , Concat, ConcatSym0, ConcatSym1, sConcat , ConcatMap, ConcatMapSym0, ConcatMapSym1, ConcatMapSym2, sConcatMap , Elem, ElemSym0, ElemSym1, ElemSym2, sElem , Find, FindSym0, FindSym1, FindSym2, sFind , Foldl1, Foldl1Sym0, Foldl1Sym1, Foldl1Sym2, sFoldl1 , Foldl', Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3, sFoldl' , Foldr1, Foldr1Sym0, Foldr1Sym1, Foldr1Sym2, sFoldr1 , MapAccumL, MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, sMapAccumL , MapAccumR, MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, sMapAccumR , Maximum, MaximumSym0, MaximumSym1, sMaximum , MaximumBy, MaximumBySym0, MaximumBySym1, MaximumBySym2, sMaximumBy , Minimum, MinimumSym0, MinimumSym1, sMinimum , MinimumBy, MinimumBySym0, MinimumBySym1, MinimumBySym2, sMinimumBy , Length, LengthSym0, LengthSym1, sLength , NotElem, NotElemSym0, NotElemSym1, NotElemSym2, sNotElem , Null, NullSym0, NullSym1, sNull , Or, OrSym0, OrSym1, sOr , Product, ProductSym0, ProductSym1, sProduct , Sum, SumSym0, SumSym1, sSum ) singletons-2.5.1/src/Data/Singletons/Prelude/List/0000755000000000000000000000000007346545000020175 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Prelude/List/Internal.hs0000644000000000000000000006111607346545000022312 0ustar0000000000000000{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TemplateHaskell, GADTs, UndecidableInstances, RankNTypes, ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-} {-# OPTIONS_GHC -O0 #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List.Internal -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for '[]', -- including a singletons version of a few of the definitions in @Data.List@. -- -- All of the functions defined in this module are specialized for lists, -- unlike "Data.Singletons.Prelude.List", which uses 'Foldable' and -- 'Traversable' contexts when available. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.List.Internal where import Data.Singletons.Prelude.Instances import Data.Singletons.Promote import Data.Singletons.Single import Data.Singletons.TypeLits import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Semigroup.Internal (SSemigroup(..), type (<>@#@$)) import Data.Singletons.Prelude.Tuple import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Maybe $(singletonsOnly [d| head :: [a] -> a head (a : _) = a head [] = error "Data.Singletons.List.head: empty list" last :: [a] -> a last [] = error "Data.Singletons.List.last: empty list" last [x] = x last (_:x:xs) = last (x:xs) tail :: [a] -> [a] tail (_ : t) = t tail [] = error "Data.Singletons.List.tail: empty list" init :: [a] -> [a] init [] = error "Data.Singletons.List.init: empty list" init (x:xs) = init' x xs where init' :: a -> [a] -> [a] init' _ [] = [] init' y (z:zs) = y : init' z zs null :: [a] -> Bool null [] = True null (_:_) = False reverse :: [a] -> [a] reverse l = rev l [] where rev :: [a] -> [a] -> [a] rev [] a = a rev (x:xs) a = rev xs (x:a) intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse sep (x:xs) = x : prependToAll sep xs intercalate :: [a] -> [[a]] -> [a] intercalate xs xss = concat (intersperse xs xss) subsequences :: [a] -> [[a]] subsequences xs = [] : nonEmptySubsequences xs nonEmptySubsequences :: [a] -> [[a]] nonEmptySubsequences [] = [] nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs) where f ys r = ys : (x : ys) : r prependToAll :: a -> [a] -> [a] prependToAll _ [] = [] prependToAll sep (x:xs) = sep : x : prependToAll sep xs permutations :: forall a. [a] -> [[a]] permutations xs0 = xs0 : perms xs0 [] where perms [] _ = [] perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is) where interleave xs r = let (_,zs) = interleave' id xs r in zs -- This type signature isn't present in the reference -- implementation of permutations in base. However, it is needed -- here, since (at least in GHC 8.2.1) the singletonized version -- will fail to typecheck without it. See #13549 for the full story. interleave' :: ([a] -> b) -> [a] -> [b] -> ([a], [b]) interleave' _ [] r = (ts, r) interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r in (y:us, f (t:y:us) : zs) foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b foldl' f z0 xs0 = lgo z0 xs0 where lgo :: b -> [a] -> b lgo z [] = z lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs foldl1 _ [] = error "Data.Singletons.List.foldl1: empty list" foldl1' :: (a -> a -> a) -> [a] -> a foldl1' f (x:xs) = foldl' f x xs foldl1' _ [] = error "Data.Singletons.List.foldl1': empty list" foldr1 :: (a -> a -> a) -> [a] -> a foldr1 _ [x] = x foldr1 f (x:xs@(_:_)) = f x (foldr1 f xs) foldr1 _ [] = error "Data.Singletons.List.foldr1: empty list" concat :: [[a]] -> [a] concat = foldr (++) [] concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = foldr ((++) . f) [] and :: [Bool] -> Bool and [] = True and (x:xs) = x && and xs or :: [Bool] -> Bool or [] = False or (x:xs) = x || or xs all :: (a -> Bool) -> [a] -> Bool all _ [] = True all p (x:xs) = p x && all p xs any :: (a -> Bool) -> [a] -> Bool any _ [] = False any p (x:xs) = p x || any p xs scanl :: (b -> a -> b) -> b -> [a] -> [b] scanl f q ls = q : (case ls of [] -> [] x:xs -> scanl f (f q x) xs) scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanl1 _ [] = [] scanr :: (a -> b -> b) -> b -> [a] -> [b] scanr _ q0 [] = [q0] scanr f q0 (x:xs) = case scanr f q0 xs of [] -> error "Data.Singletons.List.scanr: empty list" (q:qs) -> f x q : (q:qs) scanr1 :: (a -> a -> a) -> [a] -> [a] scanr1 _ [] = [] scanr1 _ [x] = [x] scanr1 f (x:xs@(_:_)) = case scanr1 f xs of [] -> error "Data.Singletons.List.scanr1: empty list" (q:qs) -> f x q : (q:qs) mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) mapAccumL _ s [] = (s, []) mapAccumL f s (x:xs) = (s'',y:ys) where (s', y ) = f s x (s'',ys) = mapAccumL f s' xs mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) mapAccumR _ s [] = (s, []) mapAccumR f s (x:xs) = (s'', y:ys) where (s'',y ) = f s' x (s', ys) = mapAccumR f s xs unfoldr :: (b -> Maybe (a, b)) -> b -> [a] unfoldr f b = case f b of Just (a,new_b) -> a : unfoldr f new_b Nothing -> [] inits :: [a] -> [[a]] inits xs = [] : case xs of [] -> [] x : xs' -> map (x :) (inits xs') tails :: [a] -> [[a]] tails xs = xs : case xs of [] -> [] _ : xs' -> tails xs' isPrefixOf :: (Eq a) => [a] -> [a] -> Bool isPrefixOf [] [] = True isPrefixOf [] (_:_) = True isPrefixOf (_:_) [] = False isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys isSuffixOf :: (Eq a) => [a] -> [a] -> Bool isSuffixOf x y = reverse x `isPrefixOf` reverse y isInfixOf :: (Eq a) => [a] -> [a] -> Bool isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack) elem :: (Eq a) => a -> [a] -> Bool elem _ [] = False elem x (y:ys) = x==y || elem x ys infix 4 `elem` notElem :: (Eq a) => a -> [a] -> Bool notElem _ [] = True notElem x (y:ys) = x /= y && notElem x ys infix 4 `notElem` zip :: [a] -> [b] -> [(a,b)] zip (x:xs) (y:ys) = (x,y) : zip xs ys zip [] [] = [] zip (_:_) [] = [] zip [] (_:_) = [] zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs zip3 [] [] [] = [] zip3 [] [] (_:_) = [] zip3 [] (_:_) [] = [] zip3 [] (_:_) (_:_) = [] zip3 (_:_) [] [] = [] zip3 (_:_) [] (_:_) = [] zip3 (_:_) (_:_) [] = [] zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys zipWith _ [] [] = [] zipWith _ (_:_) [] = [] zipWith _ [] (_:_) = [] zipWith3 :: (a->b->c->d) -> [a]->[b]->[c]->[d] zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs zipWith3 _ [] [] [] = [] zipWith3 _ [] [] (_:_) = [] zipWith3 _ [] (_:_) [] = [] zipWith3 _ [] (_:_) (_:_) = [] zipWith3 _ (_:_) [] [] = [] zipWith3 _ (_:_) [] (_:_) = [] zipWith3 _ (_:_) (_:_) [] = [] unzip :: [(a,b)] -> ([a],[b]) unzip xs = foldr (\(a,b) (as,bs) -> (a:as,b:bs)) ([],[]) xs -- Lazy patterns removed from unzip unzip3 :: [(a,b,c)] -> ([a],[b],[c]) unzip3 xs = foldr (\(a,b,c) (as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[]) xs unzip4 :: [(a,b,c,d)] -> ([a],[b],[c],[d]) unzip4 xs = foldr (\(a,b,c,d) (as,bs,cs,ds) -> (a:as,b:bs,c:cs,d:ds)) ([],[],[],[]) xs unzip5 :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e]) unzip5 xs = foldr (\(a,b,c,d,e) (as,bs,cs,ds,es) -> (a:as,b:bs,c:cs,d:ds,e:es)) ([],[],[],[],[]) xs unzip6 :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f]) unzip6 xs = foldr (\(a,b,c,d,e,f) (as,bs,cs,ds,es,fs) -> (a:as,b:bs,c:cs,d:ds,e:es,f:fs)) ([],[],[],[],[],[]) xs unzip7 :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g]) unzip7 xs = foldr (\(a,b,c,d,e,f,g) (as,bs,cs,ds,es,fs,gs) -> (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs)) ([],[],[],[],[],[],[]) xs -- We can't promote any of these functions because at the type level -- String literals are no longer considered to be lists of Chars, so -- there is mismatch between term-level and type-level semantics -- lines :: String -> [String] -- lines "" = [] -- lines s = cons (case break (== '\n') s of -- (l, s') -> (l, case s' of -- [] -> [] -- _:s'' -> lines s'')) -- where -- cons ~(h, t) = h : t -- -- words :: String -> [String] -- words s = case dropWhile isSpace s of -- "" -> [] -- s' -> w : words s'' -- where (w, s'') = -- break isSpace s' unlines :: [Symbol] -> Symbol unlines [] = "" unlines (l:ls) = l <> "\n" <> unlines ls unwords :: [Symbol] -> Symbol unwords [] = "" unwords (w:ws) = w <> go ws where go [] = "" go (v:vs) = " " <> (v <> go vs) delete :: (Eq a) => a -> [a] -> [a] delete = deleteBy (==) (\\) :: (Eq a) => [a] -> [a] -> [a] (\\) = foldl (flip delete) infix 5 \\ -- This comment is necessary so CPP doesn't treat the -- trailing backslash as a line splice. Urgh. deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] deleteBy _ _ [] = [] deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] deleteFirstsBy eq = foldl (flip (deleteBy eq)) sortBy :: (a -> a -> Ordering) -> [a] -> [a] sortBy cmp = foldr (insertBy cmp) [] insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBy _ x [] = [x] insertBy cmp x ys@(y:ys') = case cmp x y of GT -> y : insertBy cmp x ys' LT -> x : ys EQ -> x : ys maximumBy :: (a -> a -> Ordering) -> [a] -> a maximumBy _ [] = error "Data.Singletons.List.maximumBy: empty list" maximumBy cmp xs@(_:_) = foldl1 maxBy xs where maxBy x y = case cmp x y of GT -> x EQ -> y LT -> y minimumBy :: (a -> a -> Ordering) -> [a] -> a minimumBy _ [] = error "Data.Singletons.List.minimumBy: empty list" minimumBy cmp xs@(_:_) = foldl1 minBy xs where minBy x y = case cmp x y of GT -> y EQ -> x LT -> x filter :: (a -> Bool) -> [a] -> [a] filter _p [] = [] filter p (x:xs) = if p x then x : filter p xs else filter p xs find :: (a -> Bool) -> [a] -> Maybe a find p = listToMaybe . filter p -- These three rely on findIndices, which does not promote. -- Since we have our own implementation of findIndices these are perfectly valid elemIndex :: Eq a => a -> [a] -> Maybe Nat elemIndex x = findIndex (x==) elemIndices :: Eq a => a -> [a] -> [Nat] elemIndices x = findIndices (x==) findIndex :: (a -> Bool) -> [a] -> Maybe Nat findIndex p = listToMaybe . findIndices p -- Uses infinite lists and and Ints -- findIndices :: (a -> Bool) -> [a] -> [Int] -- findIndices p xs = [ i | (x,i) <- zip xs [0..], p x] findIndices :: (a -> Bool) -> [a] -> [Nat] findIndices p xs = map snd (filter (\(x,_) -> p x) (zip xs (buildList 0 xs))) where buildList :: Nat -> [b] -> [Nat] buildList _ [] = [] buildList a (_:rest) = a : buildList (a+1) rest intersect :: (Eq a) => [a] -> [a] -> [a] intersect = intersectBy (==) intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] intersectBy _ [] [] = [] intersectBy _ [] (_:_) = [] intersectBy _ (_:_) [] = [] intersectBy eq xs@(_:_) ys@(_:_) = [x | x <- xs, any (eq x) ys] takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] takeWhile p (x:xs) = if p x then x : takeWhile p xs else [] dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile _ [] = [] dropWhile p xs@(x:xs') = if p x then dropWhile p xs' else xs dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] span :: (a -> Bool) -> [a] -> ([a],[a]) span _ xs@[] = (xs, xs) span p xs@(x:xs') = if p x then let (ys,zs) = span p xs' in (x:ys,zs) else ([], xs) break :: (a -> Bool) -> [a] -> ([a],[a]) break _ xs@[] = (xs, xs) break p xs@(x:xs') = if p x then ([],xs) else let (ys,zs) = break p xs' in (x:ys,zs) -- Can't be promoted because of limitations of Int promotion -- Below is a re-implementation using Nat -- take :: Int -> [a] -> [a] -- take n _ | n <= 0 = [] -- take _ [] = [] -- take n (x:xs) = x : take (n-1) xs -- drop :: Int -> [a] -> [a] -- drop n xs | n <= 0 = xs -- drop _ [] = [] -- drop n (_:xs) = drop (n-1) xs -- splitAt :: Int -> [a] -> ([a],[a]) -- splitAt n xs = (take n xs, drop n xs) take :: Nat -> [a] -> [a] take _ [] = [] take n (x:xs) = if n == 0 then [] else x : take (n-1) xs drop :: Nat -> [a] -> [a] drop _ [] = [] drop n (x:xs) = if n == 0 then x:xs else drop (n-1) xs splitAt :: Nat -> [a] -> ([a],[a]) splitAt n xs = (take n xs, drop n xs) group :: Eq a => [a] -> [[a]] group xs = groupBy (==) xs maximum :: (Ord a) => [a] -> a maximum [] = error "Data.Singletons.List.maximum: empty list" maximum xs@(_:_) = foldl1 max xs minimum :: (Ord a) => [a] -> a minimum [] = error "Data.Singletons.List.minimum: empty list" minimum xs@(_:_) = foldl1 min xs insert :: Ord a => a -> [a] -> [a] insert e ls = insertBy (compare) e ls sort :: (Ord a) => [a] -> [a] sort = sortBy compare groupBy :: (a -> a -> Bool) -> [a] -> [[a]] groupBy _ [] = [] groupBy eq (x:xs) = (x:ys) : groupBy eq zs where (ys,zs) = span (eq x) xs lookup :: (Eq a) => a -> [(a,b)] -> Maybe b lookup _key [] = Nothing lookup key ((x,y):xys) = if key == x then Just y else lookup key xys partition :: (a -> Bool) -> [a] -> ([a],[a]) partition p xs = foldr (select p) ([],[]) xs -- Lazy pattern removed from select select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) select p x (ts,fs) = if p x then (x:ts,fs) else (ts, x:fs) -- Can't be promoted because of limitations of Int promotion -- Below is a re-implementation using Nat -- sum :: (Num a) => [a] -> a -- sum l = sum' l 0 -- where -- sum' [] a = a -- sum' (x:xs) a = sum' xs (a+x) -- -- product :: (Num a) => [a] -> a -- product l = prod l 1 -- where -- prod [] a = a -- prod (x:xs) a = prod xs (a*x) sum :: forall a. Num a => [a] -> a sum l = sum' l 0 where sum' :: [a] -> a -> a sum' [] a = a sum' (x:xs) a = sum' xs (a+x) product :: forall a. Num a => [a] -> a product l = prod l 1 where prod :: [a] -> a -> a prod [] a = a prod (x:xs) a = prod xs (a*x) -- Can't be promoted because of limitations of Int promotion -- Below is a re-implementation using Nat -- length :: [a] -> Int -- length l = lenAcc l 0# -- -- lenAcc :: [a] -> Int# -> Int -- lenAcc [] a# = I# a# -- lenAcc (_:xs) a# = lenAcc xs (a# +# 1#) -- -- incLen :: a -> (Int# -> Int) -> Int# -> Int -- incLen _ g x = g (x +# 1#) length :: [a] -> Nat length [] = 0 length (_:xs) = 1 + length xs -- Functions working on infinite lists don't promote because they create -- infinite types. replicate also uses integers, but luckily it can be rewritten -- iterate :: (a -> a) -> a -> [a] -- iterate f x = x : iterate f (f x) -- -- repeat :: a -> [a] -- repeat x = xs where xs = x : xs -- -- replicate :: Int -> a -> [a] -- replicate n x = take n (repeat x) -- -- cycle :: [a] -> [a] -- cycle [] = error "Data.Singletons.List.cycle: empty list" -- cycle xs = xs' where xs' = xs ++ xs' replicate :: Nat -> a -> [a] replicate n x = if n == 0 then [] else x : replicate (n-1) x -- Uses partial pattern-matching in a list comprehension -- (see https://github.com/goldfirere/singletons/issues/340) -- transpose :: [[a]] -> [[a]] -- transpose [] = [] -- transpose ([] : xss) = transpose xss -- transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss transpose ((x:xs) : xss) = (x : (map head xss)) : transpose (xs : (map tail xss)) -- Can't be promoted because of limitations of Int promotion. -- Below is a re-implementation using Nat -- (!!) :: [a] -> Int -> a -- xs !! n | n < 0 = error "Data.Singletons.List.!!: negative index" -- [] !! _ = error "Data.Singletons.List.!!: index too large" -- (x:_) !! 0 = x -- (_:xs) !! n = xs !! (n-1) (!!) :: [a] -> Nat -> a [] !! _ = error "Data.Singletons.List.!!: index too large" (x:xs) !! n = if n == 0 then x else xs !! (n-1) infixl 9 !! nub :: forall a. (Eq a) => [a] -> [a] nub l = nub' l [] where nub' :: [a] -> [a] -> [a] nub' [] _ = [] nub' (x:xs) ls = if x `elem` ls then nub' xs ls else x : nub' xs (x:ls) nubBy :: (a -> a -> Bool) -> [a] -> [a] nubBy eq l = nubBy' l [] where nubBy' [] _ = [] nubBy' (y:ys) xs = if elem_by eq y xs then nubBy' ys xs else y : nubBy' ys (y:xs) elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool elem_by _ _ [] = False elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs union :: (Eq a) => [a] -> [a] -> [a] union = unionBy (==) genericLength :: (Num i) => [a] -> i genericLength [] = 0 genericLength (_:xs) = 1 + genericLength xs |]) -- Workaround for #326 infix 5 \\ -- This comment is necessary so CPP doesn't treat the infixl 9 !! -- The following functions are supported for promotion only. $(promoteOnly [d| -- Overlapping patterns don't singletonize stripPrefix :: Eq a => [a] -> [a] -> Maybe [a] stripPrefix [] ys = Just ys stripPrefix (x:xs) (y:ys) | x == y = stripPrefix xs ys stripPrefix _ _ = Nothing -- To singletonize these we would need to rewrite all patterns -- as non-overlapping. This means 2^7 equations for zipWith7. zip4 :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)] zip4 = zipWith4 (,,,) zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)] zip5 = zipWith5 (,,,,) zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a,b,c,d,e,f)] zip6 = zipWith6 (,,,,,) zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a,b,c,d,e,f,g)] zip7 = zipWith7 (,,,,,,) zipWith4 :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] zipWith4 z (a:as) (b:bs) (c:cs) (d:ds) = z a b c d : zipWith4 z as bs cs ds zipWith4 _ _ _ _ _ = [] zipWith5 :: (a->b->c->d->e->f) -> [a]->[b]->[c]->[d]->[e]->[f] zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) = z a b c d e : zipWith5 z as bs cs ds es zipWith5 _ _ _ _ _ _ = [] zipWith6 :: (a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g] zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) = z a b c d e f : zipWith6 z as bs cs ds es fs zipWith6 _ _ _ _ _ _ _ = [] zipWith7 :: (a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h] zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) = z a b c d e f g : zipWith7 z as bs cs ds es fs gs zipWith7 _ _ _ _ _ _ _ _ = [] -- These functions use Integral or Num typeclass instead of Int. -- -- genericLength, genericTake, genericDrop, genericSplitAt, genericIndex -- genericReplicate -- -- We provide aliases below to improve compatibility genericTake :: (Integral i) => i -> [a] -> [a] genericTake = take genericDrop :: (Integral i) => i -> [a] -> [a] genericDrop = drop genericSplitAt :: (Integral i) => i -> [a] -> ([a], [a]) genericSplitAt = splitAt genericIndex :: (Integral i) => [a] -> i -> a genericIndex = (!!) genericReplicate :: (Integral i) => i -> a -> [a] genericReplicate = replicate |]) singletons-2.5.1/src/Data/Singletons/Prelude/List/Internal/0000755000000000000000000000000007346545000021751 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs0000644000000000000000000000742507346545000025254 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List.Internal.Disambiguation -- Copyright : (C) 2016 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Renames a bunch of List functions because singletons can't support qualified -- names. :( -- ---------------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, UndecidableInstances, GADTs, DataKinds, PolyKinds #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module Data.Singletons.Prelude.List.Internal.Disambiguation where import Data.Singletons.Single import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.List.Internal import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Eq import Data.List import GHC.TypeLits -- singletons doesn't support qualified names :( $(singletons [d| listlast :: [a] -> a listlast = last listinit :: [a] -> [a] listinit = init listsort :: Ord a => [a] -> [a] listsort = sort listinits :: [a] -> [[a]] listinits = inits listtails :: [a] -> [[a]] listtails = tails listinsert :: Ord a => a -> [a] -> [a] listinsert = insert listscanl :: (b -> a -> b) -> b -> [a] -> [b] listscanl = scanl listscanr :: (a -> b -> b) -> b -> [a] -> [b] listscanr = scanr listscanr1 :: (a -> a -> a) -> [a] -> [a] listscanr1 = scanr1 listintersperse :: a -> [a] -> [a] listintersperse = intersperse listreverse :: [a] -> [a] listreverse = reverse listtakeWhile :: (a -> Bool) -> [a] -> [a] listtakeWhile = takeWhile listdropWhile :: (a -> Bool) -> [a] -> [a] listdropWhile = dropWhile listspan :: (a -> Bool) -> [a] -> ([a], [a]) listspan = span listfilter :: (a -> Bool) -> [a] -> [a] listfilter = filter listpartition :: (a -> Bool) -> [a] -> ([a], [a]) listpartition = partition listsortBy :: (a -> a -> Ordering) -> [a] -> [a] listsortBy = sortBy listisPrefixOf :: Eq a => [a] -> [a] -> Bool listisPrefixOf = isPrefixOf listzip :: [a] -> [b] -> [(a, b)] listzip = zip listzipWith :: (a -> b -> c) -> [a] -> [b] -> [c] listzipWith = zipWith listnubBy :: (a -> a -> Bool) -> [a] -> [a] listnubBy = nubBy listtranspose :: [[a]] -> [[a]] listtranspose = transpose listunzip :: [(a,b)] -> ([a],[b]) listunzip = unzip listmap :: (a -> b) -> [a] -> [b] listmap = map listelem :: Eq a => a -> [a] -> Bool listelem = elem listfoldl :: (b -> a -> b) -> b -> [a] -> b listfoldl = foldl listfoldl' :: (b -> a -> b) -> b -> [a] -> b listfoldl' = foldl' listfoldl1 :: (a -> a -> a) -> [a] -> a listfoldl1 = foldl1 listfoldr :: (a -> b -> b) -> b -> [a] -> b listfoldr = foldr listfoldr1 :: (a -> a -> a) -> [a] -> a listfoldr1 = foldr1 listmaximum :: Ord a => [a] -> a listmaximum = maximum listminimum :: Ord a => [a] -> a listminimum = minimum listnull :: [a] -> Bool listnull = null listproduct :: Num a => [a] -> a listproduct = product listsum :: Num a => [a] -> a listsum = sum |]) $(singletonsOnly [d| listtake :: Nat -> [a] -> [a] listtake = take listdrop :: Nat -> [a] -> [a] listdrop = drop listsplitAt :: Nat -> [a] -> ([a], [a]) listsplitAt = splitAt listindex :: [a] -> Nat -> a listindex = (!!) listlength :: [a] -> Nat listlength = length |]) listtake :: Nat -> [a] -> [a] listtake = undefined listdrop :: Nat -> [a] -> [a] listdrop = undefined listsplitAt :: Nat -> [a] -> ([a], [a]) listsplitAt = undefined listindex :: [a] -> Nat -> a listindex = undefined listlength :: [a] -> Nat listlength = undefined singletons-2.5.1/src/Data/Singletons/Prelude/List/NonEmpty.hs0000644000000000000000000004471107346545000022311 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, TypeFamilies, GADTs, UndecidableInstances, InstanceSigs, DataKinds, PolyKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.List.NonEmpty -- Copyright : (C) 2016 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for 'NonEmpty', -- including a singletons version of all the definitions in @Data.List.NonEmpty@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.List.NonEmpty@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.List.NonEmpty ( -- * The 'NonEmpty' singleton Sing((:%|)), -- | Though Haddock doesn't show it, the 'Sing' instance above declares -- constructor -- -- > (:%|) :: Sing h -> Sing t -> Sing (h :| t) SNonEmpty, -- | 'SNonEmpty' is a kind-restricted synonym for 'Sing': -- @type SNonEmpty (a :: NonEmpty) = Sing a@ -- * Non-empty stream transformations Map, sMap, Intersperse, sIntersperse, Scanl, sScanl, Scanr, sScanr, Scanl1, sScanl1, Scanr1, sScanr1, Transpose, sTranspose, SortBy, sSortBy, SortWith, sSortWith, Length, sLength, Head, sHead, Tail, sTail, Last, sLast, Init, sInit, type (<|), (%<|), Cons, sCons, Uncons, sUncons, Unfoldr, sUnfoldr, Sort, sSort, Reverse, sReverse, Inits, sInits, Tails, sTails, Unfold, sUnfold, Insert, sInsert, Take, sTake, Drop, sDrop, SplitAt, sSplitAt, TakeWhile, sTakeWhile, DropWhile, sDropWhile, Span, sSpan, Break, sBreak, Filter, sFilter, Partition, sPartition, Group, sGroup, GroupBy, sGroupBy, GroupWith, sGroupWith, GroupAllWith, sGroupAllWith, Group1, sGroup1, GroupBy1, sGroupBy1, GroupWith1, sGroupWith1, GroupAllWith1, sGroupAllWith1, IsPrefixOf, sIsPrefixOf, Nub, sNub, NubBy, sNubBy, type (!!), (%!!), Zip, sZip, ZipWith, sZipWith, Unzip, sUnzip, FromList, sFromList, ToList, sToList, NonEmpty_, sNonEmpty_, Xor, sXor, -- * Defunctionalization symbols (:|@#@$), (:|@#@$$), (:|@#@$$$), MapSym0, MapSym1, MapSym2, IntersperseSym0, IntersperseSym1, IntersperseSym2, ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3, ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3, Scanl1Sym0, Scanl1Sym1, Scanl1Sym2, Scanr1Sym0, Scanr1Sym1, Scanr1Sym2, TransposeSym0, TransposeSym1, SortBySym0, SortBySym1, SortBySym2, SortWithSym0, SortWithSym1, SortWithSym2, LengthSym0, LengthSym1, HeadSym0, HeadSym1, TailSym0, TailSym1, LastSym0, LastSym1, InitSym0, InitSym1, type (<|@#@$), type (<|@#@$$), type (<|@#@$$$), ConsSym0, ConsSym1, ConsSym2, UnconsSym0, UnconsSym1, UnfoldrSym0, UnfoldrSym1, UnfoldrSym2, SortSym0, SortSym1, ReverseSym0, ReverseSym1, InitsSym0, InitsSym1, TailsSym0, TailsSym1, UnfoldSym0, UnfoldSym1, InsertSym0, InsertSym1, InsertSym2, TakeSym0, TakeSym1, TakeSym2, DropSym0, DropSym1, DropSym2, SplitAtSym0, SplitAtSym1, SplitAtSym2, TakeWhileSym0, TakeWhileSym1, TakeWhileSym2, DropWhileSym0, DropWhileSym1, DropWhileSym2, SpanSym0, SpanSym1, SpanSym2, BreakSym0, BreakSym1, BreakSym2, FilterSym0, FilterSym1, FilterSym2, PartitionSym0, PartitionSym1, PartitionSym2, GroupSym0, GroupSym1, GroupBySym0, GroupBySym1, GroupBySym2, GroupWithSym0, GroupWithSym1, GroupWithSym2, GroupAllWithSym0, GroupAllWithSym1, GroupAllWithSym2, Group1Sym0, Group1Sym1, GroupBy1Sym0, GroupBy1Sym1, GroupBy1Sym2, GroupWith1Sym0, GroupWith1Sym1, GroupWith1Sym2, GroupAllWith1Sym0, GroupAllWith1Sym1, GroupAllWith1Sym2, IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2, NubSym0, NubSym1, NubBySym0, NubBySym1, NubBySym2, type (!!@#@$), type (!!@#@$$), type (!!@#@$$$), ZipSym0, ZipSym1, ZipSym2, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3, UnzipSym0, UnzipSym1, FromListSym0, FromListSym1, ToListSym0, ToListSym1, NonEmpty_Sym0, NonEmpty_Sym1, XorSym0, XorSym1 ) where import Control.Monad.Zip import Data.List.NonEmpty import Data.Singletons.Prelude.List.Internal.Disambiguation import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Base hiding ( MapSym0, MapSym1, MapSym2, Map, sMap ) import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Monad.Zip import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Function import Data.Function import Data.Ord import Data.Singletons.TypeLits import Data.Singletons.Single $(singletonsOnly [d| {- -- | @since 4.9.0.0 instance Exts.IsList (NonEmpty a) where type Item (NonEmpty a) = a fromList = fromList toList = toList -- | @since 4.9.0.0 instance MonadFix NonEmpty where mfix f = case fix (f . head) of ~(x :| _) -> x :| mfix (tail . f) -} instance MonadZip NonEmpty where mzip = zip mzipWith = zipWith munzip = unzip -- needed to implement other functions fmap :: (a -> b) -> NonEmpty a -> NonEmpty b fmap f (x :| xs) = f x :| listmap f xs -- -| Number of elements in 'NonEmpty' list. length :: NonEmpty a -> Nat length (_ :| xs) = 1 + listlength xs -- -| Compute n-ary logic exclusive OR operation on 'NonEmpty' list. xor :: NonEmpty Bool -> Bool xor (x :| xs) = foldr xor' x xs where xor' True y = not y xor' False y = y -- -| 'unfold' produces a new stream by repeatedly applying the unfolding -- function to the seed value to produce an element of type @b@ and a new -- seed value. When the unfolding function returns 'Nothing' instead of -- a new seed value, the stream ends. unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfold f a = case f a of (b, Nothing) -> b :| [] (b, Just c) -> b <| unfold f c -- -| 'nonEmpty' efficiently turns a normal list into a 'NonEmpty' stream, -- producing 'Nothing' if the input is empty. nonEmpty_ :: [a] -> Maybe (NonEmpty a) nonEmpty_ [] = Nothing nonEmpty_ (a:as) = Just (a :| as) -- -| 'uncons' produces the first element of the stream, and a stream of the -- remaining elements, if any. uncons :: NonEmpty a -> (a, Maybe (NonEmpty a)) uncons (a :| as) = (a, nonEmpty_ as) -- -| The 'unfoldr' function is analogous to "Data.List"'s -- 'Data.List.unfoldr' operation. unfoldr :: (a -> (b, Maybe a)) -> a -> NonEmpty b unfoldr f a = case f a of (b, mc) -> b :| maybe_ [] go mc where go c = case f c of (d, me) -> d : maybe_ [] go me {- -- | @since 4.9.0.0 instance Functor NonEmpty where fmap f ~(a :| as) = f a :| fmap f as b <$ ~(_ :| as) = b :| (b <$ as) -- | @since 4.9.0.0 instance Applicative NonEmpty where pure a = a :| [] (<*>) = ap -- | @since 4.9.0.0 instance Monad NonEmpty where ~(a :| as) >>= f = b :| (bs ++ bs') where b :| bs = f a bs' = as >>= toList . f -- | @since 4.9.0.0 instance Traversable NonEmpty where traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as -- | @since 4.9.0.0 instance Foldable NonEmpty where foldr f z ~(a :| as) = f a (foldr f z as) foldl f z ~(a :| as) = foldl f (f z a) as foldl1 f ~(a :| as) = foldl f a as foldMap f ~(a :| as) = f a `mappend` foldMap f as fold ~(m :| ms) = m `mappend` fold ms -} -- -| Extract the first element of the stream. head :: NonEmpty a -> a head (a :| _) = a -- -| Extract the possibly-empty tail of the stream. tail :: NonEmpty a -> [a] tail (_ :| as) = as -- -| Extract the last element of the stream. last :: NonEmpty a -> a last (a :| as) = listlast (a : as) -- -| Extract everything except the last element of the stream. init :: NonEmpty a -> [a] init (a :| as) = listinit (a : as) -- -| Prepend an element to the stream. (<|) :: a -> NonEmpty a -> NonEmpty a a <| (b :| bs) = a :| b : bs -- -| Synonym for '<|'. cons :: a -> NonEmpty a -> NonEmpty a cons = (<|) -- -| Sort a stream. sort :: Ord a => NonEmpty a -> NonEmpty a sort = lift listsort -- -| Converts a normal list to a 'NonEmpty' stream. -- -- Raises an error if given an empty list. fromList :: [a] -> NonEmpty a fromList (a:as) = a :| as fromList [] = error "NonEmpty.fromList: empty list" -- -| Convert a stream to a normal list efficiently. toList :: NonEmpty a -> [a] toList (a :| as) = a : as -- -| Lift list operations to work on a 'NonEmpty' stream. -- -- /Beware/: If the provided function returns an empty list, -- this will raise an error. lift :: ([a] -> [b]) -> NonEmpty a -> NonEmpty b lift f = fromList . f . toList -- -| Map a function over a 'NonEmpty' stream. map :: (a -> b) -> NonEmpty a -> NonEmpty b map f (a :| as) = f a :| listmap f as -- -| The 'inits' function takes a stream @xs@ and returns all the -- finite prefixes of @xs@. inits :: [a] -> NonEmpty [a] inits = fromList . listinits -- -| The 'tails' function takes a stream @xs@ and returns all the -- suffixes of @xs@. tails :: [a] -> NonEmpty [a] tails = fromList . listtails -- -| @'insert' x xs@ inserts @x@ into the last position in @xs@ where it -- is still less than or equal to the next element. In particular, if the -- list is sorted beforehand, the result will also be sorted. insert :: Ord a => a -> [a] -> NonEmpty a insert a = fromList . listinsert a {- -- | @'some1' x@ sequences @x@ one or more times. some1 :: Alternative f => f a -> f (NonEmpty a) some1 x = (:|) <$> x <*> many x -} -- -| 'scanl' is similar to 'foldl', but returns a stream of successive -- reduced values from the left: -- -- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...] -- -- Note that -- -- > last (scanl f z xs) == foldl f z xs. scanl :: (b -> a -> b) -> b -> [a] -> NonEmpty b scanl f z = fromList . listscanl f z -- -| 'scanr' is the right-to-left dual of 'scanl'. -- Note that -- -- > head (scanr f z xs) == foldr f z xs. scanr :: (a -> b -> b) -> b -> [a] -> NonEmpty b scanr f z = fromList . listscanr f z -- -| 'scanl1' is a variant of 'scanl' that has no starting value argument: -- -- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...] scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanl1 f (a :| as) = fromList (listscanl f a as) -- -| 'scanr1' is a variant of 'scanr' that has no starting value argument. scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a scanr1 f (a :| as) = fromList (listscanr1 f (a:as)) -- -| 'intersperse x xs' alternates elements of the list with copies of @x@. -- -- > intersperse 0 (1 :| [2,3]) == 1 :| [0,2,0,3] intersperse :: a -> NonEmpty a -> NonEmpty a intersperse a (b :| bs) = b :| case bs of [] -> [] _:_ -> a : listintersperse a bs {- -- | @'iterate' f x@ produces the infinite sequence -- of repeated applications of @f@ to @x@. -- -- > iterate f x = x :| [f x, f (f x), ..] iterate :: (a -> a) -> a -> NonEmpty a iterate f a = a :| listiterate f (f a) -- | @'cycle' xs@ returns the infinite repetition of @xs@: -- -- > cycle (1 :| [2,3]) = 1 :| [2,3,1,2,3,...] cycle :: NonEmpty a -> NonEmpty a cycle = fromList . listcycle . toList -} -- -| 'reverse' a finite NonEmpty stream. reverse :: NonEmpty a -> NonEmpty a reverse = lift listreverse {- -- | @'repeat' x@ returns a constant stream, where all elements are -- equal to @x@. repeat :: a -> NonEmpty a repeat a = a :| listrepeat a -} -- -| @'take' n xs@ returns the first @n@ elements of @xs@. take :: Nat -> NonEmpty a -> [a] take n = listtake n . toList -- -| @'drop' n xs@ drops the first @n@ elements off the front of -- the sequence @xs@. drop :: Nat -> NonEmpty a -> [a] drop n = listdrop n . toList -- -| @'splitAt' n xs@ returns a pair consisting of the prefix of @xs@ -- of length @n@ and the remaining stream immediately following this prefix. -- -- > 'splitAt' n xs == ('take' n xs, 'drop' n xs) -- > xs == ys ++ zs where (ys, zs) = 'splitAt' n xs splitAt :: Nat -> NonEmpty a -> ([a],[a]) splitAt n = listsplitAt n . toList -- -| @'takeWhile' p xs@ returns the longest prefix of the stream -- @xs@ for which the predicate @p@ holds. takeWhile :: (a -> Bool) -> NonEmpty a -> [a] takeWhile p = listtakeWhile p . toList -- -| @'dropWhile' p xs@ returns the suffix remaining after -- @'takeWhile' p xs@. dropWhile :: (a -> Bool) -> NonEmpty a -> [a] dropWhile p = listdropWhile p . toList -- -| @'span' p xs@ returns the longest prefix of @xs@ that satisfies -- @p@, together with the remainder of the stream. -- -- > 'span' p xs == ('takeWhile' p xs, 'dropWhile' p xs) -- > xs == ys ++ zs where (ys, zs) = 'span' p xs span :: (a -> Bool) -> NonEmpty a -> ([a], [a]) span p = listspan p . toList -- -| The @'break' p@ function is equivalent to @'span' (not . p)@. break :: (a -> Bool) -> NonEmpty a -> ([a], [a]) break p = span (not . p) -- -| @'filter' p xs@ removes any elements from @xs@ that do not satisfy @p@. filter :: (a -> Bool) -> NonEmpty a -> [a] filter p = listfilter p . toList -- -| The 'partition' function takes a predicate @p@ and a stream -- @xs@, and returns a pair of lists. The first list corresponds to the -- elements of @xs@ for which @p@ holds; the second corresponds to the -- elements of @xs@ for which @p@ does not hold. -- -- > 'partition' p xs = ('filter' p xs, 'filter' (not . p) xs) partition :: (a -> Bool) -> NonEmpty a -> ([a], [a]) partition p = listpartition p . toList -- -| The 'group' function takes a stream and returns a list of -- streams such that flattening the resulting list is equal to the -- argument. Moreover, each stream in the resulting list -- contains only equal elements. For example, in list notation: -- -- > 'group' $ 'cycle' "Mississippi" -- > = "M" : "i" : "ss" : "i" : "ss" : "i" : "pp" : "i" : "M" : "i" : ... group :: Eq a => [a] -> [NonEmpty a] group = groupBy (==) -- -| 'groupBy' operates like 'group', but uses the provided equality -- predicate instead of `==`. groupBy :: (a -> a -> Bool) -> [a] -> [NonEmpty a] groupBy eq0 = go eq0 where go _ [] = [] go eq (x : xs) = (x :| ys) : groupBy eq zs where (ys, zs) = listspan (eq x) xs -- -| 'groupWith' operates like 'group', but uses the provided projection when -- comparing for equality groupWith :: Eq b => (a -> b) -> [a] -> [NonEmpty a] groupWith f = groupBy ((==) `on` f) -- -| 'groupAllWith' operates like 'groupWith', but sorts the list -- first so that each equivalence class has, at most, one list in the -- output groupAllWith :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] groupAllWith f = groupWith f . listsortBy (compare `on` f) -- -| 'group1' operates like 'group', but uses the knowledge that its -- input is non-empty to produce guaranteed non-empty output. group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a) group1 = groupBy1 (==) -- -| 'groupBy1' is to 'group1' as 'groupBy' is to 'group'. groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a) groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs where (ys, zs) = listspan (eq x) xs -- -| 'groupWith1' is to 'group1' as 'groupWith' is to 'group' groupWith1 :: (Eq b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupWith1 f = groupBy1 ((==) `on` f) -- -| 'groupAllWith1' is to 'groupWith1' as 'groupAllWith' is to 'groupWith' groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a) groupAllWith1 f = groupWith1 f . sortWith f -- -| The 'isPrefix' function returns @True@ if the first argument is -- a prefix of the second. isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool isPrefixOf [] _ = True isPrefixOf (y:ys) (x :| xs) = (y == x) && listisPrefixOf ys xs -- -| @xs !! n@ returns the element of the stream @xs@ at index -- @n@. Note that the head of the stream has index 0. -- -- /Beware/: a negative or out-of-bounds index will cause an error. (!!) :: NonEmpty a -> Nat -> a (!!) (x :| xs) n | n == 0 = x | n > 0 = xs `listindex` (n - 1) | otherwise = error "NonEmpty.!! negative argument" -- -| The 'zip' function takes two streams and returns a stream of -- corresponding pairs. zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b) zip (x :| xs) (y :| ys) = (x, y) :| listzip xs ys -- -| The 'zipWith' function generalizes 'zip'. Rather than tupling -- the elements, the elements are combined using the function -- passed as the first argument. zipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c zipWith f (x :| xs) (y :| ys) = f x y :| listzipWith f xs ys -- -| The 'unzip' function is the inverse of the 'zip' function. unzip :: NonEmpty (a,b) -> (NonEmpty a, NonEmpty b) unzip ((a,b) :| asbs) = (a :| as, b :| bs) where (as, bs) = listunzip asbs -- -| The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurence of each element. -- (The name 'nub' means \'essence\'.) -- It is a special case of 'nubBy', which allows the programmer to -- supply their own inequality test. nub :: Eq a => NonEmpty a -> NonEmpty a nub = nubBy (==) -- -| The 'nubBy' function behaves just like 'nub', except it uses a -- user-supplied equality predicate instead of the overloaded '==' -- function. nubBy :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty a nubBy eq (a :| as) = a :| listnubBy eq (listfilter (\b -> not (eq a b)) as) -- -| 'transpose' for 'NonEmpty', behaves the same as 'Data.List.transpose' -- The rows/columns need not be the same length, in which case -- > transpose . transpose /= id transpose :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a) transpose = fmap fromList . fromList . listtranspose . toList . fmap toList -- -| 'sortBy' for 'NonEmpty', behaves the same as 'Data.List.sortBy' sortBy :: (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a sortBy f = lift (listsortBy f) -- -| 'sortWith' for 'NonEmpty', behaves the same as: -- -- > sortBy . comparing sortWith :: Ord o => (a -> o) -> NonEmpty a -> NonEmpty a sortWith = sortBy . comparing |]) singletons-2.5.1/src/Data/Singletons/Prelude/Maybe.hs0000644000000000000000000001156607346545000020664 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, DataKinds, PolyKinds, UndecidableInstances, GADTs, RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Maybe -- Copyright : (C) 2013-2014 Richard Eisenberg, Jan Stolarek -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for 'Maybe', -- including a singletons version of all the definitions in @Data.Maybe@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Maybe@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Maybe ( -- The 'Maybe' singleton Sing(SNothing, SJust), -- | Though Haddock doesn't show it, the 'Sing' instance above declares -- constructors -- -- > SNothing :: Sing Nothing -- > SJust :: Sing a -> Sing (Just a) SMaybe, -- | 'SBool' is a kind-restricted synonym for 'Sing': @type SMaybe (a :: Maybe k) = Sing a@ -- * Singletons from @Data.Maybe@ maybe_, Maybe_, sMaybe_, -- | The preceding two definitions are derived from the function 'maybe' in -- @Data.Maybe@. The extra underscore is to avoid name clashes with the type -- 'Maybe'. IsJust, sIsJust, IsNothing, sIsNothing, FromJust, sFromJust, FromMaybe, sFromMaybe, ListToMaybe, sListToMaybe, MaybeToList, sMaybeToList, CatMaybes, sCatMaybes, MapMaybe, sMapMaybe, -- * Defunctionalization symbols NothingSym0, JustSym0, JustSym1, Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3, IsJustSym0, IsJustSym1, IsNothingSym0, IsNothingSym1, FromJustSym0, FromJustSym1, FromMaybeSym0, FromMaybeSym1, FromMaybeSym2, ListToMaybeSym0, ListToMaybeSym1, MaybeToListSym0, MaybeToListSym1, CatMaybesSym0, CatMaybesSym1, MapMaybeSym0, MapMaybeSym1, MapMaybeSym2 ) where import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Singletons.TypeLits $(singletons [d| -- Renamed to avoid name clash -- -| The 'maybe' function takes a default value, a function, and a 'Maybe' -- value. If the 'Maybe' value is 'Nothing', the function returns the -- default value. Otherwise, it applies the function to the value inside -- the 'Just' and returns the result. maybe_ :: b -> (a -> b) -> Maybe a -> b maybe_ n _ Nothing = n maybe_ _ f (Just x) = f x |]) $(singletonsOnly [d| -- -| The 'isJust' function returns 'True' iff its argument is of the -- form @Just _@. isJust :: Maybe a -> Bool isJust Nothing = False isJust (Just _) = True -- -| The 'isNothing' function returns 'True' iff its argument is 'Nothing'. isNothing :: Maybe a -> Bool isNothing Nothing = True isNothing (Just _) = False -- -| The 'fromJust' function extracts the element out of a 'Just' and -- throws an error if its argument is 'Nothing'. fromJust :: Maybe a -> a fromJust Nothing = error "Maybe.fromJust: Nothing" -- yuck fromJust (Just x) = x -- -| The 'fromMaybe' function takes a default value and and 'Maybe' -- value. If the 'Maybe' is 'Nothing', it returns the default values; -- otherwise, it returns the value contained in the 'Maybe'. fromMaybe :: a -> Maybe a -> a fromMaybe d x = case x of {Nothing -> d;Just v -> v} -- -| The 'maybeToList' function returns an empty list when given -- 'Nothing' or a singleton list when not given 'Nothing'. maybeToList :: Maybe a -> [a] maybeToList Nothing = [] maybeToList (Just x) = [x] -- -| The 'listToMaybe' function returns 'Nothing' on an empty list -- or @'Just' a@ where @a@ is the first element of the list. listToMaybe :: [a] -> Maybe a listToMaybe [] = Nothing listToMaybe (a:_) = Just a -- Modified to avoid list comprehensions -- -| The 'catMaybes' function takes a list of 'Maybe's and returns -- a list of all the 'Just' values. catMaybes :: [Maybe a] -> [a] catMaybes [] = [] catMaybes (Just x : xs) = x : catMaybes xs catMaybes (Nothing : xs) = catMaybes xs -- -| The 'mapMaybe' function is a version of 'map' which can throw -- out elements. In particular, the functional argument returns -- something of type @'Maybe' b@. If this is 'Nothing', no element -- is added on to the result list. If it just @'Just' b@, then @b@ is -- included in the result list. mapMaybe :: (a -> Maybe b) -> [a] -> [b] mapMaybe _ [] = [] mapMaybe f (x:xs) = let rs = mapMaybe f xs in case f x of Nothing -> rs Just r -> r:rs |]) singletons-2.5.1/src/Data/Singletons/Prelude/Monad.hs0000644000000000000000000002327607346545000020666 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Monad -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'Monad' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Monad ( PFunctor(Fmap), SFunctor(sFmap), PMonad(..), SMonad(..), PMonadPlus(..), SMonadPlus(..), MapM, sMapM, MapM_, sMapM_, ForM, sForM, Sequence, sSequence, Sequence_, sSequence_, type (=<<), (%=<<), type (>=>), (%>=>), type (<=<), (%<=<), Void, sVoid, Join, sJoin, Msum, sMsum, Mfilter, sMfilter, FilterM, sFilterM, MapAndUnzipM, sMapAndUnzipM, ZipWithM, sZipWithM, ZipWithM_, sZipWithM_, FoldlM, sFoldlM, ReplicateM, sReplicateM, ReplicateM_, sReplicateM_, Guard, sGuard, When, sWhen, Unless, sUnless, LiftM, sLiftM, LiftM2, sLiftM2, LiftM3, sLiftM3, LiftM4, sLiftM4, LiftM5, sLiftM5, Ap, sAp, type (<$!>), (%<$!>), -- * Defunctionalization symbols FmapSym0, FmapSym1, FmapSym2, type (>>=@#@$), type (>>=@#@$$), type (>>=@#@$$$), type (>>@#@$), type (>>@#@$$), type (>>@#@$$$), ReturnSym0, ReturnSym1, FailSym0, FailSym1, MzeroSym0, MplusSym0, MplusSym1, MplusSym2, MapMSym0, MapMSym1, MapMSym2, MapM_Sym0, MapM_Sym1, MapM_Sym2, ForMSym0, ForMSym1, ForMSym2, SequenceSym0, SequenceSym1, Sequence_Sym0, Sequence_Sym1, type (=<<@#@$), type (=<<@#@$$), type (=<<@#@$$$), type (>=>@#@$), type (>=>@#@$$), type (>=>@#@$$$), type (<=<@#@$), type (<=<@#@$$), type (<=<@#@$$$), VoidSym0, VoidSym1, JoinSym0, JoinSym1, MsumSym0, MsumSym1, MfilterSym0, MfilterSym1, MfilterSym2, FilterMSym0, FilterMSym1, FilterMSym2, MapAndUnzipMSym0, MapAndUnzipMSym1, MapAndUnzipMSym2, ZipWithMSym0, ZipWithMSym1, ZipWithMSym2, ZipWithMSym3, ZipWithM_Sym0, ZipWithM_Sym1, ZipWithM_Sym2, ZipWithM_Sym3, FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3, ReplicateMSym0, ReplicateMSym1, ReplicateMSym2, ReplicateM_Sym0, ReplicateM_Sym1, ReplicateM_Sym2, GuardSym0, GuardSym1, WhenSym0, WhenSym1, WhenSym2, UnlessSym0, UnlessSym1, UnlessSym2, LiftMSym0, LiftMSym1, LiftMSym2, LiftM2Sym0, LiftM2Sym1, LiftM2Sym2, LiftM2Sym3, LiftM3Sym0, LiftM3Sym1, LiftM3Sym2, LiftM3Sym3, LiftM3Sym4, LiftM4Sym0, LiftM4Sym1, LiftM4Sym2, LiftM4Sym3, LiftM4Sym4, LiftM4Sym5, LiftM5Sym0, LiftM5Sym1, LiftM5Sym2, LiftM5Sym3, LiftM5Sym4, LiftM5Sym5, LiftM5Sym6, ApSym0, ApSym1, ApSym2, type (<$!>@#@$), type (<$!>@#@$$), type (<$!>@#@$$$), ) where import Control.Applicative import Control.Monad import Data.Ord (Down(..)) import Data.Singletons.Prelude.Applicative () import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, sFoldr) import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.List (UnzipSym0, sUnzip, ZipWithSym0, sZipWith) import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Traversable import Data.Singletons.Single import GHC.TypeNats $(singletonsOnly [d| -- ----------------------------------------------------------------------------- -- Functions mandated by the Prelude -- -| This generalizes the list-based 'filter' function. filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a] filterM p = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x)) (pure []) infixr 1 <=<, >=> -- -| Left-to-right Kleisli composition of monads. (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) f >=> g = \x -> f x >>= g -- -| Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped. -- -- Note how this operator resembles function composition @('.')@: -- -- > (.) :: (b -> c) -> (a -> b) -> a -> c -- > (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<) = flip (>=>) {- Relies on infinite lists -- -| @'forever' act@ repeats the action infinitely. forever :: (Applicative f) => f a -> f b forever a = let a' = a *> a' in a' -- Use explicit sharing here, as it prevents a space leak regardless of -- optimizations. -} -- ----------------------------------------------------------------------------- -- Other monad functions -- -| The 'mapAndUnzipM' function maps its first argument over a list, returning -- the result as a pair of lists. This function is mainly used with complicated -- data structures or a state-transforming monad. mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) mapAndUnzipM f xs = unzip <$> traverse f xs -- -| The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors. zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWithM f xs ys = sequenceA (zipWith f xs ys) -- -| 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m () zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys) {- -| The 'foldM' function is analogous to 'foldl', except that its result is encapsulated in a monad. Note that 'foldM' works from left-to-right over the list arguments. This could be an issue where @('>>')@ and the `folded function' are not commutative. > foldM f a1 [x1, x2, ..., xm] == > do > a2 <- f a1 x1 > a3 <- f a2 x2 > ... > f am xm If right-to-left evaluation is required, the input list should be reversed. Note: 'foldM' is the same as 'foldlM' -} foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM = foldlM -- -| Like 'foldM', but discards the result. foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m () foldM_ f a xs = foldlM f a xs >> return () {- Note [Worker/wrapper transform on replicateM/replicateM_] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementations of replicateM and replicateM_ both leverage the worker/wrapper transform. The simpler implementation of replicateM_, as an example, would be: replicateM_ 0 _ = pure () replicateM_ n f = f *> replicateM_ (n - 1) f However, the self-recursive nature of this implementation inhibits inlining, which means we never get to specialise to the action (`f` in the code above). By contrast, the implementation below with a local loop makes it possible to inline the entire definition (as happens for foldr, for example) thereby specialising for the particular action. For further information, see this Trac comment, which includes side-by-side Core: https://ghc.haskell.org/trac/ghc/ticket/11795#comment:6 -} -- -| @'replicateM' n act@ performs the action @n@ times, -- gathering the results. replicateM :: (Applicative m) => Nat -> m a -> m [a] replicateM cnt0 f = loop cnt0 where loop cnt | cnt <= 0 = pure [] | otherwise = liftA2 (:) f (loop (cnt - 1)) -- -| Like 'replicateM', but discards the result. replicateM_ :: (Applicative m) => Nat -> m a -> m () replicateM_ cnt0 f = loop cnt0 where loop cnt | cnt <= 0 = pure () | otherwise = f *> loop (cnt - 1) -- -| The reverse of 'when'. unless :: (Applicative f) => Bool -> f () -> f () unless p s = if p then pure () else s infixl 4 <$!> -- -| Strict version of 'Data.Functor.<$>'. -- -- @since 4.8.0.0 (<$!>) :: Monad m => (a -> b) -> m a -> m b f <$!> m = do x <- m let z = f x z `seq` return z -- ----------------------------------------------------------------------------- -- Other MonadPlus functions -- -| Direct 'MonadPlus' equivalent of 'filter' -- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@ -- applicable to any 'MonadPlus', for example -- @mfilter odd (Just 1) == Just 1@ -- @mfilter odd (Just 2) == Nothing@ mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a mfilter p ma = do a <- ma if p a then return a else mzero {- -$naming The functions in this library use the following naming conventions: * A postfix \'@M@\' always stands for a function in the Kleisli category: The monad type constructor @m@ is added to function results (modulo currying) and nowhere else. So, for example, > filter :: (a -> Bool) -> [a] -> [a] > filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@. Thus, for example: > sequence :: Monad m => [m a] -> m [a] > sequence_ :: Monad m => [m a] -> m () * A prefix \'@m@\' generalizes an existing function to a monadic form. Thus, for example: > sum :: Num a => [a] -> a > msum :: MonadPlus m => [m a] -> m a -} instance Monoid a => Monad ((,) a) where (u, a) >>= k = case k a of (v, b) -> (u `mappend` v, b) instance Monad Down where Down a >>= k = k a |]) -- Workaround for #326 infixr 1 <=<, >=> infixl 4 <$!> singletons-2.5.1/src/Data/Singletons/Prelude/Monad/0000755000000000000000000000000007346545000020320 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Prelude/Monad/Internal.hs0000644000000000000000000004047307346545000022440 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Monad.Internal -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of: -- -- * Functor -- * Applicative -- * Alternative -- * Monad -- * MonadPlus -- -- As well as auxiliary definitions. -- -- This module exists to break up import cycles. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Monad.Internal where import Control.Applicative import Control.Monad import Data.Kind import Data.List.NonEmpty (NonEmpty(..)) import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Singletons.TypeLits.Internal {- Note [How to get the right kinds when promoting Functor and friends] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To avoid running afoul of a CUSK validity check (see Note [CUSKification]), classes with type parameters that lack explicit kind signatures will be defaulted to be of kind Type. This is not what you want for Functor, however, since its argument is of kind (Type -> Type), so we must explicitly use this kind when declaring the Functor class (and other classes in this module). -} $(singletonsOnly [d| infixl 4 <$ {- -| The 'Functor' class is used for types that can be mapped over. Instances of 'Functor' should satisfy the following laws: > fmap id == id > fmap (f . g) == fmap f . fmap g The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' satisfy these laws. -} class Functor (f :: Type -> Type) where fmap :: (a -> b) -> f a -> f b -- -| Replace all locations in the input with the same value. -- The default definition is @'fmap' . 'const'@, but this may be -- overridden with a more efficient version. (<$) :: a -> f b -> f a (<$) = fmap . const infixl 4 <*>, <*, *>, <**> -- -| A functor with application, providing operations to -- -- -* embed pure expressions ('pure'), and -- -- -* sequence computations and combine their results ('<*>' and 'liftA2'). -- -- A minimal complete definition must include implementations of 'pure' -- and of either '<*>' or 'liftA2'. If it defines both, then they must behave -- the same as their default definitions: -- -- @('<*>') = 'liftA2' 'id'@ -- -- @'liftA2' f x y = f '<$>' x '<*>' y@ -- -- Further, any definition must satisfy the following: -- -- [/identity/] -- -- @'pure' 'id' '<*>' v = v@ -- -- [/composition/] -- -- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ -- -- [/homomorphism/] -- -- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ -- -- [/interchange/] -- -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ -- -- -- The other methods have the following default definitions, which may -- be overridden with equivalent specialized implementations: -- -- * @u '*>' v = ('id' '<$' u) '<*>' v@ -- -- * @u '<*' v = 'liftA2' 'const' u v@ -- -- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy -- -- * @'fmap' f x = 'pure' f '<*>' x@ -- -- -- It may be useful to note that supposing -- -- @forall x y. p (q x y) = f x . g y@ -- -- it follows from the above that -- -- @'liftA2' p ('liftA2' q u v) = 'liftA2' f u . 'liftA2' g v@ -- -- -- If @f@ is also a 'Monad', it should satisfy -- -- * @'pure' = 'return'@ -- -- * @('<*>') = 'ap'@ -- -- * @('*>') = ('>>')@ -- -- (which implies that 'pure' and '<*>' satisfy the applicative functor laws). class Functor f => Applicative (f :: Type -> Type) where -- {-# MINIMAL pure, ((<*>) | liftA2) #-} -- -| Lift a value. pure :: a -> f a -- -| Sequential application. -- -- A few functors support an implementation of '<*>' that is more -- efficient than the default one. (<*>) :: f (a -> b) -> f a -> f b (<*>) = liftA2 id -- -| Lift a binary function to actions. -- -- Some functors support an implementation of 'liftA2' that is more -- efficient than the default one. In particular, if 'fmap' is an -- expensive operation, it is likely better to use 'liftA2' than to -- 'fmap' over the structure and then use '<*>'. liftA2 :: (a -> b -> c) -> f a -> f b -> f c liftA2 f x = (<*>) (fmap f x) -- -| Sequence actions, discarding the value of the first argument. (*>) :: f a -> f b -> f b a1 *> a2 = (id <$ a1) <*> a2 -- This is essentially the same as liftA2 (flip const), but if the -- Functor instance has an optimized (<$), it may be better to use -- that instead. Before liftA2 became a method, this definition -- was strictly better, but now it depends on the functor. For a -- functor supporting a sharing-enhancing (<$), this definition -- may reduce allocation by preventing a1 from ever being fully -- realized. In an implementation with a boring (<$) but an optimizing -- liftA2, it would likely be better to define (*>) using liftA2. -- -| Sequence actions, discarding the value of the second argument. (<*) :: f a -> f b -> f a (<*) = liftA2 const -- -| A variant of '<*>' with the arguments reversed. (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (\a f -> f a) -- Don't use $ here, see the note at the top of the page -- -| Lift a function to actions. -- This function may be used as a value for `fmap` in a `Functor` instance. liftA :: Applicative f => (a -> b) -> f a -> f b liftA f a = pure f <*> a -- Caution: since this may be used for `fmap`, we can't use the obvious -- definition of liftA = fmap. -- -| Lift a ternary function to actions. liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d liftA3 f a b c = liftA2 f a b <*> c infixl 1 >>, >>= infixr 1 =<< -- -| The 'join' function is the conventional monad join operator. It -- is used to remove one level of monadic structure, projecting its -- bound argument into the outer level. -- -- ==== __Examples__ -- -- A common use of 'join' is to run an 'IO' computation returned from -- an 'GHC.Conc.STM' transaction, since 'GHC.Conc.STM' transactions -- can't perform 'IO' directly. Recall that -- -- @ -- 'GHC.Conc.atomically' :: STM a -> IO a -- @ -- -- is used to run 'GHC.Conc.STM' transactions atomically. So, by -- specializing the types of 'GHC.Conc.atomically' and 'join' to -- -- @ -- 'GHC.Conc.atomically' :: STM (IO b) -> IO (IO b) -- 'join' :: IO (IO b) -> IO b -- @ -- -- we can compose them as -- -- @ -- 'join' . 'GHC.Conc.atomically' :: STM (IO b) -> IO b -- @ -- -- to run an 'GHC.Conc.STM' transaction and the 'IO' action it -- returns. join :: (Monad m) => m (m a) -> m a join x = x >>= id {- -| The 'Monad' class defines the basic operations over a /monad/, a concept from a branch of mathematics known as /category theory/. From the perspective of a Haskell programmer, however, it is best to think of a monad as an /abstract datatype/ of actions. Haskell's @do@ expressions provide a convenient syntax for writing monadic expressions. Instances of 'Monad' should satisfy the following laws: * @'return' a '>>=' k = k a@ * @m '>>=' 'return' = m@ * @m '>>=' (\\x -> k x '>>=' h) = (m '>>=' k) '>>=' h@ Furthermore, the 'Monad' and 'Applicative' operations should relate as follows: * @'pure' = 'return'@ * @('<*>') = 'ap'@ The above laws imply: * @'fmap' f xs = xs '>>=' 'return' . f@ * @('>>') = ('*>')@ and that 'pure' and ('<*>') satisfy the applicative functor laws. The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO' defined in the "Prelude" satisfy these laws. -} class Applicative m => Monad (m :: Type -> Type) where -- -| Sequentially compose two actions, passing any value produced -- by the first as an argument to the second. (>>=) :: forall a b. m a -> (a -> m b) -> m b -- -| Sequentially compose two actions, discarding any value produced -- by the first, like sequencing operators (such as the semicolon) -- in imperative languages. (>>) :: forall a b. m a -> m b -> m b m >> k = m >>= \_ -> k -- See Note [Recursive bindings for Applicative/Monad] -- -| Inject a value into the monadic type. return :: a -> m a return = pure -- -| Fail with a message. This operation is not part of the -- mathematical definition of a monad, but is invoked on pattern-match -- failure in a @do@ expression. -- -- As part of the MonadFail proposal (MFP), this function is moved -- to its own class 'MonadFail' (see "Control.Monad.Fail" for more -- details). The definition here will be removed in a future -- release. fail :: Symbol -> m a fail s = error s {- Note [Recursive bindings for Applicative/Monad] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The original Applicative/Monad proposal stated that after implementation, the designated implementation of (>>) would become (>>) :: forall a b. m a -> m b -> m b (>>) = (*>) by default. You might be inclined to change this to reflect the stated proposal, but you really shouldn't! Why? Because people tend to define such instances the /other/ way around: in particular, it is perfectly legitimate to define an instance of Applicative (*>) in terms of (>>), which would lead to an infinite loop for the default implementation of Monad! And people do this in the wild. This turned into a nasty bug that was tricky to track down, and rather than eliminate it everywhere upstream, it's easier to just retain the original default. -} -- -| Same as '>>=', but with the arguments interchanged. (=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f -- -| Conditional execution of 'Applicative' expressions. For example, -- -- > when debug (putStrLn "Debugging") -- -- will output the string @Debugging@ if the Boolean value @debug@ -- is 'True', and otherwise do nothing. when :: (Applicative f) => Bool -> f () -> f () when p s = if p then s else pure () -- -| Promote a function to a monad. liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) } -- -| Promote a function to a monad, scanning the monadic arguments from -- left to right. For example, -- -- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] -- > liftM2 (+) (Just 1) Nothing = Nothing -- liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } -- Caution: since this may be used for `liftA2`, we can't use the obvious -- definition of liftM2 = liftA2. -- -| Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) } -- -| Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) } -- -| Promote a function to a monad, scanning the monadic arguments from -- left to right (cf. 'liftM2'). liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) } {- -| In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. > return f `ap` x1 `ap` ... `ap` xn is equivalent to > liftMn f x1 x2 ... xn -} ap :: (Monad m) => m (a -> b) -> m a -> m b ap m1 m2 = do { x1 <- m1; x2 <- m2; return (x1 x2) } -- Since many Applicative instances define (<*>) = ap, we -- cannot define ap = (<*>) -- ----------------------------------------------------------------------------- -- The Alternative class definition infixl 3 <|> -- -| A monoid on applicative functors. -- -- If defined, 'some' and 'many' should be the least solutions -- of the equations: -- -- -* @'some' v = (:) '<$>' v '<*>' 'many' v@ -- -- -* @'many' v = 'some' v '<|>' 'pure' []@ class Applicative f => Alternative (f :: Type -> Type) where -- -| The identity of '<|>' empty :: f a -- -| An associative binary operation (<|>) :: f a -> f a -> f a {- some and many rely on infinite lists -- -| One or more. some :: f a -> f [a] some v = some_v where many_v = some_v <|> pure [] some_v = liftA2 (:) v many_v -- -| Zero or more. many :: f a -> f [a] many v = many_v where many_v = some_v <|> pure [] some_v = liftA2 (:) v many_v -} -- -| @'guard' b@ is @'pure' ()@ if @b@ is 'True', -- and 'empty' if @b@ is 'False'. guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty -- ----------------------------------------------------------------------------- -- The MonadPlus class definition -- -| Monads that also support choice and failure. class (Alternative m, Monad m) => MonadPlus (m :: Type -> Type) where -- -| The identity of 'mplus'. It should also satisfy the equations -- -- > mzero >>= f = mzero -- > v >> mzero = mzero -- -- The default definition is -- -- @ -- mzero = 'empty' -- @ mzero :: m a mzero = empty -- -| An associative operation. The default definition is -- -- @ -- mplus = ('<|>') -- @ mplus :: m a -> m a -> m a mplus = (<|>) |]) -- Workaround for #326 infixl 4 <$ infixl 4 <*>, <*, *>, <**> infixl 1 >>, >>= infixr 1 =<< infixl 3 <|> $(singletonsOnly [d| ------------------------------------------------------------------------------- -- Instances deriving instance Functor Maybe deriving instance Functor NonEmpty deriving instance Functor [] deriving instance Functor (Either a) instance Applicative Maybe where pure = Just Just f <*> m = fmap f m Nothing <*> _m = Nothing liftA2 f (Just x) (Just y) = Just (f x y) liftA2 _ Just{} Nothing = Nothing liftA2 _ Nothing Just{} = Nothing liftA2 _ Nothing Nothing = Nothing Just _m1 *> m2 = m2 Nothing *> _m2 = Nothing instance Applicative NonEmpty where pure a = a :| [] (<*>) = ap liftA2 = liftM2 instance Applicative [] where pure x = [x] (<*>) = ap liftA2 = liftM2 (*>) = (>>) instance Applicative (Either e) where pure = Right Left e <*> _ = Left e Right f <*> r = fmap f r instance Monad Maybe where (Just x) >>= k = k x Nothing >>= _ = Nothing (>>) = (*>) fail _ = Nothing instance Monad NonEmpty where (a :| as) >>= f = b :| (bs ++ bs') where b :| bs = f a bs' = as >>= toList . f toList (c :| cs) = c : cs instance Monad [] where xs >>= f = foldr ((++) . f) [] xs fail _ = [] instance Monad (Either e) where Left l >>= _ = Left l Right r >>= k = k r instance Alternative Maybe where empty = Nothing Nothing <|> r = r l@(Just{}) <|> _ = l instance Alternative [] where empty = [] (<|>) = (++) instance MonadPlus Maybe instance MonadPlus [] |]) singletons-2.5.1/src/Data/Singletons/Prelude/Monad/Zip.hs0000644000000000000000000000572307346545000021425 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Monad.Zip -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'MonadZip' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Monad.Zip ( PMonadZip(..), SMonadZip(..), -- * Defunctionalization symbols MzipSym0, MzipSym1, MzipSym2, MzipWithSym0, MzipWithSym1, MzipWithSym2, MzipWithSym3, MunzipSym0, MunzipSym1, ) where import Control.Monad.Zip import Data.Functor.Identity import Data.Kind import Data.Monoid import Data.Singletons.Prelude.Identity import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.List ( ZipSym0, ZipWithSym0, UnzipSym0 , sZip, sZipWith, sUnzip ) import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid () import Data.Singletons.Prelude.Tuple import Data.Singletons.Single $(singletonsOnly [d| -- -| `MonadZip` type class. Minimal definition: `mzip` or `mzipWith` -- -- Instances should satisfy the laws: -- -- -* Naturality : -- -- > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb) -- -- -* Information Preservation: -- -- > liftM (const ()) ma = liftM (const ()) mb -- > ==> -- > munzip (mzip ma mb) = (ma, mb) -- class Monad m => MonadZip (m :: Type -> Type) where -- {-# MINIMAL mzip | mzipWith #-} mzip :: m a -> m b -> m (a,b) mzip = mzipWith (,) mzipWith :: (a -> b -> c) -> m a -> m b -> m c mzipWith f ma mb = liftM (uncurry f) (mzip ma mb) munzip :: m (a,b) -> (m a, m b) munzip mab = (liftM fst mab, liftM snd mab) -- munzip is a member of the class because sometimes -- you can implement it more efficiently than the -- above default code. See Trac #4370 comment by giorgidze instance MonadZip [] where mzip = zip mzipWith = zipWith munzip = unzip instance MonadZip Identity where mzipWith = liftM2 munzip (Identity (a, b)) = (Identity a, Identity b) instance MonadZip Dual where -- Cannot use coerce, it's unsafe mzipWith = liftM2 instance MonadZip Sum where mzipWith = liftM2 instance MonadZip Product where mzipWith = liftM2 instance MonadZip Maybe where mzipWith = liftM2 instance MonadZip First where mzipWith = liftM2 instance MonadZip Last where mzipWith = liftM2 |]) singletons-2.5.1/src/Data/Singletons/Prelude/Monoid.hs0000644000000000000000000001536407346545000021054 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Monoid -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted version of 'Monoid', 'PMonoid', and the -- singleton version, 'SMonoid'. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Monoid ( PMonoid(..), SMonoid(..), Sing(SDual, sGetDual, SAll, sGetAll, SAny, sGetAny, SSum, sGetSum, SProduct, sGetProduct, SFirst, sGetFirst, SLast, sGetLast), GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast, SDual, SAll, SAny, SSum, SProduct, SFirst, SLast, -- ** Defunctionalization symbols MemptySym0, MappendSym0, MappendSym1, MappendSym2, MconcatSym0, MconcatSym1, DualSym0, DualSym1, GetDualSym0, GetDualSym1, AllSym0, AllSym1, GetAllSym0, GetAllSym1, AnySym0, AnySym1, GetAnySym0, GetAnySym1, SumSym0, SumSym1, GetSumSym0, GetSumSym1, ProductSym0, ProductSym1, GetProductSym0, GetProductSym1, FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1, LastSym0, LastSym1, GetLastSym0, GetLastSym1 ) where import Data.Monoid (First(..), Last(..)) import Data.Ord (Down(..)) import Data.Semigroup hiding (First(..), Last(..)) import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Semigroup.Internal hiding (Sing(SFirst, SLast), SFirst, SLast, FirstSym0, FirstSym1, FirstSym0KindInference, LastSym0, LastSym1, LastSym0KindInference, GetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference, GetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference) import Data.Singletons.Prelude.Show import Data.Singletons.Single import Data.Singletons.Util import GHC.TypeLits (Symbol) $(singletonsOnly [d| -- -| The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following laws: -- -- * @x '<>' 'mempty' = x@ -- -- * @'mempty' '<>' x = x@ -- -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ ('Semigroup' law) -- -- * @'mconcat' = 'foldr' '(<>)' 'mempty'@ -- -- The method names refer to the monoid of lists under concatenation, -- but there are many other instances. -- -- Some types can be viewed as a monoid in more than one way, -- e.g. both addition and multiplication on numbers. -- In such cases we often define @newtype@s and make those instances -- of 'Monoid', e.g. 'Sum' and 'Product'. class Semigroup a => Monoid a where -- -| Identity of 'mappend' mempty :: a -- -| An associative operation -- -- __NOTE__: This method is redundant and has the default -- implementation @'mappend' = '(<>)'@. mappend :: a -> a -> a mappend = (<>) -- -| Fold a list using the monoid. -- -- For most types, the default definition for 'mconcat' will be -- used, but the function is included in the class definition so -- that an optimized version can be provided for specific types. mconcat :: [a] -> a mconcat = foldr mappend mempty instance Monoid [a] where mempty = [] -- mconcat xss = [x | xs <- xss, x <- xs] instance Monoid b => Monoid (a -> b) where mempty _ = mempty instance Monoid () where -- Should it be strict? mempty = () mconcat _ = () instance (Monoid a, Monoid b) => Monoid (a,b) where mempty = (mempty, mempty) instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where mempty = (mempty, mempty, mempty) instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where mempty = (mempty, mempty, mempty, mempty) instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a,b,c,d,e) where mempty = (mempty, mempty, mempty, mempty, mempty) -- lexicographical ordering instance Monoid Ordering where mempty = EQ -- -| Lift a semigroup into 'Maybe' forming a 'Monoid' according to -- : \"Any semigroup @S@ may be -- turned into a monoid simply by adjoining an element @e@ not in @S@ -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" instance Semigroup a => Monoid (Maybe a) where mempty = Nothing instance Monoid Symbol where mempty = "" |]) $(genSingletons monoidBasicTypes) $(showSingInstances monoidBasicTypes) $(singEqInstances monoidBasicTypes) $(singDecideInstances monoidBasicTypes) $(singOrdInstances monoidBasicTypes) $(singShowInstances monoidBasicTypes) $(singletonsOnly [d| instance Monoid a => Monoid (Dual a) where mempty = Dual mempty instance Monoid All where mempty = All True instance Monoid Any where mempty = Any False instance Num a => Monoid (Sum a) where mempty = Sum 0 instance Num a => Monoid (Product a) where mempty = Product 1 -- deriving newtype instance Monoid a => Monoid (Down a) instance Monoid a => Monoid (Down a) where mempty = Down mempty -- deriving newtype instance Applicative First instance Applicative First where pure = First . pure First f <*> First x = First (f <*> x) deriving instance Functor First -- deriving newtype instance Monad First instance Monad First where First a >>= k = First (a >>= \x -> case k x of First y -> y) instance Semigroup (First a) where First Nothing <> b = b a@(First Just{}) <> _ = a instance Monoid (First a) where mempty = First Nothing -- deriving newtype instance Applicative Last instance Applicative Last where pure = Last . pure Last f <*> Last x = Last (f <*> x) deriving instance Functor Last -- deriving newtype instance Monad Last instance Monad Last where Last a >>= k = Last (a >>= \x -> case k x of Last y -> y) instance Semigroup (Last a) where a <> Last Nothing = a _ <> b@(Last Just {}) = b instance Monoid (Last a) where mempty = Last Nothing |]) singletons-2.5.1/src/Data/Singletons/Prelude/Num.hs0000644000000000000000000000776107346545000020370 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies, TypeOperators, GADTs, ScopedTypeVariables, UndecidableInstances, DefaultSignatures, FlexibleContexts, InstanceSigs, NoStarIsType #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Num -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines and exports promoted and singleton versions of definitions from -- GHC.Num. -- -- Be warned that some of the associated type families in the 'PNum' class -- (@(+)@, @(-)@, and @(*)@) clash with their counterparts for 'Nat' in the -- "GHC.TypeLits" module. ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Num ( PNum(..), SNum(..), Subtract, sSubtract, -- ** Defunctionalization symbols type (+@#@$), type (+@#@$$), type (+@#@$$$), type (-@#@$), type (-@#@$$), type (-@#@$$$), type (*@#@$), type (*@#@$$), type (*@#@$$$), NegateSym0, NegateSym1, AbsSym0, AbsSym1, SignumSym0, SignumSym1, FromIntegerSym0, FromIntegerSym1, SubtractSym0, SubtractSym1, SubtractSym2 ) where import Data.Ord (Down(..)) import Data.Singletons.Single import Data.Singletons.Internal import Data.Singletons.Prelude.Ord import Data.Singletons.TypeLits.Internal import Data.Singletons.Decide import qualified GHC.TypeNats as TN import GHC.TypeNats (Nat, SomeNat(..), someNatVal) import Unsafe.Coerce $(singletonsOnly [d| -- Basic numeric class. -- -- Minimal complete definition: all except 'negate' or @(-)@ class Num a where (+), (-), (*) :: a -> a -> a infixl 6 + infixl 6 - infixl 7 * -- Unary negation. negate :: a -> a -- Absolute value. abs :: a -> a -- Sign of a number. -- The functions 'abs' and 'signum' should satisfy the law: -- -- > abs x * signum x == x -- -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero) -- or @1@ (positive). signum :: a -> a -- Conversion from a 'Nat'. fromInteger :: Nat -> a x - y = x + negate y negate x = 0 - x -- deriving newtype instance Num a => Num (Down a) instance Num a => Num (Down a) where Down a + Down b = Down (a + b) Down a - Down b = Down (a - b) Down a * Down b = Down (a * b) negate (Down a) = Down (negate a) abs (Down a) = Down (abs a) signum (Down a) = Down (signum a) fromInteger n = Down (fromInteger n) |]) -- Workaround for #326 infixl 6 + infixl 6 - infixl 7 * -- PNum instance type family SignumNat (a :: Nat) :: Nat where SignumNat 0 = 0 SignumNat x = 1 instance PNum Nat where type a + b = a TN.+ b type a - b = a TN.- b type a * b = a TN.* b type Negate (a :: Nat) = Error "Cannot negate a natural number" type Abs (a :: Nat) = a type Signum a = SignumNat a type FromInteger a = a -- SNum instance instance SNum Nat where sa %+ sb = let a = fromSing sa b = fromSing sb ex = someNatVal (a + b) in case ex of SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) sa %- sb = let a = fromSing sa b = fromSing sb ex = someNatVal (a - b) in case ex of SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) sa %* sb = let a = fromSing sa b = fromSing sb ex = someNatVal (a * b) in case ex of SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) sNegate _ = error "Cannot call sNegate on a natural number singleton." sAbs x = x sSignum sx = case sx %~ (sing :: Sing 0) of Proved Refl -> sing :: Sing 0 Disproved _ -> unsafeCoerce (sing :: Sing 1) sFromInteger x = x $(singletonsOnly [d| subtract :: Num a => a -> a -> a subtract x y = y - x |]) singletons-2.5.1/src/Data/Singletons/Prelude/Ord.hs0000644000000000000000000000671607346545000020354 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables, TypeFamilies, TypeOperators, GADTs, UndecidableInstances, FlexibleContexts, DefaultSignatures, InstanceSigs, StandaloneDeriving, FlexibleInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Ord -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted version of Ord, 'POrd', and the singleton version, -- 'SOrd'. -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Ord ( POrd(..), SOrd(..), Comparing, sComparing, -- | 'thenCmp' returns its second argument if its first is 'EQ'; otherwise, -- it returns its first argument. thenCmp, ThenCmp, sThenCmp, Sing(SLT, SEQ, SGT, SDown), SOrdering, SDown, -- ** Defunctionalization symbols ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, LTSym0, EQSym0, GTSym0, CompareSym0, CompareSym1, CompareSym2, type (<@#@$), type (<@#@$$), type (<@#@$$$), type (<=@#@$), type (<=@#@$$), type (<=@#@$$$), type (>@#@$), type (>@#@$$), type (>@#@$$$), type (>=@#@$), type (>=@#@$$), type (>=@#@$$$), MaxSym0, MaxSym1, MaxSym2, MinSym0, MinSym1, MinSym2, ComparingSym0, ComparingSym1, ComparingSym2, ComparingSym3, DownSym0, DownSym1 ) where import Data.Ord (Down(..)) import Data.Singletons.Single import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances import Data.Singletons.Util $(singletonsOnly [d| class (Eq a) => Ord a where compare :: a -> a -> Ordering (<), (<=), (>), (>=) :: a -> a -> Bool infix 4 <= infix 4 < infix 4 > infix 4 >= max, min :: a -> a -> a compare x y = if x == y then EQ -- NB: must be '<=' not '<' to validate the -- above claim about the minimal things that -- can be defined for an instance of Ord: else if x <= y then LT else GT x < y = case compare x y of { LT -> True; EQ -> False; GT -> False } x <= y = case compare x y of { LT -> True; EQ -> True; GT -> False } x > y = case compare x y of { LT -> False; EQ -> False; GT -> True } x >= y = case compare x y of { LT -> False; EQ -> True; GT -> True } -- These two default methods use '<=' rather than 'compare' -- because the latter is often more expensive max x y = if x <= y then y else x min x y = if x <= y then x else y -- Not handled by TH: {-# MINIMAL compare | (<=) #-} -- -| -- > comparing p x y = compare (p x) (p y) -- -- Useful combinator for use in conjunction with the @xxxBy@ family -- of functions from "Data.List", for example: -- -- > ... sortBy (comparing fst) ... comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) |]) -- Workaround for #326 infix 4 <= infix 4 < infix 4 > infix 4 >= $(genSingletons [''Down]) $(singletonsOnly [d| deriving instance Eq a => Eq (Down a) instance Ord a => Ord (Down a) where compare (Down x) (Down y) = y `compare` x |]) $(singletons [d| thenCmp :: Ordering -> Ordering -> Ordering thenCmp EQ x = x thenCmp LT _ = LT thenCmp GT _ = GT |]) $(singOrdInstances basicTypes) singletons-2.5.1/src/Data/Singletons/Prelude/Semigroup.hs0000644000000000000000000002353207346545000021575 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Semigroup -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted version of 'Semigroup', 'PSemigroup', and the -- singleton version, 'SSemigroup'. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Semigroup ( PSemigroup(..), SSemigroup(..), Sing(SMin, sGetMin, SMax, sGetMax, SFirst, sGetFirst, SLast, sGetLast, SWrapMonoid, sUnwrapMonoid, SDual, sGetDual, SAll, sGetAll, SAny, sGetAny, SSum, sGetSum, SProduct, sGetProduct, SOption, sGetOption, SArg), GetMin, GetMax, GetFirst, GetLast, GetDual, GetAll, GetAny, GetSum, GetProduct, GetOption, SMin, SMax, SFirst, SLast, SWrappedMonoid, SDual, SAll, SAny, SSum, SProduct, SOption, SArg, option_, sOption_, Option_, -- ** Defunctionalization symbols type (<>@#@$), type (<>@#@$$), type (<>@#@$$$), SconcatSym0, SconcatSym1, MinSym0, MinSym1, GetMinSym0, GetMinSym1, MaxSym0, MaxSym1, GetMaxSym0, GetMaxSym1, FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1, LastSym0, LastSym1, GetLastSym0, GetLastSym1, WrapMonoidSym0, WrapMonoidSym1, UnwrapMonoidSym0, UnwrapMonoidSym1, DualSym0, DualSym1, GetDualSym0, GetDualSym1, AllSym0, AllSym1, GetAllSym0, GetAllSym1, AnySym0, AnySym1, GetAnySym0, GetAnySym1, SumSym0, SumSym1, GetSumSym0, GetSumSym1, ProductSym0, ProductSym1, GetProductSym0, GetProductSym1, OptionSym0, OptionSym1, GetOptionSym0, GetOptionSym1, ArgSym0, ArgSym1, ArgSym2 ) where import Control.Applicative import Control.Monad import qualified Data.Semigroup as Semi (Min(..), Max(..)) import Data.Semigroup (First(..), Last(..), WrappedMonoid(..), Option(..), Arg(..)) import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Foldable hiding ( All, AllSym0, AllSym1 , Any, AnySym0, AnySym1 , Product, ProductSym0, ProductSym1 , Sum, SumSym0, SumSym1 ) import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid hiding (Sing(SFirst, SLast), SFirst, sGetFirst, SLast, sGetLast, FirstSym0, FirstSym1, LastSym0, LastSym1, GetFirst, GetFirstSym0, GetFirstSym1, GetLast, GetLastSym0, GetLastSym1) import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord hiding (MinSym0, MinSym1, MaxSym0, MaxSym1) import Data.Singletons.Prelude.Semigroup.Internal import Data.Singletons.Prelude.Show import Data.Singletons.Prelude.Traversable import Data.Singletons.Single import Data.Singletons.Util $(genSingletons [''Arg]) $(showSingInstances $ ''Option : semigroupBasicTypes) $(singShowInstances $ ''Option : semigroupBasicTypes) $(singletonsOnly [d| instance Applicative Semi.Min where pure = Semi.Min a <* _ = a _ *> a = a Semi.Min f <*> Semi.Min x = Semi.Min (f x) liftA2 f (Semi.Min a) (Semi.Min b) = Semi.Min (f a b) instance Enum a => Enum (Semi.Min a) where succ (Semi.Min a) = Semi.Min (succ a) pred (Semi.Min a) = Semi.Min (pred a) toEnum = Semi.Min . toEnum fromEnum (Semi.Min a) = fromEnum a enumFromTo (Semi.Min a) (Semi.Min b) = Semi.Min `map` enumFromTo a b enumFromThenTo (Semi.Min a) (Semi.Min b) (Semi.Min c) = Semi.Min `map` enumFromThenTo a b c deriving instance Functor Semi.Min instance Monad Semi.Min where (>>) = (*>) Semi.Min a >>= f = f a instance Ord a => Semigroup (Semi.Min a) where Semi.Min a <> Semi.Min b = Semi.Min (a `min_` b) instance (Ord a, Bounded a) => Monoid (Semi.Min a) where mempty = maxBound instance Num a => Num (Semi.Min a) where (Semi.Min a) + (Semi.Min b) = Semi.Min (a + b) (Semi.Min a) * (Semi.Min b) = Semi.Min (a * b) (Semi.Min a) - (Semi.Min b) = Semi.Min (a - b) negate (Semi.Min a) = Semi.Min (negate a) abs (Semi.Min a) = Semi.Min (abs a) signum (Semi.Min a) = Semi.Min (signum a) fromInteger = Semi.Min . fromInteger deriving instance Foldable Semi.Min deriving instance Traversable Semi.Min instance Applicative Semi.Max where pure = Semi.Max a <* _ = a _ *> a = a Semi.Max f <*> Semi.Max x = Semi.Max (f x) liftA2 f (Semi.Max a) (Semi.Max b) = Semi.Max (f a b) instance Enum a => Enum (Semi.Max a) where succ (Semi.Max a) = Semi.Max (succ a) pred (Semi.Max a) = Semi.Max (pred a) toEnum = Semi.Max . toEnum fromEnum (Semi.Max a) = fromEnum a enumFromTo (Semi.Max a) (Semi.Max b) = Semi.Max `map` enumFromTo a b enumFromThenTo (Semi.Max a) (Semi.Max b) (Semi.Max c) = Semi.Max `map` enumFromThenTo a b c deriving instance Functor Semi.Max instance Monad Semi.Max where (>>) = (*>) Semi.Max a >>= f = f a instance Ord a => Semigroup (Semi.Max a) where Semi.Max a <> Semi.Max b = Semi.Max (a `max_` b) instance (Ord a, Bounded a) => Monoid (Semi.Max a) where mempty = minBound instance Num a => Num (Semi.Max a) where (Semi.Max a) + (Semi.Max b) = Semi.Max (a + b) (Semi.Max a) * (Semi.Max b) = Semi.Max (a * b) (Semi.Max a) - (Semi.Max b) = Semi.Max (a - b) negate (Semi.Max a) = Semi.Max (negate a) abs (Semi.Max a) = Semi.Max (abs a) signum (Semi.Max a) = Semi.Max (signum a) fromInteger = Semi.Max . fromInteger deriving instance Foldable Semi.Max deriving instance Traversable Semi.Max instance Eq a => Eq (Arg a b) where Arg a _ == Arg b _ = a == b deriving instance Functor (Arg a) instance Ord a => Ord (Arg a b) where Arg a _ `compare` Arg b _ = compare a b min x@(Arg a _) y@(Arg b _) | a <= b = x | otherwise = y max x@(Arg a _) y@(Arg b _) | a >= b = x | otherwise = y deriving instance (Show a, Show b) => Show (Arg a b) deriving instance Foldable (Arg a) deriving instance Traversable (Arg a) instance Applicative First where pure x = First x a <* _ = a _ *> a = a First f <*> First x = First (f x) liftA2 f (First a) (First b) = First (f a b) instance Enum a => Enum (First a) where succ (First a) = First (succ a) pred (First a) = First (pred a) toEnum = First . toEnum fromEnum (First a) = fromEnum a enumFromTo (First a) (First b) = First `map` enumFromTo a b enumFromThenTo (First a) (First b) (First c) = First `map` enumFromThenTo a b c deriving instance Functor First instance Monad First where (>>) = (*>) First a >>= f = f a instance Semigroup (First a) where a <> _ = a deriving instance Foldable First deriving instance Traversable First instance Applicative Last where pure x = Last x a <* _ = a _ *> a = a Last f <*> Last x = Last (f x) liftA2 f (Last a) (Last b) = Last (f a b) instance Enum a => Enum (Last a) where succ (Last a) = Last (succ a) pred (Last a) = Last (pred a) toEnum = Last . toEnum fromEnum (Last a) = fromEnum a enumFromTo (Last a) (Last b) = Last `map` enumFromTo a b enumFromThenTo (Last a) (Last b) (Last c) = Last `map` enumFromThenTo a b c deriving instance Functor Last instance Monad Last where (>>) = (*>) Last a >>= f = f a instance Semigroup (Last a) where _ <> b = b deriving instance Foldable Last deriving instance Traversable Last instance Monoid m => Semigroup (WrappedMonoid m) where WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b) instance Monoid m => Monoid (WrappedMonoid m) where mempty = WrapMonoid mempty instance Enum a => Enum (WrappedMonoid a) where succ (WrapMonoid a) = WrapMonoid (succ a) pred (WrapMonoid a) = WrapMonoid (pred a) toEnum = WrapMonoid . toEnum fromEnum (WrapMonoid a) = fromEnum a enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid `map` enumFromTo a b enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) = WrapMonoid `map` enumFromThenTo a b c instance Alternative Option where empty = Option Nothing Option Nothing <|> b = b a@(Option Just{}) <|> _ = a instance Applicative Option where pure a = Option (Just a) Option a <*> Option b = Option (a <*> b) liftA2 f (Option x) (Option y) = Option (liftA2 f x y) Option Nothing *> _ = Option Nothing Option Just{} *> b = b deriving instance Functor Option instance Monad Option where Option (Just a) >>= k = k a Option Nothing >>= _ = Option Nothing (>>) = (*>) instance MonadPlus Option -- deriving newtype instance Semigroup a => Semigroup (Option a) instance Semigroup a => Semigroup (Option a) where Option a <> Option b = Option (a <> b) instance Semigroup a => Monoid (Option a) where mempty = Option Nothing instance Foldable Option where foldMap f (Option (Just m)) = f m foldMap _ (Option Nothing) = mempty instance Traversable Option where traverse f (Option (Just a)) = Option . Just <$> f a traverse _ (Option Nothing) = pure (Option Nothing) |]) $(singletons [d| -- Renamed to avoid name clash -- -| Fold an 'Option' case-wise, just like 'maybe'. option_ :: b -> (a -> b) -> Option a -> b option_ n j (Option m) = maybe_ n j m |]) singletons-2.5.1/src/Data/Singletons/Prelude/Semigroup/0000755000000000000000000000000007346545000021234 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Prelude/Semigroup/Internal.hs0000644000000000000000000002040707346545000023347 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Semigroup.Internal -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted version of 'Semigroup', 'PSemigroup'; the -- singleton version, 'SSemigroup'; and some @newtype@ wrappers, all -- of which are reexported from the "Data.Semigroup" module or -- imported directly by some other modules. -- -- This module exists to avoid import cycles with -- "Data.Singletons.Prelude.Monoid". -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Semigroup.Internal where import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord (Down(..)) import Data.Proxy import Data.Semigroup (Dual(..), All(..), Any(..), Sum(..), Product(..), Option(..)) import Data.Singletons.Internal import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Num import Data.Singletons.Prelude.Ord hiding (MinSym0, MinSym1, MaxSym0, MaxSym1) import Data.Singletons.Promote import Data.Singletons.Single import Data.Singletons.TypeLits.Internal import Data.Singletons.Util import qualified Data.Text as T import Data.Void (Void) import GHC.TypeLits (AppendSymbol, SomeSymbol(..), someSymbolVal, Symbol) import Unsafe.Coerce $(singletonsOnly [d| -- -| The class of semigroups (types with an associative binary operation). -- -- Instances should satisfy the associativity law: -- -- * @x '<>' (y '<>' z) = (x '<>' y) '<>' z@ class Semigroup a where -- -| An associative operation. (<>) :: a -> a -> a infixr 6 <> -- -| Reduce a non-empty list with @\<\>@ -- -- The default definition should be sufficient, but this can be -- overridden for efficiency. -- sconcat :: NonEmpty a -> a sconcat (a :| as) = go a as where go b (c:cs) = b <> go c cs go b [] = b {- Can't single 'stimes', since there's no singled 'Integral' class. -- -| Repeat a value @n@ times. -- -- Given that this works on a 'Semigroup' it is allowed to fail if -- you request 0 or fewer repetitions, and the default definition -- will do so. -- -- By making this a member of the class, idempotent semigroups -- and monoids can upgrade this to execute in /O(1)/ by -- picking @stimes = 'stimesIdempotent'@ or @stimes = -- 'stimesIdempotentMonoid'@ respectively. stimes :: Integral b => b -> a -> a stimes = stimesDefault -} instance Semigroup [a] where (<>) = (++) instance Semigroup (NonEmpty a) where (a :| as) <> (b :| bs) = a :| (as ++ b : bs) instance Semigroup b => Semigroup (a -> b) where f <> g = \x -> f x <> g x instance Semigroup () where _ <> _ = () sconcat _ = () instance (Semigroup a, Semigroup b) => Semigroup (a, b) where (a,b) <> (a',b') = (a<>a',b<>b') instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c') instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d') instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e') instance Semigroup Ordering where LT <> _ = LT EQ <> y = y GT <> _ = GT instance Semigroup a => Semigroup (Maybe a) where Nothing <> b = b a <> Nothing = a Just a <> Just b = Just (a <> b) instance Semigroup (Either a b) where Left _ <> b = b -- a <> _ = a a@Right{} <> _ = a instance Semigroup Void where a <> _ = a -- deriving newtype instance Semigroup a => Semigroup (Down a) instance Semigroup a => Semigroup (Down a) where Down a <> Down b = Down (a <> b) |]) -- Workaround for #326 infixr 6 <> $(genSingletons $ ''Option : semigroupBasicTypes) $(singBoundedInstances semigroupBasicTypes) $(singEqInstances $ ''Option : semigroupBasicTypes) $(singDecideInstances $ ''Option : semigroupBasicTypes) $(singOrdInstances $ ''Option : semigroupBasicTypes) $(singletonsOnly [d| instance Applicative Dual where pure = Dual Dual f <*> Dual x = Dual (f x) deriving instance Functor Dual instance Monad Dual where Dual a >>= k = k a instance Semigroup a => Semigroup (Dual a) where Dual a <> Dual b = Dual (b <> a) instance Semigroup All where All a <> All b = All (a && b) instance Semigroup Any where Any a <> Any b = Any (a || b) instance Applicative Sum where pure = Sum Sum f <*> Sum x = Sum (f x) deriving instance Functor Sum instance Monad Sum where Sum a >>= k = k a instance Num a => Semigroup (Sum a) where Sum a <> Sum b = Sum (a + b) -- deriving newtype instance Num a => Num (Sum a) instance Num a => Num (Sum a) where Sum a + Sum b = Sum (a + b) Sum a - Sum b = Sum (a - b) Sum a * Sum b = Sum (a * b) negate (Sum a) = Sum (negate a) abs (Sum a) = Sum (abs a) signum (Sum a) = Sum (signum a) fromInteger n = Sum (fromInteger n) instance Applicative Product where pure = Product Product f <*> Product x = Product (f x) deriving instance Functor Product instance Monad Product where Product a >>= k = k a instance Num a => Semigroup (Product a) where Product a <> Product b = Product (a * b) -- deriving newtype instance Num a => Num (Product a) instance Num a => Num (Product a) where Product a + Product b = Product (a + b) Product a - Product b = Product (a - b) Product a * Product b = Product (a * b) negate (Product a) = Product (negate a) abs (Product a) = Product (abs a) signum (Product a) = Product (signum a) fromInteger n = Product (fromInteger n) |]) instance PSemigroup Symbol where type a <> b = AppendSymbol a b instance SSemigroup Symbol where sa %<> sb = let a = fromSing sa b = fromSing sb ex = someSymbolVal $ T.unpack $ a <> b in case ex of SomeSymbol (_ :: Proxy ab) -> unsafeCoerce (SSym :: Sing ab) -- We need these in Data.Singletons.Prelude.Semigroup, as we need to promote -- code that simultaneously uses the Min/Max constructors and the min/max -- functions, which have clashing defunctionalization symbol names. Our -- workaround is to simply define synonyms for min/max and use those instead. min_, max_ :: Ord a => a -> a -> a min_ = min max_ = max type Min_ x y = Min x y type Max_ x y = Max x y $(genDefunSymbols [''Min_, ''Max_]) sMin_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Min_` y) sMin_ = sMin sMax_ :: forall a (x :: a) (y :: a). SOrd a => Sing x -> Sing y -> Sing (x `Max_` y) sMax_ = sMax -- We need these in Data.Singletons.Prelude.Foldable. all_ :: Bool -> All all_ = All any_ :: Bool -> Any any_ = Any sum_ :: a -> Sum a sum_ = Sum product_ :: a -> Product a product_ = Product type All_ a = 'All a type Any_ a = 'Any a type Sum_ a = 'Sum a type Product_ a = 'Product a $(genDefunSymbols [''All_, ''Any_, ''Sum_, ''Product_]) sAll_ :: forall (x :: Bool). Sing x -> Sing (All_ x) sAll_ = SAll sAny_ :: forall (x :: Bool). Sing x -> Sing (Any_ x) sAny_ = SAny sSum_ :: forall a (x :: a). Sing x -> Sing (Sum_ x) sSum_ = SSum sProduct_ :: forall a (x :: a). Sing x -> Sing (Product_ x) sProduct_ = SProduct singletons-2.5.1/src/Data/Singletons/Prelude/Show.hs0000644000000000000000000001425307346545000020543 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Show -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the SShow singleton version of the Show type class. -- ----------------------------------------------------------------------------- module Data.Singletons.Prelude.Show ( PShow(..), SShow(..), SymbolS, SChar, show_, Shows, sShows, ShowListWith, sShowListWith, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace, ShowCommaSpace, sShowCommaSpace, AppPrec, sAppPrec, AppPrec1, sAppPrec1, -- * Defunctionalization symbols ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, Show_Sym0, Show_Sym1, ShowListSym0, ShowListSym1, ShowListSym2, ShowsSym0, ShowsSym1, ShowsSym2, ShowListWithSym0, ShowListWithSym1, ShowListWithSym2, ShowListWithSym3, ShowCharSym0, ShowCharSym1, ShowCharSym2, ShowStringSym0, ShowStringSym1, ShowStringSym2, ShowParenSym0, ShowParenSym1, ShowParenSym2, ShowSpaceSym0, ShowSpaceSym1, ShowCommaSpaceSym0, ShowCommaSpaceSym1, AppPrecSym0, AppPrec1Sym0 ) where import Data.List.NonEmpty (NonEmpty) import Data.Ord (Down) import Data.Proxy import Data.Singletons.Internal import Data.Singletons.Prelude.Base import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.List.Internal import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Semigroup.Internal import Data.Singletons.Promote import Data.Singletons.Single import Data.Singletons.TypeLits import qualified Data.Text as T import Data.Void import GHC.TypeLits import qualified Prelude as P import Prelude hiding (Show(..)) import Unsafe.Coerce (unsafeCoerce) -- | The @shows@ functions return a function that prepends the -- output 'Symbol' to an existing 'Symbol'. This allows constant-time -- concatenation of results using function composition. type SymbolS = Symbol -> Symbol -- | GHC currently has no notion of type-level 'Char's, so we fake them with -- single-character 'Symbol's. type SChar = Symbol $(singletonsOnly [d| class Show a where showsPrec :: Nat -> a -> SymbolS show_ :: a -> Symbol showList :: [a] -> SymbolS showsPrec _ x s = show_ x <> s show_ x = shows x "" showList ls s = showListWith shows ls s shows :: Show a => a -> SymbolS shows s = showsPrec 0 s showListWith :: (a -> SymbolS) -> [a] -> SymbolS showListWith _ [] s = "[]" <> s showListWith showx (x:xs) s = "[" <> showx x (showl xs) where showl [] = "]" <> s showl (y:ys) = "," <> showx y (showl ys) showChar :: SChar -> SymbolS showChar = (<>) showString :: Symbol -> SymbolS showString = (<>) showParen :: Bool -> SymbolS -> SymbolS showParen b p = if b then showChar "(" . p . showChar ")" else p showSpace :: SymbolS showSpace = \xs -> " " <> xs showCommaSpace :: SymbolS showCommaSpace = showString ", " appPrec, appPrec1 :: Nat appPrec = 10 appPrec1 = 11 instance Show a => Show [a] where showsPrec _ = showList -- -| This is not an ideal Show instance for Symbol, since the Show instance -- for String escapes special characters. Unfortunately, GHC lacks the ability -- to case on individual characters in a Symbol (at least, not without GHC -- plugins), so this is the best we can do for the time being. instance Show Symbol where showsPrec _ = showString show_tuple :: [SymbolS] -> SymbolS show_tuple ss = showChar "(" . foldr1 (\s r -> s . showChar "," . r) ss . showChar ")" instance (Show a, Show b) => Show (a,b) where showsPrec _ (a,b) s = show_tuple [shows a, shows b] s instance (Show a, Show b, Show c) => Show (a, b, c) where showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s deriving instance Show a => Show (Down a) |]) $(promoteOnly [d| showsNat :: Nat -> SymbolS showsNat 0 = showChar "0" showsNat 1 = showChar "1" showsNat 2 = showChar "2" showsNat 3 = showChar "3" showsNat 4 = showChar "4" showsNat 5 = showChar "5" showsNat 6 = showChar "6" showsNat 7 = showChar "7" showsNat 8 = showChar "8" showsNat 9 = showChar "9" showsNat n = showsNat (n `div` 10) . showsNat (n `mod` 10) |]) instance PShow Nat where type ShowsPrec _ n x = ShowsNat n x instance SShow Nat where sShowsPrec _ sn sx = let n = fromSing sn x = fromSing sx ex = someSymbolVal (P.show n ++ T.unpack x) in case ex of SomeSymbol (_ :: Proxy s) -> unsafeCoerce (SSym :: Sing s) -- | 'P.show', but with an extra underscore so that its promoted counterpart -- ('Show_') will not clash with the 'Show' class. show_ :: P.Show a => a -> String show_ = P.show $(singShowInstances [ ''(), ''Maybe, ''Either, ''NonEmpty, ''Bool, ''Ordering, ''Void ]) singletons-2.5.1/src/Data/Singletons/Prelude/Traversable.hs0000644000000000000000000002443107346545000022074 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Traversable -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the promoted and singled versions of the 'Traversable' type class. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Traversable ( PTraversable(..), STraversable(..), For, sFor, ForM, sForM, MapAccumL, sMapAccumL, MapAccumR, sMapAccumR, FmapDefault, sFmapDefault, FoldMapDefault, sFoldMapDefault, -- * Defunctionalization symbols TraverseSym0, TraverseSym1, TraverseSym2, SequenceASym0, SequenceASym1, MapMSym0, MapMSym1, MapMSym2, SequenceSym0, SequenceSym1, ForSym0, ForSym1, ForSym2, ForMSym0, ForMSym1, ForMSym2, MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3, MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3, FmapDefaultSym0, FmapDefaultSym1, FmapDefaultSym2, FoldMapDefaultSym0, FoldMapDefaultSym1, FoldMapDefaultSym2 ) where import Control.Applicative import Data.Functor.Identity import Data.Kind import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid import Data.Singletons.Internal import Data.Singletons.Prelude.Base hiding (Const, ConstSym0) import Data.Singletons.Prelude.Const import Data.Singletons.Prelude.Foldable (PFoldable, SFoldable) import Data.Singletons.Prelude.Functor import Data.Singletons.Prelude.Identity import Data.Singletons.Prelude.Instances import Data.Singletons.Prelude.Monad.Internal import Data.Singletons.Prelude.Monoid import Data.Singletons.Single newtype StateL s a = StateL (s ~> (s, a)) data instance Sing :: forall s a. StateL s a -> Type where SStateL :: Sing x -> Sing ('StateL x) data StateLSym0 :: forall s a. (s ~> (s, a)) ~> StateL s a type instance Apply StateLSym0 x = 'StateL x newtype StateR s a = StateR (s ~> (s, a)) data instance Sing :: forall s a. StateR s a -> Type where SStateR :: Sing x -> Sing ('StateR x) data StateRSym0 :: forall s a. (s ~> (s, a)) ~> StateR s a type instance Apply StateRSym0 x = 'StateR x $(singletonsOnly [d| -- -| Functors representing data structures that can be traversed from -- left to right. -- -- A definition of 'traverse' must satisfy the following laws: -- -- [/naturality/] -- @t . 'traverse' f = 'traverse' (t . f)@ -- for every applicative transformation @t@ -- -- [/identity/] -- @'traverse' Identity = Identity@ -- -- [/composition/] -- @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@ -- -- A definition of 'sequenceA' must satisfy the following laws: -- -- [/naturality/] -- @t . 'sequenceA' = 'sequenceA' . 'fmap' t@ -- for every applicative transformation @t@ -- -- [/identity/] -- @'sequenceA' . 'fmap' Identity = Identity@ -- -- [/composition/] -- @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@ -- -- where an /applicative transformation/ is a function -- -- @t :: (Applicative f, Applicative g) => f a -> g a@ -- -- preserving the 'Applicative' operations, i.e. -- -- * @t ('pure' x) = 'pure' x@ -- -- * @t (x '<*>' y) = t x '<*>' t y@ -- -- and the identity functor @Identity@ and composition of functors @Compose@ -- are defined as -- -- > newtype Identity a = Identity a -- > -- > instance Functor Identity where -- > fmap f (Identity x) = Identity (f x) -- > -- > instance Applicative Identity where -- > pure x = Identity x -- > Identity f <*> Identity x = Identity (f x) -- > -- > newtype Compose f g a = Compose (f (g a)) -- > -- > instance (Functor f, Functor g) => Functor (Compose f g) where -- > fmap f (Compose x) = Compose (fmap (fmap f) x) -- > -- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where -- > pure x = Compose (pure (pure x)) -- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x) -- -- (The naturality law is implied by parametricity.) -- -- Instances are similar to 'Functor', e.g. given a data type -- -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) -- -- a suitable instance would be -- -- > instance Traversable Tree where -- > traverse f Empty = pure Empty -- > traverse f (Leaf x) = Leaf <$> f x -- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r -- -- This is suitable even for abstract types, as the laws for '<*>' -- imply a form of associativity. -- -- The superclass instances should satisfy the following: -- -- * In the 'Functor' instance, 'fmap' should be equivalent to traversal -- with the identity applicative functor ('fmapDefault'). -- -- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be -- equivalent to traversal with a constant applicative functor -- ('foldMapDefault'). -- class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where -- {-# MINIMAL traverse | sequenceA #-} -- -| Map each element of a structure to an action, evaluate these actions -- from left to right, and collect the results. For a version that ignores -- the results see 'Data.Foldable.traverse_'. traverse :: Applicative f => (a -> f b) -> t a -> f (t b) traverse f = sequenceA . fmap f -- -| Evaluate each action in the structure from left to right, and -- and collect the results. For a version that ignores the results -- see 'Data.Foldable.sequenceA_'. sequenceA :: Applicative f => t (f a) -> f (t a) sequenceA = traverse id -- -| Map each element of a structure to a monadic action, evaluate -- these actions from left to right, and collect the results. For -- a version that ignores the results see 'Data.Foldable.mapM_'. mapM :: Monad m => (a -> m b) -> t a -> m (t b) mapM = traverse -- -| Evaluate each monadic action in the structure from left to -- right, and collect the results. For a version that ignores the -- results see 'Data.Foldable.sequence_'. sequence :: Monad m => t (m a) -> m (t a) sequence = sequenceA |]) $(singletonsOnly [d| -- instances for Prelude types deriving instance Traversable Maybe deriving instance Traversable [] deriving instance Traversable NonEmpty deriving instance Traversable (Either a) deriving instance Traversable ((,) a) deriving instance Traversable (Const m) deriving instance Traversable Dual deriving instance Traversable Sum deriving instance Traversable Product deriving instance Traversable First deriving instance Traversable Last deriving instance Traversable Identity -- general functions -- -| 'for' is 'traverse' with its arguments flipped. For a version -- that ignores the results see 'Data.Foldable.for_'. for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) for = flip traverse -- -| 'forM' is 'mapM' with its arguments flipped. For a version that -- ignores the results see 'Data.Foldable.forM_'. forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM = flip mapM instance Functor (StateL s) where fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v) instance Applicative (StateL s) where pure x = StateL (\ s -> (s, x)) StateL kf <*> StateL kv = StateL $ \ s -> let (s', f) = kf s (s'', v) = kv s' in (s'', f v) liftA2 f (StateL kx) (StateL ky) = StateL $ \s -> let (s', x) = kx s (s'', y) = ky s' in (s'', f x y) instance Functor (StateR s) where fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v) instance Applicative (StateR s) where pure x = StateR (\ s -> (s, x)) StateR kf <*> StateR kv = StateR $ \ s -> let (s', v) = kv s (s'', f) = kf s' in (s'', f v) liftA2 f (StateR kx) (StateR ky) = StateR $ \ s -> let (s', y) = ky s (s'', x) = kx s' in (s'', f x y) -- -|The 'mapAccumL' function behaves like a combination of 'fmap' -- and 'foldl'; it applies a function to each element of a structure, -- passing an accumulating parameter from left to right, and returning -- a final value of this accumulator together with the new structure. mapAccumL :: forall t a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL f s t = case traverse (StateL . flip f) t of StateL g -> g s -- -|The 'mapAccumR' function behaves like a combination of 'fmap' -- and 'foldr'; it applies a function to each element of a structure, -- passing an accumulating parameter from right to left, and returning -- a final value of this accumulator together with the new structure. mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR f s t = case traverse (StateR . flip f) t of StateR g -> g s -- -| This function may be used as a value for `fmap` in a `Functor` -- instance, provided that 'traverse' is defined. (Using -- `fmapDefault` with a `Traversable` instance defined only by -- 'sequenceA' will result in infinite recursion.) -- -- @ -- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f) -- @ fmapDefault :: forall t a b . Traversable t => (a -> b) -> t a -> t b fmapDefault f x = case traverse (Identity . f) x of Identity y -> y -- -| This function may be used as a value for `Data.Foldable.foldMap` -- in a `Foldable` instance. -- -- @ -- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f) -- @ foldMapDefault :: forall t m a . (Traversable t, Monoid m) => (a -> m) -> t a -> m foldMapDefault f x = case traverse (mkConst . f) x of Const y -> y where mkConst :: m -> Const m () mkConst = Const |]) singletons-2.5.1/src/Data/Singletons/Prelude/Tuple.hs0000644000000000000000000000535207346545000020714 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, PolyKinds, RankNTypes, TypeFamilies, GADTs, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Tuple -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for tuples, -- including a singletons version of all the definitions in @Data.Tuple@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Tuple@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Tuple ( -- * Singleton definitions -- | See 'Data.Singletons.Prelude.Sing' for more info. Sing(STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7), STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, -- * Singletons from @Data.Tuple@ Fst, sFst, Snd, sSnd, Curry, sCurry, Uncurry, sUncurry, Swap, sSwap, -- * Defunctionalization symbols Tuple0Sym0, Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, FstSym0, FstSym1, SndSym0, SndSym1, CurrySym0, CurrySym1, CurrySym2, CurrySym3, UncurrySym0, UncurrySym1, UncurrySym2, SwapSym0, SwapSym1 ) where import Data.Singletons.Prelude.Instances import Data.Singletons.Single $(singletonsOnly [d| -- -| Extract the first component of a pair. fst :: (a,b) -> a fst (x,_) = x -- -| Extract the second component of a pair. snd :: (a,b) -> b snd (_,y) = y -- -| 'curry' converts an uncurried function to a curried function. curry :: ((a, b) -> c) -> a -> b -> c curry f x y = f (x, y) -- -| 'uncurry' converts a curried function to a function on pairs. uncurry :: (a -> b -> c) -> ((a, b) -> c) uncurry f p = f (fst p) (snd p) -- -| Swap the components of a pair. swap :: (a,b) -> (b,a) swap (a,b) = (b,a) |]) singletons-2.5.1/src/Data/Singletons/Prelude/Void.hs0000644000000000000000000000344407346545000020524 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Prelude.Void -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines functions and datatypes relating to the singleton for 'Void', -- including a singleton version of all the definitions in @Data.Void@. -- -- Because many of these definitions are produced by Template Haskell, -- it is not possible to create proper Haddock documentation. Please look -- up the corresponding operation in @Data.Void@. Also, please excuse -- the apparent repeated variable names. This is due to an interaction -- between Template Haskell and Haddock. -- ---------------------------------------------------------------------------- module Data.Singletons.Prelude.Void ( -- * The 'Void' singleton Sing, -- | Just as 'Void' has no constructors, the 'Sing' instance above also has -- no constructors. SVoid, -- | 'SVoid' is a kind-restricted synonym for 'Sing': -- @type SVoid (a :: Void) = Sing a@ -- * Singletons from @Data.Void@ Absurd, sAbsurd, -- * Defunctionalization symbols AbsurdSym0, AbsurdSym1 ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Void $(singletonsOnly [d| -- -| Since 'Void' values logically don't exist, this witnesses the -- logical reasoning tool of \"ex falso quodlibet\". absurd :: Void -> a absurd a = case a of {} |]) singletons-2.5.1/src/Data/Singletons/Promote.hs0000644000000000000000000011023007346545000017640 0ustar0000000000000000{- Data/Singletons/Promote.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu This file contains functions to promote term-level constructs to the type level. It is an internal module to the singletons package. -} {-# LANGUAGE TemplateHaskell, MultiWayIf, LambdaCase, TupleSections #-} module Data.Singletons.Promote where import Language.Haskell.TH hiding ( Q, cxt ) import Language.Haskell.TH.Syntax ( Quasi(..) ) import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Promote.Monad import Data.Singletons.Promote.Eq import Data.Singletons.Promote.Defun import Data.Singletons.Promote.Type import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum import Data.Singletons.Deriving.Show import Data.Singletons.Deriving.Util import Data.Singletons.Partition import Data.Singletons.Util import Data.Singletons.Syntax import Prelude hiding (exp) import Control.Applicative (Alternative(..)) import Control.Arrow (second) import Control.Monad import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Maybe import Control.Monad.Writer import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import qualified Data.Set as Set import Data.Set ( Set ) import Data.Maybe import qualified GHC.LanguageExtensions.Type as LangExt -- | Generate promoted definitions from a type that is already defined. -- This is generally only useful with classes. genPromotions :: DsMonad q => [Name] -> q [Dec] genPromotions names = do checkForRep names infos <- mapM reifyWithLocals names dinfos <- mapM dsInfo infos ddecs <- promoteM_ [] $ mapM_ promoteInfo dinfos return $ decsToTH ddecs -- | Promote every declaration given to the type level, retaining the originals. promote :: DsMonad q => q [Dec] -> q [Dec] promote qdec = do decls <- qdec ddecls <- withLocalDeclarations decls $ dsDecs decls promDecls <- promoteM_ decls $ promoteDecs ddecls return $ decls ++ decsToTH promDecls -- | Promote each declaration, discarding the originals. Note that a promoted -- datatype uses the same definition as an original datatype, so this will -- not work with datatypes. Classes, instances, and functions are all fine. promoteOnly :: DsMonad q => q [Dec] -> q [Dec] promoteOnly qdec = do decls <- qdec ddecls <- dsDecs decls promDecls <- promoteM_ decls $ promoteDecs ddecls return $ decsToTH promDecls -- | Generate defunctionalization symbols for existing type families. -- -- 'genDefunSymbols' has reasonable support for type families that use -- dependent quantification. For instance, this: -- -- @ -- type family MyProxy k (a :: k) :: Type where -- MyProxy k (a :: k) = Proxy a -- -- $('genDefunSymbols' [''MyProxy]) -- @ -- -- Will generate the following defunctionalization symbols: -- -- @ -- data MyProxySym0 :: Type ~> k ~> Type -- data MyProxySym1 (k :: Type) :: k ~> Type -- @ -- -- Note that @MyProxySym0@ is a bit more general than it ought to be, since -- there is no dependency between the first kind (@Type@) and the second kind -- (@k@). But this would require the ability to write something like: -- -- @ -- data MyProxySym0 :: forall (k :: Type) ~> k ~> Type -- @ -- -- Which currently isn't possible. So for the time being, the kind of -- @MyProxySym0@ will be slightly more general, which means that under rare -- circumstances, you may have to provide extra type signatures if you write -- code which exploits the dependency in @MyProxy@'s kind. genDefunSymbols :: DsMonad q => [Name] -> q [Dec] genDefunSymbols names = do checkForRep names infos <- mapM (dsInfo <=< reifyWithLocals) names decs <- promoteMDecs [] $ concatMapM defunInfo infos return $ decsToTH decs -- | Produce instances for @(==)@ (type-level equality) from the given types promoteEqInstances :: DsMonad q => [Name] -> q [Dec] promoteEqInstances = concatMapM promoteEqInstance -- | Produce instances for 'POrd' from the given types promoteOrdInstances :: DsMonad q => [Name] -> q [Dec] promoteOrdInstances = concatMapM promoteOrdInstance -- | Produce an instance for 'POrd' from the given type promoteOrdInstance :: DsMonad q => Name -> q [Dec] promoteOrdInstance = promoteInstance mkOrdInstance "Ord" -- | Produce instances for 'PBounded' from the given types promoteBoundedInstances :: DsMonad q => [Name] -> q [Dec] promoteBoundedInstances = concatMapM promoteBoundedInstance -- | Produce an instance for 'PBounded' from the given type promoteBoundedInstance :: DsMonad q => Name -> q [Dec] promoteBoundedInstance = promoteInstance mkBoundedInstance "Bounded" -- | Produce instances for 'PEnum' from the given types promoteEnumInstances :: DsMonad q => [Name] -> q [Dec] promoteEnumInstances = concatMapM promoteEnumInstance -- | Produce an instance for 'PEnum' from the given type promoteEnumInstance :: DsMonad q => Name -> q [Dec] promoteEnumInstance = promoteInstance mkEnumInstance "Enum" -- | Produce instances for 'PShow' from the given types promoteShowInstances :: DsMonad q => [Name] -> q [Dec] promoteShowInstances = concatMapM promoteShowInstance -- | Produce an instance for 'PShow' from the given type promoteShowInstance :: DsMonad q => Name -> q [Dec] promoteShowInstance = promoteInstance mkShowInstance "Show" -- | Produce an instance for @(==)@ (type-level equality) from the given type promoteEqInstance :: DsMonad q => Name -> q [Dec] promoteEqInstance name = do (tvbs, cons) <- getDataD "I cannot make an instance of (==) for it." name tvbs' <- mapM dsTvb tvbs let data_ty = foldTypeTvbs (DConT name) tvbs' cons' <- concatMapM (dsCon tvbs' data_ty) cons kind <- promoteType (foldTypeTvbs (DConT name) tvbs') inst_decs <- mkEqTypeInstance kind cons' return $ decsToTH inst_decs promoteInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec] promoteInstance mk_inst class_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ class_name ++ " for it.") name tvbs' <- mapM dsTvb tvbs let data_ty = foldTypeTvbs (DConT name) tvbs' cons' <- concatMapM (dsCon tvbs' data_ty) cons let data_decl = DataDecl name tvbs' cons' raw_inst <- mk_inst Nothing data_ty data_decl decs <- promoteM_ [] $ void $ promoteInstanceDec Map.empty raw_inst return $ decsToTH decs promoteInfo :: DInfo -> PrM () promoteInfo (DTyConI dec _instances) = promoteDecs [dec] promoteInfo (DPrimTyConI _name _numArgs _unlifted) = fail "Promotion of primitive type constructors not supported" promoteInfo (DVarI _name _ty _mdec) = fail "Promotion of individual values not supported" promoteInfo (DTyVarI _name _ty) = fail "Promotion of individual type variables not supported" promoteInfo (DPatSynI {}) = fail "Promotion of pattern synonyms not supported" -- Note [Promoting declarations in two stages] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- -- It is necessary to know the types of things when promoting. So, -- we promote in two stages: first, we build a LetDecEnv, which allows -- for easy lookup. Then, we go through the actual elements of the LetDecEnv, -- performing the promotion. -- -- Why do we need the types? For kind annotations on the type family. We also -- need to have both the types and the actual function definition at the same -- time, because the function definition tells us how many patterns are -- matched. Note that an eta-contracted function needs to return a TyFun, -- not a proper type-level function. -- -- Consider this example: -- -- foo :: Nat -> Bool -> Bool -- foo Zero = id -- foo _ = not -- -- Here the first parameter to foo is non-uniform, because it is -- inspected in a pattern and can be different in each defining -- equation of foo. The second parameter to foo, specified in the type -- signature as Bool, is a uniform parameter - it is not inspected and -- each defining equation of foo uses it the same way. The foo -- function will be promoted to a type familty Foo like this: -- -- type family Foo (n :: Nat) :: Bool ~> Bool where -- Foo Zero = Id -- Foo a = Not -- -- To generate type signature for Foo type family we must first learn -- what is the actual number of patterns used in defining cequations -- of foo. In this case there is only one so we declare Foo to take -- one argument and have return type of Bool -> Bool. -- Promote a list of top-level declarations. promoteDecs :: [DDec] -> PrM () promoteDecs raw_decls = do decls <- expand raw_decls -- expand type synonyms checkForRepInDecls decls PDecs { pd_let_decs = let_decs , pd_class_decs = classes , pd_instance_decs = insts , pd_data_decs = datas , pd_ty_syn_decs = ty_syns , pd_open_type_family_decs = o_tyfams , pd_closed_type_family_decs = c_tyfams , pd_derived_eq_decs = derived_eq_decs } <- partitionDecs decls defunTypeDecls ty_syns c_tyfams o_tyfams -- promoteLetDecs returns LetBinds, which we don't need at top level _ <- promoteLetDecs noPrefix let_decs mapM_ promoteClassDec classes let orig_meth_sigs = foldMap (lde_types . cd_lde) classes mapM_ (promoteInstanceDec orig_meth_sigs) insts mapM_ promoteDerivedEqDec derived_eq_decs promoteDataDecs datas promoteDataDecs :: [DataDecl] -> PrM () promoteDataDecs data_decs = do rec_selectors <- concatMapM extract_rec_selectors data_decs _ <- promoteLetDecs noPrefix rec_selectors mapM_ promoteDataDec data_decs where extract_rec_selectors :: DataDecl -> PrM [DLetDec] extract_rec_selectors (DataDecl data_name tvbs cons) = let arg_ty = foldTypeTvbs (DConT data_name) tvbs in getRecordSelectors arg_ty cons -- curious about ALetDecEnv? See the LetDecEnv module for an explanation. promoteLetDecs :: (String, String) -- (alpha, symb) prefixes to use -> [DLetDec] -> PrM ([LetBind], ALetDecEnv) -- See Note [Promoting declarations in two stages] promoteLetDecs prefixes decls = do let_dec_env <- buildLetDecEnv decls all_locals <- allLocals let binds = [ (name, foldType (DConT sym) (map DVarT all_locals)) | name <- Map.keys $ lde_defns let_dec_env , let proName = promoteValNameLhsPrefix prefixes name sym = promoteTySym proName (length all_locals) ] (decs, let_dec_env') <- letBind binds $ promoteLetDecEnv prefixes let_dec_env emitDecs decs return (binds, let_dec_env' { lde_proms = Map.fromList binds }) -- Promotion of data types to kinds is automatic (see "Giving Haskell a -- Promotion" paper for more details). Here we "plug into" the promotion -- mechanism to add some extra stuff to the promotion: -- -- * if data type derives Eq we generate a type family that implements the -- equality test for the data type. -- -- * for each data constructor with arity greater than 0 we generate type level -- symbols for use with Apply type family. In this way promoted data -- constructors and promoted functions can be used in a uniform way at the -- type level in the same way they can be used uniformly at the type level. -- -- * for each nullary data constructor we generate a type synonym promoteDataDec :: DataDecl -> PrM () promoteDataDec (DataDecl _name _tvbs ctors) = do ctorSyms <- buildDefunSymsDataD ctors emitDecs ctorSyms -- Note [CUSKification] -- ~~~~~~~~~~~~~~~~~~~~ -- GHC #12928 means that sometimes, this TH code will produce a declaration -- that has a kind signature even when we want kind inference to work. There -- seems to be no way to avoid this, so we embrace it: -- -- * If a class type variable has no explicit kind, we make no effort to -- guess it and default to *. This is OK because before GHC 8.0, we were -- limited by KProxy anyway. -- -- * If a class type variable has an explicit kind, it is preserved. -- -- This way, we always get proper CUSKs where we need them. promoteClassDec :: UClassDecl -> PrM AClassDecl promoteClassDec decl@(ClassDecl { cd_cxt = cxt , cd_name = cls_name , cd_tvbs = tvbs' , cd_fds = fundeps , cd_lde = lde@LetDecEnv { lde_defns = defaults , lde_types = meth_sigs , lde_infix = infix_decls } }) = do let -- a workaround for GHC Trac #12928; see Note [CUSKification] tvbs = map cuskify tvbs' let pClsName = promoteClassName cls_name pCxt <- mapM promote_superclass_pred cxt forallBind cls_kvs_to_bind $ do sig_decs <- mapM (uncurry promote_sig) (Map.toList meth_sigs) let defaults_list = Map.toList defaults defaults_names = map fst defaults_list (default_decs, ann_rhss, prom_rhss) <- mapAndUnzip3M (promoteMethod Map.empty Nothing meth_sigs) defaults_list let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) $ Map.toList infix_decls -- no need to do anything to the fundeps. They work as is! emitDecs [DClassD pCxt pClsName tvbs fundeps (sig_decs ++ default_decs ++ infix_decls')] let defaults_list' = zip defaults_names ann_rhss proms = zip defaults_names prom_rhss cls_kvs_to_bind' = cls_kvs_to_bind <$ meth_sigs return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list' , lde_proms = Map.fromList proms , lde_bound_kvs = cls_kvs_to_bind' } }) where cls_kvb_names, cls_tvb_names, cls_kvs_to_bind :: Set Name cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) tvbs' cls_tvb_names = Set.fromList $ map extractTvbName tvbs' cls_kvs_to_bind = cls_kvb_names `Set.union` cls_tvb_names promote_sig :: Name -> DType -> PrM DDec promote_sig name ty = do let proName = promoteValNameLhs name (argKs, resK) <- promoteUnraveled ty args <- mapM (const $ qNewName "arg") argKs let tvbs = zipWith DKindedTV args argKs emitDecsM $ defunReifyFixity proName tvbs (Just resK) return $ DOpenTypeFamilyD (DTypeFamilyHead proName tvbs (DKindSig resK) Nothing) promote_superclass_pred :: DPred -> PrM DPred promote_superclass_pred = go where go (DForallPr {}) = fail "Cannot promote quantified constraints" go (DAppPr pr ty) = DAppPr <$> go pr <*> promoteType ty go (DSigPr pr _k) = go pr -- just ignore the kind; it can't matter go (DVarPr name) = fail $ "Cannot promote ConstraintKinds variables like " ++ show name go (DConPr name) = return $ DConPr (promoteClassName name) go DWildCardPr = return DWildCardPr -- returns (unpromoted method name, ALetDecRHS) pairs promoteInstanceDec :: Map Name DType -> UInstDecl -> PrM AInstDecl promoteInstanceDec orig_meth_sigs decl@(InstDecl { id_name = cls_name , id_arg_tys = inst_tys , id_sigs = inst_sigs , id_meths = meths }) = do cls_tvb_names <- lookup_cls_tvb_names inst_kis <- mapM promoteType inst_tys let kvs_to_bind = foldMap fvDType inst_kis forallBind kvs_to_bind $ do let subst = Map.fromList $ zip cls_tvb_names inst_kis (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod inst_sigs (Just subst) orig_meth_sigs) meths emitDecs [DInstanceD Nothing [] (foldType (DConT pClsName) inst_kis) meths'] return (decl { id_meths = zip (map fst meths) ann_rhss }) where pClsName = promoteClassName cls_name lookup_cls_tvb_names :: PrM [Name] lookup_cls_tvb_names = do let mk_tvb_names = extract_tvb_names (dsReifyTypeNameInfo pClsName) <|> extract_tvb_names (dsReifyTypeNameInfo cls_name) -- See Note [Using dsReifyTypeNameInfo when promoting instances] mb_tvb_names <- runMaybeT mk_tvb_names case mb_tvb_names of Just tvb_names -> pure tvb_names Nothing -> fail $ "Cannot find class declaration annotation for " ++ show cls_name extract_tvb_names :: PrM (Maybe DInfo) -> MaybeT PrM [Name] extract_tvb_names reify_info = do mb_info <- lift reify_info case mb_info of Just (DTyConI (DClassD _ _ tvbs _ _) _) -> pure $ map extractTvbName tvbs _ -> empty {- Note [Using dsReifyTypeNameInfo when promoting instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During the promotion of a class instance, it becomes necessary to reify the original promoted class's info to learn various things. It's tempting to think that just calling dsReify on the class name will be sufficient, but it's not. Consider this class and its promotion: class Eq a where (==) :: a -> a -> Bool class PEq a where type (==) (x :: a) (y :: a) :: Bool Notice how both of these classes have an identifier named (==), one at the value level, and one at the type level. Now imagine what happens when you attempt to promote this Template Haskell declaration: [d| f :: Bool f = () == () |] When promoting ==, singletons will come up with its promoted equivalent (which also happens to be ==). However, this promoted name is a raw Name, since it is created with mkName. This becomes an issue when we call dsReify the raw "==" Name, as Template Haskell has to arbitrarily choose between reifying the info for the value-level (==) and the type-level (==), and in this case, it happens to pick the value-level (==) info. We want the type-level (==) info, however, because we care about the promoted version of (==). Fortunately, there's a serviceable workaround. Instead of dsReify, we can use dsReifyTypeNameInfo, which first calls lookupTypeName (to ensure we can find a Name that's in the type namespace) and _then_ reifies it. -} promoteMethod :: Map Name DType -- InstanceSigs for methods -> Maybe (Map Name DKind) -- ^ instantiations for class tyvars (Nothing for default decls) -- See Note [Promoted class method kinds] -> Map Name DType -- method types -> (Name, ULetDecRHS) -> PrM (DDec, ALetDecRHS, DType) -- returns (type instance, ALetDecRHS, promoted RHS) promoteMethod inst_sigs_map m_subst orig_sigs_map (meth_name, meth_rhs) = do (meth_arg_kis, meth_res_ki) <- lookup_meth_ty ((_, _, _, eqns), _defuns, ann_rhs) <- promoteLetDecRHS (Just (meth_arg_kis, meth_res_ki)) Map.empty Map.empty noPrefix meth_name meth_rhs meth_arg_tvs <- mapM (const $ qNewName "a") meth_arg_kis let helperNameBase = case nameBase proName of first:_ | not (isHsLetter first) -> "TFHelper" alpha -> alpha -- family_args are the type variables in a promoted class's -- associated type family instance (or default implementation), e.g., -- -- class C k where -- type T (a :: k) (b :: Bool) -- type T a b = THelper1 a b -- family_args = [a, b] -- -- instance C Bool where -- type T a b = THelper2 a b -- family_args = [a, b] -- -- We could annotate these variables with explicit kinds, but it's not -- strictly necessary, as kind inference can figure them out just as well. family_args = map DVarT meth_arg_tvs helperName <- newUniqueName helperNameBase let tvbs = zipWith DKindedTV meth_arg_tvs meth_arg_kis emitDecs [DClosedTypeFamilyD (DTypeFamilyHead helperName tvbs (DKindSig meth_res_ki) Nothing) eqns] emitDecsM (defunctionalize helperName Nothing tvbs (Just meth_res_ki)) return ( DTySynInstD proName (DTySynEqn family_args (foldApply (promoteValRhs helperName) (map DVarT meth_arg_tvs))) , ann_rhs , DConT (promoteTySym helperName 0) ) where proName = promoteValNameLhs meth_name lookup_meth_ty :: PrM ([DKind], DKind) lookup_meth_ty = case Map.lookup meth_name inst_sigs_map of Just ty -> -- We have an InstanceSig. These are easy: no substitution for clas -- variables is required at all! promoteUnraveled ty Nothing -> do -- We don't have an InstanceSig, so we must compute the kind to use -- ourselves (possibly substituting for class variables below). (arg_kis, res_ki) <- case Map.lookup meth_name orig_sigs_map of Nothing -> do mb_info <- dsReifyTypeNameInfo proName -- See Note [Using dsReifyTypeNameInfo when promoting instances] case mb_info of Just (DTyConI (DOpenTypeFamilyD (DTypeFamilyHead _ tvbs mb_res_ki _)) _) -> let arg_kis = map (default_to_star . extractTvbKind) tvbs res_ki = default_to_star (resultSigToMaybeKind mb_res_ki) in return (arg_kis, res_ki) _ -> fail $ "Cannot find type annotation for " ++ show proName Just ty -> promoteUnraveled ty let -- If we're dealing with an associated type family instance, substitute -- in the kind of the instance for better kind information in the RHS -- helper function. If we're dealing with a default family implementation -- (m_subst = Nothing), there's no need for a substitution. -- See Note [Promoted class method kinds] do_subst = maybe id substKind m_subst meth_arg_kis' = map do_subst arg_kis meth_res_ki' = do_subst res_ki pure (meth_arg_kis', meth_res_ki') default_to_star Nothing = DConT typeKindName default_to_star (Just k) = k {- Note [Promoted class method kinds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example of a type class (and instance): class C a where m :: a -> Bool -> Bool m _ x = x instance C [a] where m l _ = null l The promoted version of these declarations would be: class PC a where type M (x :: a) (y :: Bool) (z :: Bool) type M x y z = MHelper1 x y z instance PC [a] where type M x y z = MHelper2 x y z type family MHelper1 (x :: a) (y :: Bool) (z :: Bool) where ... type family MHelper2 (x :: [a]) (y :: Bool) (z :: Bool) where ... Getting the kind signature for MHelper1 (the promoted default implementation of M) is quite simple, as it corresponds exactly to the kind of M. We might even choose to make that the kind of MHelper2, but then it would be overly general (and more difficult to find in -ddump-splices output). For this reason, we substitute in the kinds of the instance itself to determine the kinds of promoted method implementations like MHelper2. -} promoteLetDecEnv :: (String, String) -> ULetDecEnv -> PrM ([DDec], ALetDecEnv) promoteLetDecEnv prefixes (LetDecEnv { lde_defns = value_env , lde_types = type_env , lde_infix = fix_env }) = do let infix_decls = catMaybes $ map (uncurry promoteInfixDecl) $ Map.toList fix_env -- promote all the declarations, producing annotated declarations let (names, rhss) = unzip $ Map.toList value_env (payloads, defun_decss, ann_rhss) <- fmap unzip3 $ zipWithM (promoteLetDecRHS Nothing type_env fix_env prefixes) names rhss emitDecs $ concat defun_decss bound_kvs <- allBoundKindVars let decs = map payload_to_dec payloads ++ infix_decls -- build the ALetDecEnv let let_dec_env' = LetDecEnv { lde_defns = Map.fromList $ zip names ann_rhss , lde_types = type_env , lde_infix = fix_env , lde_proms = Map.empty -- filled in promoteLetDecs , lde_bound_kvs = Map.fromList $ map (, bound_kvs) names } return (decs, let_dec_env') where payload_to_dec (name, tvbs, m_ki, eqns) = DClosedTypeFamilyD (DTypeFamilyHead name tvbs sig Nothing) eqns where sig = maybe DNoSig DKindSig m_ki promoteInfixDecl :: Name -> Fixity -> Maybe DDec promoteInfixDecl name fixity | nameBase name == nameBase promoted_name -- If a name and its promoted counterpart are the same (modulo module -- prefixes), then there's no need to promote a fixity declaration for -- that name, since the existing fixity declaration will cover both -- the term- and type-level versions of that name, -- -- Names that fall into this category include data constructor names -- and infix names, with the exceptions of (.) and (!). -- See Note [Special cases for (.) and (!)] in Data.Singletons.Names. = Nothing | otherwise = Just $ DLetDec $ DInfixD fixity promoted_name where promoted_name = promoteValNameLhs name -- This function is used both to promote class method defaults and normal -- let bindings. Thus, it can't quite do all the work locally and returns -- an intermediate structure. Perhaps a better design is available. promoteLetDecRHS :: Maybe ([DKind], DKind) -- the promoted type of the RHS (if known) -- needed to fix #136 -> Map Name DType -- local type env't -> Map Name Fixity -- local fixity env't -> (String, String) -- let-binding prefixes -> Name -- name of the thing being promoted -> ULetDecRHS -- body of the thing -> PrM ( (Name, [DTyVarBndr], Maybe DKind, [DTySynEqn]) -- "type family" , [DDec] -- defunctionalization , ALetDecRHS ) -- annotated RHS promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UValue exp) = do (res_kind, num_arrows) <- case m_rhs_ki of Just (arg_kis, res_ki) -> return ( Just (ravelTyFun (arg_kis ++ [res_ki])) , length arg_kis ) _ | Just ty <- Map.lookup name type_env -> do ki <- promoteType ty return (Just ki, countArgs ty) | otherwise -> return (Nothing, 0) case num_arrows of 0 -> do all_locals <- allLocals let lde_kvs_to_bind = foldMap fvDType res_kind (exp', ann_exp) <- forallBind lde_kvs_to_bind $ promoteExp exp let proName = promoteValNameLhsPrefix prefixes name m_fixity = Map.lookup name fix_env tvbs = map DPlainTV all_locals defuns <- defunctionalize proName m_fixity tvbs res_kind return ( ( proName, tvbs, res_kind , [DTySynEqn (map DVarT all_locals) exp'] ) , defuns , AValue (foldType (DConT proName) (map DVarT all_locals)) num_arrows ann_exp ) _ -> do names <- replicateM num_arrows (newUniqueName "a") let pats = map DVarPa names newArgs = map DVarE names promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction [DClause pats (foldExp exp newArgs)]) promoteLetDecRHS m_rhs_ki type_env fix_env prefixes name (UFunction clauses) = do numArgs <- count_args clauses (m_argKs, m_resK, ty_num_args) <- case m_rhs_ki of Just (arg_kis, res_ki) -> return (map Just arg_kis, Just res_ki, length arg_kis) _ | Just ty <- Map.lookup name type_env -> do -- promoteType turns arrows into TyFun. So, we unravel first to -- avoid this behavior. Note the use of ravelTyFun in resultK -- to make the return kind work out (argKs, resultK) <- promoteUnraveled ty -- invariant: countArgs ty == length argKs return (map Just argKs, Just resultK, length argKs) | otherwise -> return (replicate numArgs Nothing, Nothing, numArgs) let proName = promoteValNameLhsPrefix prefixes name m_fixity = Map.lookup name fix_env all_locals <- allLocals let local_tvbs = map DPlainTV all_locals tyvarNames <- mapM (const $ qNewName "a") m_argKs let args = zipWith inferMaybeKindTV tyvarNames m_argKs all_args = local_tvbs ++ args defun_decs <- defunctionalize proName m_fixity all_args m_resK expClauses <- mapM (etaContractOrExpand ty_num_args numArgs) clauses let lde_kvs_to_bind = foldMap (foldMap fvDType) m_argKs <> foldMap fvDType m_resK (eqns, ann_clauses) <- forallBind lde_kvs_to_bind $ mapAndUnzipM promoteClause expClauses prom_fun <- lookupVarE name return ( (proName, all_args, m_resK, eqns) , defun_decs , AFunction prom_fun ty_num_args ann_clauses ) where etaContractOrExpand :: Int -> Int -> DClause -> PrM DClause etaContractOrExpand ty_num_args clause_num_args (DClause pats exp) | n >= 0 = do -- Eta-expand names <- replicateM n (newUniqueName "a") let newPats = map DVarPa names newArgs = map DVarE names return $ DClause (pats ++ newPats) (foldExp exp newArgs) | otherwise = do -- Eta-contract let (clausePats, lamPats) = splitAt ty_num_args pats lamExp <- mkDLamEFromDPats lamPats exp return $ DClause clausePats lamExp where n = ty_num_args - clause_num_args count_args (DClause pats _ : _) = return $ length pats count_args _ = fail $ "Impossible! A function without clauses." promoteClause :: DClause -> PrM (DTySynEqn, ADClause) promoteClause (DClause pats exp) = do -- promoting the patterns creates variable bindings. These are passed -- to the function promoted the RHS ((types, pats'), prom_pat_infos) <- evalForPair $ mapAndUnzipM promotePat pats let PromDPatInfos { prom_dpat_vars = new_vars , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos (ty, ann_exp) <- forallBind sig_kvs $ lambdaBind new_vars $ promoteExp exp all_locals <- allLocals -- these are bound *outside* of this clause return ( DTySynEqn (map DVarT all_locals ++ types) ty , ADClause new_vars pats' ann_exp ) promoteMatch :: DMatch -> PrM (DTySynEqn, ADMatch) promoteMatch (DMatch pat exp) = do -- promoting the patterns creates variable bindings. These are passed -- to the function promoted the RHS ((ty, pat'), prom_pat_infos) <- evalForPair $ promotePat pat let PromDPatInfos { prom_dpat_vars = new_vars , prom_dpat_sig_kvs = sig_kvs } = prom_pat_infos (rhs, ann_exp) <- forallBind sig_kvs $ lambdaBind new_vars $ promoteExp exp all_locals <- allLocals return $ ( DTySynEqn (map DVarT all_locals ++ [ty]) rhs , ADMatch new_vars pat' ann_exp) -- promotes a term pattern into a type pattern, accumulating bound variable names promotePat :: DPat -> QWithAux PromDPatInfos PrM (DType, ADPat) promotePat (DLitPa lit) = (, ADLitPa lit) <$> promoteLitPat lit promotePat (DVarPa name) = do -- term vars can be symbols... type vars can't! tyName <- mkTyName name tell $ PromDPatInfos [(name, tyName)] Set.empty return (DVarT tyName, ADVarPa name) promotePat (DConPa name pats) = do (types, pats') <- mapAndUnzipM promotePat pats let name' = unboxed_tuple_to_tuple name return (foldType (DConT name') types, ADConPa name pats') where unboxed_tuple_to_tuple n | Just deg <- unboxedTupleNameDegree_maybe n = tupleDataName deg | otherwise = n promotePat (DTildePa pat) = do qReportWarning "Lazy pattern converted into regular pattern in promotion" second ADTildePa <$> promotePat pat promotePat (DBangPa pat) = do qReportWarning "Strict pattern converted into regular pattern in promotion" second ADBangPa <$> promotePat pat promotePat (DSigPa pat ty) = do -- We must maintain the invariant that any promoted pattern signature must -- not have any wildcards in the underlying pattern. -- See Note [Singling pattern signatures]. wildless_pat <- removeWilds pat (promoted, pat') <- promotePat wildless_pat ki <- promoteType ty tell $ PromDPatInfos [] (fvDType ki) return (DSigT promoted ki, ADSigPa promoted pat' ki) promotePat DWildPa = return (DWildCardT, ADWildPa) promoteExp :: DExp -> PrM (DType, ADExp) promoteExp (DVarE name) = fmap (, ADVarE name) $ lookupVarE name promoteExp (DConE name) = return $ (promoteValRhs name, ADConE name) promoteExp (DLitE lit) = fmap (, ADLitE lit) $ promoteLitExp lit promoteExp (DAppE exp1 exp2) = do (exp1', ann_exp1) <- promoteExp exp1 (exp2', ann_exp2) <- promoteExp exp2 return (apply exp1' exp2', ADAppE ann_exp1 ann_exp2) -- Until we get visible kind applications, this is the best we can do. promoteExp (DAppTypeE exp _) = do qReportWarning "Visible type applications are ignored by `singletons`." promoteExp exp promoteExp (DLamE names exp) = do lambdaName <- newUniqueName "Lambda" tyNames <- mapM mkTyName names let var_proms = zip names tyNames (rhs, ann_exp) <- lambdaBind var_proms $ promoteExp exp tyFamLamTypes <- mapM (const $ qNewName "t") names all_locals <- allLocals let all_args = all_locals ++ tyFamLamTypes tvbs = map DPlainTV all_args emitDecs [DClosedTypeFamilyD (DTypeFamilyHead lambdaName tvbs DNoSig Nothing) [DTySynEqn (map DVarT (all_locals ++ tyNames)) rhs]] emitDecsM $ defunctionalize lambdaName Nothing tvbs Nothing let promLambda = foldl apply (DConT (promoteTySym lambdaName 0)) (map DVarT all_locals) return (promLambda, ADLamE tyNames promLambda names ann_exp) promoteExp (DCaseE exp matches) = do caseTFName <- newUniqueName "Case" all_locals <- allLocals let prom_case = foldType (DConT caseTFName) (map DVarT all_locals) (exp', ann_exp) <- promoteExp exp (eqns, ann_matches) <- mapAndUnzipM promoteMatch matches tyvarName <- qNewName "t" let all_args = all_locals ++ [tyvarName] tvbs = map DPlainTV all_args emitDecs [DClosedTypeFamilyD (DTypeFamilyHead caseTFName tvbs DNoSig Nothing) eqns] -- See Note [Annotate case return type] in Single let applied_case = prom_case `DAppT` exp' return ( applied_case , ADCaseE ann_exp ann_matches applied_case ) promoteExp (DLetE decs exp) = do unique <- qNewUnique let letPrefixes = uniquePrefixes "Let" "<<<" unique (binds, ann_env) <- promoteLetDecs letPrefixes decs (exp', ann_exp) <- letBind binds $ promoteExp exp return (exp', ADLetE ann_env ann_exp) promoteExp (DSigE exp ty) = do (exp', ann_exp) <- promoteExp exp ty' <- promoteType ty return (DSigT exp' ty', ADSigE exp' ann_exp ty) promoteExp e@(DStaticE _) = fail ("Static expressions cannot be promoted: " ++ show e) promoteLitExp :: Quasi q => Lit -> q DType promoteLitExp (IntegerL n) | n >= 0 = return $ (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit n)) | otherwise = return $ (DConT tyNegateName `DAppT` (DConT tyFromIntegerName `DAppT` DLitT (NumTyLit (-n)))) promoteLitExp (StringL str) = do let prom_str_lit = DLitT (StrTyLit str) os_enabled <- qIsExtEnabled LangExt.OverloadedStrings pure $ if os_enabled then DConT tyFromStringName `DAppT` prom_str_lit else prom_str_lit promoteLitExp lit = fail ("Only string and natural number literals can be promoted: " ++ show lit) promoteLitPat :: Monad m => Lit -> m DType promoteLitPat (IntegerL n) | n >= 0 = return $ (DLitT (NumTyLit n)) | otherwise = fail $ "Negative literal patterns are not allowed,\n" ++ "because literal patterns are promoted to natural numbers." promoteLitPat (StringL str) = return $ DLitT (StrTyLit str) promoteLitPat lit = fail ("Only string and natural number literals can be promoted: " ++ show lit) -- See Note [DerivedDecl] promoteDerivedEqDec :: DerivedEqDecl -> PrM () promoteDerivedEqDec (DerivedDecl { ded_type = ty , ded_decl = DataDecl _ _ cons }) = do kind <- promoteType ty inst_decs <- mkEqTypeInstance kind cons emitDecs inst_decs singletons-2.5.1/src/Data/Singletons/Promote/0000755000000000000000000000000007346545000017307 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Promote/Defun.hs0000644000000000000000000005674507346545000020725 0ustar0000000000000000{- Data/Singletons/Promote/Defun.hs (c) Richard Eisenberg, Jan Stolarek 2014 rae@cs.brynmawr.edu This file creates defunctionalization symbols for types during promotion. -} {-# LANGUAGE TemplateHaskell #-} module Data.Singletons.Promote.Defun where import Language.Haskell.TH.Desugar import Data.Singletons.Promote.Monad import Data.Singletons.Promote.Type import Data.Singletons.Names import Language.Haskell.TH.Syntax import Data.Singletons.Syntax import Data.Singletons.Util import Control.Monad import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Data.Maybe import qualified Data.Set as Set defunInfo :: DInfo -> PrM [DDec] defunInfo (DTyConI dec _instances) = buildDefunSyms dec defunInfo (DPrimTyConI _name _numArgs _unlifted) = fail $ "Building defunctionalization symbols of primitive " ++ "type constructors not supported" defunInfo (DVarI _name _ty _mdec) = fail "Building defunctionalization symbols of values not supported" defunInfo (DTyVarI _name _ty) = fail "Building defunctionalization symbols of type variables not supported" defunInfo (DPatSynI {}) = fail "Building defunctionalization symbols of pattern synonyms not supported" defunTypeDecls :: [TySynDecl] -> [ClosedTypeFamilyDecl] -> [OpenTypeFamilyDecl] -> PrM () defunTypeDecls ty_syns c_tyfams o_tyfams = do defun_ty_syns <- concatMapM (\(TySynDecl name tvbs) -> buildDefunSymsTySynD name tvbs) ty_syns defun_c_tyfams <- concatMapM (buildDefunSymsClosedTypeFamilyD . getTypeFamilyDecl) c_tyfams defun_o_tyfams <- concatMapM (buildDefunSymsOpenTypeFamilyD . getTypeFamilyDecl) o_tyfams emitDecs $ defun_ty_syns ++ defun_c_tyfams ++ defun_o_tyfams buildDefunSyms :: DDec -> PrM [DDec] buildDefunSyms (DDataD _new_or_data _cxt _tyName _tvbs _k ctors _derivings) = buildDefunSymsDataD ctors buildDefunSyms (DClosedTypeFamilyD tf_head _) = buildDefunSymsClosedTypeFamilyD tf_head buildDefunSyms (DOpenTypeFamilyD tf_head) = buildDefunSymsOpenTypeFamilyD tf_head buildDefunSyms (DTySynD name tvbs _type) = buildDefunSymsTySynD name tvbs buildDefunSyms (DClassD _cxt name tvbs _fundeps _members) = do defunReifyFixity name tvbs (Just (DConT constraintName)) buildDefunSyms _ = fail $ "Defunctionalization symbols can only be built for " ++ "type families and data declarations" buildDefunSymsClosedTypeFamilyD :: DTypeFamilyHead -> PrM [DDec] buildDefunSymsClosedTypeFamilyD = buildDefunSymsTypeFamilyHead id id buildDefunSymsOpenTypeFamilyD :: DTypeFamilyHead -> PrM [DDec] buildDefunSymsOpenTypeFamilyD = buildDefunSymsTypeFamilyHead cuskify default_to_star where default_to_star :: Maybe DKind -> Maybe DKind default_to_star Nothing = Just $ DConT typeKindName default_to_star (Just k) = Just k buildDefunSymsTypeFamilyHead :: (DTyVarBndr -> DTyVarBndr) -> (Maybe DKind -> Maybe DKind) -> DTypeFamilyHead -> PrM [DDec] buildDefunSymsTypeFamilyHead default_tvb default_kind (DTypeFamilyHead name tvbs result_sig _) = do let arg_tvbs = map default_tvb tvbs res_kind = default_kind (resultSigToMaybeKind result_sig) defunReifyFixity name arg_tvbs res_kind buildDefunSymsTySynD :: Name -> [DTyVarBndr] -> PrM [DDec] buildDefunSymsTySynD name tvbs = defunReifyFixity name tvbs Nothing buildDefunSymsDataD :: [DCon] -> PrM [DDec] buildDefunSymsDataD ctors = concatMapM promoteCtor ctors where promoteCtor :: DCon -> PrM [DDec] promoteCtor ctor@(DCon _ _ _ _ res_ty) = do let (name, arg_tys) = extractNameTypes ctor tvb_names <- replicateM (length arg_tys) $ qNewName "t" arg_kis <- mapM promoteType arg_tys let arg_tvbs = zipWith DKindedTV tvb_names arg_kis res_ki <- promoteType res_ty defunReifyFixity name arg_tvbs (Just res_ki) -- Generate defunctionalization symbols for a name, using reifyFixityWithLocals -- to determine what the fixity of each symbol should be. -- See Note [Fixity declarations for defunctionalization symbols] defunReifyFixity :: Name -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec] defunReifyFixity name tvbs m_res_kind = do m_fixity <- reifyFixityWithLocals name defunctionalize name m_fixity tvbs m_res_kind -- Generate data declarations and apply instances -- required for defunctionalization. -- For a type family: -- -- type family Foo (m :: Nat) (n :: Nat) (l :: Nat) :: Nat -- -- we generate data declarations that allow us to talk about partial -- application at the type level: -- -- type FooSym3 a b c = Foo a b c -- data FooSym2 a b f where -- FooSym2KindInference :: SameKind (Apply (FooSym2 a b) arg) (FooSym3 a b arg) -- => FooSym2 a b f -- type instance Apply (FooSym2 a b) c = FooSym3 a b c -- data FooSym1 a f where -- FooSym1KindInference :: SameKind (Apply (FooSym1 a) arg) (FooSym2 a arg) -- => FooSym1 a f -- type instance Apply (FooSym1 a) b = FooSym2 a b -- data FooSym0 f where -- FooSym0KindInference :: SameKind (Apply FooSym0 arg) (FooSym1 arg) -- => FooSym0 f -- type instance Apply FooSym0 a = FooSym1 a -- -- What's up with all the "KindInference" stuff? In some scenarios, we don't -- know the kinds that we should be using in these symbols. But, GHC can figure -- it out using the types of the "KindInference" dummy data constructors. A -- bit of a hack, but it works quite nicely. The only problem is that GHC will -- warn about an unused data constructor. So, we use the data constructor in -- an instance of a dummy class. (See Data.Singletons.SuppressUnusedWarnings -- for the class, which should never be seen by anyone, ever.) -- -- The defunctionalize function takes Maybe DKinds so that the caller can -- indicate which kinds are known and which need to be inferred. -- -- See also Note [Defunctionalization and dependent quantification] defunctionalize :: Name -> Maybe Fixity -- The name's fixity, if one was declared. -> [DTyVarBndr] -> Maybe DKind -> PrM [DDec] defunctionalize name m_fixity m_arg_tvbs' m_res_kind' = do (m_arg_tvbs, m_res_kind) <- eta_expand (noExactTyVars m_arg_tvbs') (noExactTyVars m_res_kind') let -- Implements part (2)(i) from Note [Defunctionalization and dependent quantification] tvb_to_type_map :: Map Name DType tvb_to_type_map = Map.fromList $ -- (2)(i)(c) map (\tvb -> (extractTvbName tvb, dTyVarBndrToDType tvb)) $ toposortTyVarsOf $ -- (2)(i)(b) map dTyVarBndrToDType m_arg_tvbs ++ maybeToList m_res_kind -- (2)(i)(a) go :: Int -> [DTyVarBndr] -> Maybe DKind -> ([DTyVarBndr] -> DType) -- given the argument tyvar binders, -- produce the RHS of the Apply instance -> PrM [DDec] go _ [] _ _ = return [] go n (m_arg : m_args) m_result mk_rhs = do extra_name <- qNewName "arg" let tyfun_name = extractTvbName m_arg data_name = promoteTySym name n next_name = promoteTySym name (n+1) con_name = prefixName "" ":" $ suffixName "KindInference" "###" data_name m_tyfun = buildTyFunArrow_maybe (extractTvbKind m_arg) m_result arg_params = -- Implements part (2)(ii) from -- Note [Defunctionalization and dependent quantification] map (map_tvb_kind (substType tvb_to_type_map)) $ reverse m_args tyfun_param = mk_tvb tyfun_name m_tyfun arg_names = map extractTvbName arg_params params = arg_params ++ [tyfun_param] con_eq_ct = DConPr sameKindName `DAppPr` lhs `DAppPr` rhs where lhs = foldType (DConT data_name) (map DVarT arg_names) `apply` (DVarT extra_name) rhs = foldType (DConT next_name) (map DVarT (arg_names ++ [extra_name])) con_decl = DCon (map dropTvbKind params ++ [DPlainTV extra_name]) [con_eq_ct] con_name (DNormalC False []) (foldTypeTvbs (DConT data_name) params) data_decl = DDataD Data [] data_name args res_ki [con_decl] [] where (args, res_ki) = case m_tyfun of Nothing -> (params, Nothing) -- If we cannot infer the return type, don't bother -- trying to construct an explicit return kind. Just tyfun -> let bound_tvs = Set.fromList (map extractTvbName arg_params) `Set.union` foldMap (foldMap fvDType) (map extractTvbKind arg_params) not_bound tvb = not (extractTvbName tvb `Set.member` bound_tvs) tvb_to_type tvb_name = fromMaybe (DVarT tvb_name) $ Map.lookup tvb_name tvb_to_type_map -- Implements part (2)(iii) from -- Note [Defunctionalization and dependent quantification] tyfun_tvbs = filter not_bound $ -- (2)(iii)(d) toposortTyVarsOf $ -- (2)(iii)(c) map tvb_to_type $ -- (2)(iii)(b) Set.toList $ fvDType tyfun -- (2)(iii)(a) in (arg_params, Just (DForallT tyfun_tvbs [] tyfun)) app_data_ty = foldTypeTvbs (DConT data_name) m_args app_eqn = DTySynEqn [app_data_ty, DVarT tyfun_name] (mk_rhs (m_args ++ [DPlainTV tyfun_name])) app_decl = DTySynInstD applyName app_eqn suppress = DInstanceD Nothing [] (DConT suppressClassName `DAppT` app_data_ty) [DLetDec $ DFunD suppressMethodName [DClause [] ((DVarE 'snd) `DAppE` mkTupleDExp [DConE con_name, mkTupleDExp []])]] mk_rhs' = foldTypeTvbs (DConT data_name) -- See Note [Fixity declarations for defunctionalization symbols] mk_fix_decl f = DLetDec $ DInfixD f data_name fixity_decl = maybeToList $ fmap mk_fix_decl m_fixity decls <- go (n - 1) m_args m_tyfun mk_rhs' return $ suppress : data_decl : app_decl : fixity_decl ++ decls let num_args = length m_arg_tvbs sat_name = promoteTySym name num_args mk_rhs = foldTypeTvbs (DConT name) sat_dec = DTySynD sat_name m_arg_tvbs (mk_rhs m_arg_tvbs) other_decs <- go (num_args - 1) (reverse m_arg_tvbs) m_res_kind mk_rhs return $ sat_dec : other_decs where mk_tvb :: Name -> Maybe DKind -> DTyVarBndr mk_tvb tvb_name Nothing = DPlainTV tvb_name mk_tvb tvb_name (Just k) = DKindedTV tvb_name k eta_expand :: [DTyVarBndr] -> Maybe DKind -> PrM ([DTyVarBndr], Maybe DKind) eta_expand m_arg_tvbs Nothing = pure (m_arg_tvbs, Nothing) eta_expand m_arg_tvbs (Just res_kind) = do let (_, _, argKs, resultK) = unravel res_kind tvb_names <- replicateM (length argKs) $ qNewName "e" let res_kind_arg_tvbs = zipWith DKindedTV tvb_names argKs pure (m_arg_tvbs ++ res_kind_arg_tvbs, Just resultK) map_tvb_kind :: (DKind -> DKind) -> DTyVarBndr -> DTyVarBndr map_tvb_kind _ tvb@DPlainTV{} = tvb map_tvb_kind f (DKindedTV n k) = DKindedTV n (f k) {- Note [Defunctionalization and dependent quantification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The machinery in this module supports defunctionalizing types that use dependent quantification, such as in the following example: type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where Symmetry a y _ = y :~: a Here is what is involved in making this happen: 1. When defunctionalizing, we must not only know the argument kinds, but rather the argument *kind variable binders*. This is essential since, for instance, Symmetry dependently quantifies `a` and `y` and uses them in the kind of `e`. If we did not track the original kind variable names, then instead of generating this defunctionalization symbol for Symmetry: data SymmetrySym2 (a :: Proxy t) (y :: Proxy t) :: (a :~: y) ~> Type We would generate something more general, like this: data SymmetrySym2 (abc1 :: Proxy t) (abc2 :: Proxy t) :: (a :~: y) ~> Type Alas, there are times where will have no choice but to write a slightly more general kind than we should. For instance, consider this: data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type This defunctionalization symbol doesn't capture the dependent quantification in the first and second argument kinds. But in order to do that properly, you'd need the ability to write something like: data SymmetrySym0 :: forall (a :: Proxy t) ~> forall (y :: Proxy t) ~> (a :~: y) ~> Type It is my (RGS's) belief that it is not possible to achieve something like this in today's GHC (see #304), so we'll just have to live with SymmetrySym0 being slightly more general than it ought to be. In practice, this is unlikely to bite unless you're writing code that specifically exploits this dependency in just the right way. 2. I pulled a fast one earlier by writing: data SymmetrySym0 :: Proxy t ~> Proxy t ~> (a :~: y) ~> Type GHC will actually reject this, because it does not have a CUSK. There are two glaring problems here: (a) The kind of `t` is underdetermined. (b) `a` and `y` should have kind `Proxy t`, but this is not currently the case. Ultimately, the fix is to use explicit kind signatures. A naïve attempt would be something like this: data SymmetrySym0 :: Proxy (t :: (k :: Type)) ~> Proxy (t :: (k :: Type)) ~> ((a :: Proxy (t :: (k :: Type))) :~: (y :: Proxy (t :: (k :: Type)))) ~> Type While that works, it adds a nontrivial amount of clutter. Plus, it requires figuring out (in Template Haskell) which variables have underdetermined kinds and substituting for them. Blegh. A much cleaner approach is: data SymmetrySym0 :: forall (k :: Type) (t :: k) (a :: Proxy t) (y :: Proxy t). Proxy t ~> Proxy t ~> (a :~: y) ~> Type This time, all we have to do is put an explicit `forall` in front, and we achieve a CUSK without having to muck up the body of return kind. It also has the benefit of looking much nicer in generated code. Let's talk about how to achieve this feat, using SymmetrySym1 as the guiding example: (i) Before we begin defunctionalizing a type, we construct a mapping from variable names to their corresponding types, complete with kinds. For instance, in Symmetry, we would have the following map: { k :-> DVarT k -- k , t :-> DSigT (DVarT t) (DVarT k) -- (t :: k) , a :-> DSigT (DVarT a) (DConT ''Proxy `DAppT` DVarT t) -- (a :: Proxy t) , y :-> DSigT (DVarT y) (DConT ''Proxy `DAppT` DVarT y) -- (y :: Proxy t) , e :-> DSigT (DVarT e) (DConT ''(:~:) `DAppT` DSigT (DVarT a) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k)) `DAppT` DSigT (DVarT y) (DConT ''Proxy `DAppT` DSigT (DVarT t) (DVarT k))) -- (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) } Why do this? Because when constructing the `forall` in the return kind of a defunctionalization symbol, it's convenient to be able to know the kinds of everything being bound at a glance. It's not always possible to recover the kinds of every variable (for instance, if we're just given `Proxy t ~> Proxy t ~> (a :~: y) ~> Type`), so having this information is handy. To construct this map, we: (a) Grab the list of type variable binders (this is given as an input to defunctionalize, as discussed in part (1)) and turn it into a list of types. Also include the return kind (if there is one) in this list, as it may also mention type variables with explicit kinds. (b) Construct a flat list of all type variables mentioned in this list. This may involve looking in the kinds of type variables binders. (Note that this part is crucial—the the Singletons/PolyKinds test will fail to compile without it!) (c) Take the flat list and insert each variable into the map by mapping its name to its type (as demonstrated above). To continue the Symmetry example: (a) We grab the list of type variable binders [ (a :: Proxy t) , (y :: Proxy t) , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) ] from the Symmetry declaration. Including the return kind (Type), we get: [ (a :: Proxy t) , (y :: Proxy t) , (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) , Type ] (b) We flatten this into a list of well scoped type variables: [ k , (t :: k) , (a :: Proxy t) , (y :: Proxy t) , (e :: (a :: Proxy (t :: k)) :~: (y :~: Proxy (t :: k))) ] (c) From this, we construct the map shown at the beginning of (i). (ii) Using the map, we will annotate any kind variables in the LHS of the declaration with their respective kinds. In this example, the LHS is: data SymmetrySym1 (a :: Proxy t) :: ... Since `t` maps to simply `(t :: k)` in the map, the LHS becomes: data SymmetrySym1 (a :: Proxy (t :: k)) :: ... Why do this? Because we need to make it apparent that `k` is bound on the LHS. If we don't, we might end up trying to quantify `k` in the return kind (see #353 for an example of what goes wrong if you try to do this). Having to explicitly annotate each occurrence of every kind variable on the LHS like this is a bit tiresome, especially since we don't have to do this in the return kind. If GHC had syntax for visible dependent quantification, we could avoid this step entirely and simply write: data SymmetrySym1 :: forall k (t :: k). forall (a :: Proxy t) -> ... Until GHC gains this syntax, this is the best alternative. (iii) When constructing each defunctionalization symbol, we will end up with some remaining type variable binders and a return kind. For instance: data SymmetrySym1 (a :: Proxy (t :: k)) :: forall ???. Proxy t ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) ~> Type We must fill in the ??? part. Here is how we do so: (a) Collect all of the type variables mentioned in the return kind. (b) Look up each type variable's corresponding type in the map (from part (i)) to learn as much kind information as possible. (c) Perform a reverse topological sort on these types to put the types (and kind) variables in proper dependency order. (d) Filter out any variables that are already bound by the type variable binders that precede the return kind. After doing these steps, what remains goes in place of ???. Let's explain this with the example above: data SymmetrySym1 (a :: Proxy (t :: k)) :: forall ???. Proxy t ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) ~> Type (a) [t, a, k, y] (b) [(t :: k), (a :: Proxy t), k, (y :: Proxy t)] (c) [k, (t :: k), (a :: Proxy t), (y :: Proxy t)] (d) [(y :: Proxy t)] (`k`, `t` and `a` were already bound) Therefore, we end up with: data SymmetrySym1 (a :: Proxy (t :: k)) :: forall (y :: Proxy t). Proxy t ~> ((a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) ~> Type -} -- This is a small function with large importance. When generating -- defunctionalization data types, we often need to fill in the blank in the -- sort of code exemplified below: -- -- @ -- data FooSym2 a (b :: x) (c :: TyFun y z) where -- FooSym2KindInference :: _ -- @ -- -- Where the kind of @a@ is not known. It's extremely tempting to just -- copy-and-paste the type variable binders from the data type itself to the -- constructor, like so: -- -- @ -- data FooSym2 a (b :: x) (c :: TyFun y z) where -- FooSym2KindInference :: forall a (b :: x) (c :: TyFun y z). -- SameKind (...) (...). -- FooSym2KindInference a b c -- @ -- -- But this ends up being an untenable approach. Because @a@ lacks a kind -- signature, @FooSym2@ does not have a complete, user-specified kind signature -- (or CUSK), so GHC will fail to typecheck @FooSym2KindInference@. -- -- Thankfully, there's a workaround—just don't give any of the constructor's -- type variable binders any kinds: -- -- @ -- data FooSym2 a (b :: x) (c :: TyFun y z) where -- FooSym2KindInference :: forall a b c -- SameKind (...) (...). -- FooSym2KindInference a b c -- @ -- -- GHC may be moody when it comes to CUSKs, but it's at least understanding -- enough to typecheck this without issue. The 'dropTvbKind' function is -- what removes the kinds used in the kind inference constructor. dropTvbKind :: DTyVarBndr -> DTyVarBndr dropTvbKind tvb@(DPlainTV {}) = tvb dropTvbKind (DKindedTV n _) = DPlainTV n -- Shorthand for building (k1 ~> k2) buildTyFunArrow :: DKind -> DKind -> DKind buildTyFunArrow k1 k2 = DConT tyFunArrowName `DAppT` k1 `DAppT` k2 buildTyFunArrow_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind buildTyFunArrow_maybe m_k1 m_k2 = do k1 <- m_k1 k2 <- m_k2 return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2 -- Build (~>) kind from the list of kinds ravelTyFun :: [DKind] -> DKind ravelTyFun [] = error "Internal error: TyFun raveling nil" ravelTyFun [k] = k ravelTyFun kinds = go tailK (buildTyFunArrow k2 k1) where (k1 : k2 : tailK) = reverse kinds go [] acc = acc go (k:ks) acc = go ks (buildTyFunArrow k acc) {- Note [Fixity declarations for defunctionalization symbols] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Just like we promote fixity declarations, we should also generate fixity declarations for defunctionaliztion symbols. A primary use case is the following scenario: (.) :: (b -> c) -> (a -> b) -> (a -> c) (f . g) x = f (g x) infixr 9 . One often writes (f . g . h) at the value level, but because (.) is promoted to a type family with three arguments, this doesn't directly translate to the type level. Instead, one must write this: f .@#@$$$ g .@#@$$$ h But in order to ensure that this associates to the right as expected, one must generate an `infixr 9 .@#@#$$$` declaration. This is why defunctionalize accepts a Maybe Fixity argument. -} singletons-2.5.1/src/Data/Singletons/Promote/Eq.hs0000644000000000000000000000607507346545000020220 0ustar0000000000000000{- Data/Singletons/Promote/Eq.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu This module defines the functions that generate type-level equality type family instances. -} module Data.Singletons.Promote.Eq where import Language.Haskell.TH.Syntax import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Util import Control.Monad -- produce a closed type family helper and the instance -- for (==) over the given list of ctors mkEqTypeInstance :: Quasi q => DKind -> [DCon] -> q [DDec] mkEqTypeInstance kind cons = do helperName <- newUniqueName "Equals" aName <- qNewName "a" bName <- qNewName "b" true_branches <- mapM mk_branch cons let null_branch = catch_all_case trueName false_branch = catch_all_case falseName branches | null cons = [null_branch] | otherwise = true_branches ++ [false_branch] closedFam = DClosedTypeFamilyD (DTypeFamilyHead helperName -- We opt to give explicit kinds for the tyvars -- in the helper type family. -- See Note [Promoted class method kinds] -- in Data.Singletons.Promote. [ DKindedTV aName kind , DKindedTV bName kind ] (DKindSig boolKi) Nothing) branches eqInst = DTySynInstD tyEqName (DTySynEqn [DVarT aName, DVarT bName] (foldType (DConT helperName) [DVarT aName, DVarT bName])) inst = DInstanceD Nothing [] ((DConT $ promoteClassName eqName) `DAppT` kind) [eqInst] return [closedFam, inst] where mk_branch :: Quasi q => DCon -> q DTySynEqn mk_branch con = do let (name, numArgs) = extractNameArgs con lnames <- replicateM numArgs (qNewName "a") rnames <- replicateM numArgs (qNewName "b") let lvars = map DVarT lnames rvars = map DVarT rnames ltype = foldType (DConT name) lvars rtype = foldType (DConT name) rvars results = zipWith (\l r -> foldType (DConT tyEqName) [l, r]) lvars rvars result = tyAll results return $ DTySynEqn [ltype, rtype] result catch_all_case :: Name -> DTySynEqn catch_all_case returned_val_name = DTySynEqn [DSigT DWildCardT kind, DSigT DWildCardT kind] (promoteValRhs returned_val_name) tyAll :: [DType] -> DType -- "all" at the type level tyAll [] = (promoteValRhs trueName) tyAll [one] = one tyAll (h:t) = foldType (DConT $ promoteValNameLhs andName) [h, (tyAll t)] -- I could use the Apply nonsense here, but there's no reason to singletons-2.5.1/src/Data/Singletons/Promote/Monad.hs0000644000000000000000000001413307346545000020703 0ustar0000000000000000{- Data/Singletons/Promote/Monad.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu This file defines the PrM monad and its operations, for use during promotion. The PrM monad allows reading from a PrEnv environment and writing to a list of DDec, and is wrapped around a Q. -} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleContexts, TypeFamilies, KindSignatures #-} module Data.Singletons.Promote.Monad ( PrM, promoteM, promoteM_, promoteMDecs, VarPromotions, allLocals, emitDecs, emitDecsM, lambdaBind, LetBind, letBind, lookupVarE, forallBind, allBoundKindVars ) where import Control.Monad.Reader import Control.Monad.Writer import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import qualified Data.Set as Set import Data.Set ( Set ) import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Syntax import Control.Monad.Fail ( MonadFail ) type LetExpansions = Map Name DType -- from **term-level** name -- environment during promotion data PrEnv = PrEnv { pr_lambda_bound :: Map Name Name , pr_let_bound :: LetExpansions , pr_forall_bound :: Set Name -- See Note [Explicitly quantifying kinds variables] , pr_local_decls :: [Dec] } emptyPrEnv :: PrEnv emptyPrEnv = PrEnv { pr_lambda_bound = Map.empty , pr_let_bound = Map.empty , pr_forall_bound = Set.empty , pr_local_decls = [] } -- the promotion monad newtype PrM a = PrM (ReaderT PrEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad, Quasi , MonadReader PrEnv, MonadWriter [DDec] , MonadFail, MonadIO ) instance DsMonad PrM where localDeclarations = asks pr_local_decls -- return *type-level* names allLocals :: MonadReader PrEnv m => m [Name] allLocals = do lambdas <- asks (Map.toList . pr_lambda_bound) lets <- asks pr_let_bound -- filter out shadowed variables! return [ typeName | (termName, typeName) <- lambdas , case Map.lookup termName lets of Just (DVarT typeName') | typeName' == typeName -> True _ -> False ] emitDecs :: MonadWriter [DDec] m => [DDec] -> m () emitDecs = tell emitDecsM :: MonadWriter [DDec] m => m [DDec] -> m () emitDecsM action = do decs <- action emitDecs decs -- when lambda-binding variables, we still need to add the variables -- to the let-expansion, because of shadowing. ugh. lambdaBind :: VarPromotions -> PrM a -> PrM a lambdaBind binds = local add_binds where add_binds env@(PrEnv { pr_lambda_bound = lambdas , pr_let_bound = lets }) = let new_lets = Map.fromList [ (tmN, DVarT tyN) | (tmN, tyN) <- binds ] in env { pr_lambda_bound = Map.union (Map.fromList binds) lambdas , pr_let_bound = Map.union new_lets lets } type LetBind = (Name, DType) letBind :: [LetBind] -> PrM a -> PrM a letBind binds = local add_binds where add_binds env@(PrEnv { pr_let_bound = lets }) = env { pr_let_bound = Map.union (Map.fromList binds) lets } lookupVarE :: Name -> PrM DType lookupVarE n = do lets <- asks pr_let_bound case Map.lookup n lets of Just ty -> return ty Nothing -> return $ promoteValRhs n -- Add to the set of bound kind variables currently in scope. -- See Note [Explicitly binding kind variables] forallBind :: Set Name -> PrM a -> PrM a forallBind kvs1 = local (\env@(PrEnv { pr_forall_bound = kvs2 }) -> env { pr_forall_bound = kvs1 `Set.union` kvs2 }) -- Look up the set of bound kind variables currently in scope. -- See Note [Explicitly binding kind variables] allBoundKindVars :: PrM (Set Name) allBoundKindVars = asks pr_forall_bound promoteM :: DsMonad q => [Dec] -> PrM a -> q (a, [DDec]) promoteM locals (PrM rdr) = do other_locals <- localDeclarations let wr = runReaderT rdr (emptyPrEnv { pr_local_decls = other_locals ++ locals }) q = runWriterT wr runQ q promoteM_ :: DsMonad q => [Dec] -> PrM () -> q [DDec] promoteM_ locals thing = do ((), decs) <- promoteM locals thing return decs -- promoteM specialized to [DDec] promoteMDecs :: DsMonad q => [Dec] -> PrM [DDec] -> q [DDec] promoteMDecs locals thing = do (decs1, decs2) <- promoteM locals thing return $ decs1 ++ decs2 {- Note [Explicitly binding kind variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to ensure that when we single type signatures for functions, we should explicitly quantify every kind variable bound by a forall. For example, if we were to single the identity function: identity :: forall a. a -> a identity x = x We want the final result to be: sIdentity :: forall a (x :: a). Sing x -> Sing (Identity x) sIdentity sX = sX Accomplishing this takes a bit of care during promotion. When promoting a function, we determine what set of kind variables are currently bound at that point and store them in an ALetDecEnv (as lde_bound_kvs), which in turn is singled. Then, during singling, we extract every kind variable in a singled type signature, subtract the lde_bound_kvs, and explicitly bind the variables that remain. For a top-level function like identity, lde_bound_kvs is the empty set. But consider this more complicated example: f :: forall a. a -> a f = g where g :: a -> a g x = x When singling, we would eventually end up in this spot: sF :: forall a (x :: a). Sing a -> Sing (F a) sF = sG where sG :: _ sG x = x We must make sure /not/ to fill in the following type for _: sF :: forall a (x :: a). Sing a -> Sing (F a) sF = sG where sG :: forall a (y :: a). Sing a -> Sing (G a) sG x = x This would be incorrect, as the `a` bound by sF /must/ be the same one used in sG, as per the scoping of the original `f` function. Thus, we ensure that the bound variables from `f` are put into lde_bound_kvs when promoting `g` so that we subtract out `a` and are left with the correct result: sF :: forall a (x :: a). Sing a -> Sing (F a) sF = sG where sG :: forall (y :: a). Sing a -> Sing (G a) sG x = x -} singletons-2.5.1/src/Data/Singletons/Promote/Type.hs0000644000000000000000000000474207346545000020573 0ustar0000000000000000{- Data/Singletons/Type.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu This file implements promotion of types into kinds. -} module Data.Singletons.Promote.Type ( promoteType, promoteUnraveled ) where import Language.Haskell.TH.Desugar import Data.Singletons.Names import Data.Singletons.Util import Language.Haskell.TH -- the only monadic thing we do here is fail. This allows the function -- to be used from the Singletons module promoteType :: Monad m => DType -> m DKind promoteType = go [] where go :: Monad m => [DKind] -> DType -> m DKind -- We don't need to worry about constraints: they are used to express -- static guarantees at runtime. But, because we don't need to do -- anything special to keep static guarantees at compile time, we don't -- need to promote them. go [] (DForallT _tvbs _cxt ty) = go [] ty go [] (DAppT (DAppT DArrowT (DForallT (_:_) _ _)) _) = fail "Cannot promote types of rank above 1." go args (DAppT t1 t2) = do k2 <- go [] t2 go (k2 : args) t1 -- NB: This next case means that promoting something like -- (((->) a) :: Type -> Type) b -- will fail because the pattern below won't recognize the -- arrow to turn it into a TyFun. But I'm not terribly -- bothered by this, and it would be annoying to fix. Wait -- for someone to report. go args (DSigT ty ki) = do ty' <- go [] ty -- No need to promote 'ki' - it is already a kind. return $ foldType (DSigT ty' ki) args go args (DVarT name) = return $ foldType (DVarT name) args go [] (DConT name) | name == typeRepName = return $ DConT typeKindName | nameBase name == nameBase repName = return $ DConT typeKindName go args (DConT name) | Just n <- unboxedTupleNameDegree_maybe name = return $ foldType (DConT (tupleTypeName n)) args | otherwise = return $ foldType (DConT name) args go [k1, k2] DArrowT = return $ DConT tyFunArrowName `DAppT` k1 `DAppT` k2 go _ ty@DLitT{} = pure ty go args hd = fail $ "Illegal Haskell construct encountered:\n" ++ "headed by: " ++ show hd ++ "\n" ++ "applied to: " ++ show args promoteUnraveled :: Monad m => DType -> m ([DKind], DKind) promoteUnraveled ty = do arg_kis <- mapM promoteType arg_tys res_ki <- promoteType res_ty return (arg_kis, res_ki) where (_, _, arg_tys, res_ty) = unravel ty singletons-2.5.1/src/Data/Singletons/ShowSing.hs0000644000000000000000000001711307346545000017762 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.ShowSing -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines the class 'ShowSing' type synonym, which is useful for defining -- 'Show' instances for singleton types. -- ---------------------------------------------------------------------------- module Data.Singletons.ShowSing ( -- * The 'ShowSing' type ShowSing ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Instances import Data.Singletons.Single import Data.Singletons.TypeLits.Internal import Data.Singletons.Util import GHC.Show (appPrec, appPrec1) import qualified GHC.TypeNats as TN -- | In addition to the promoted and singled versions of the 'Show' class that -- @singletons@ provides, it is also useful to be able to directly define -- 'Show' instances for singleton types themselves. Doing so is almost entirely -- straightforward, as a derived 'Show' instance does 90 percent of the work. -- The last 10 percent—getting the right instance context—is a bit tricky, and -- that's where 'ShowSing' comes into play. -- -- As an example, let's consider the singleton type for lists. We want to write -- an instance with the following shape: -- -- @ -- deriving instance ??? => Show (Sing (x :: [k])) -- @ -- -- To figure out what should go in place of @???@, observe that we require the -- type of each field to also be 'Show' instances. In other words, we need -- something like @(Show (Sing (a :: k)))@. But this isn't quite right, as the -- type variable @a@ doesn't appear in the instance head. In fact, this @a@ -- type is really referring to an existentially quantified type variable in the -- 'SCons' constructor, so it doesn't make sense to try and use it like this. -- -- Luckily, the @QuantifiedConstraints@ language extension provides a solution -- to this problem. This lets you write a context of the form -- @(forall a. Show (Sing (a :: k)))@, which demands that there be an instance -- for @Show (Sing (a :: k))@ that is parametric in the use of @a@. Thus, our -- final instance looks like: -- -- @ -- deriving instance (forall a. Show (Sing (a :: k))) => Show (Sing (x :: [k])) -- @ -- -- Because that quantified constraint is somewhat lengthy, we provide the -- 'ShowSing' class synonym as a convenient shorthand. Thus, the above instance -- is equivalent to: -- -- @ -- deriving instance ShowSing k => Show (Sing (x :: [k])) -- @ -- -- When singling a derived 'Show' instance, @singletons@ will also derive -- a 'Show' instance for the corresponding singleton type using 'ShowSing'. -- In other words, if you give @singletons@ a derived 'Show' instance, then -- you'll receive the following in return: -- -- * A promoted (@PShow@) instance -- * A singled (@SShow@) instance -- * A 'Show' instance for the singleton type -- -- What a bargain! class (forall (z :: k). Show (Sing z)) => ShowSing k instance (forall (z :: k). Show (Sing z)) => ShowSing k {- Note [Define ShowSing as a class, not a type synonym] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In an ideal world, we would simply define ShowSing as an ordinary type synonym, like this: type ShowSing k = (forall (z :: k). Show (Sing z) :: Constraint) In fact, I used to assume that we lived in an ideal world, so I defined ShowSing as a type synonym in version 2.5 of this library. However, I realized some time after 2.5's release that the world is far from ideal, unfortunately, and that this approach is unfeasible at the time being due to GHC Trac #15888. To be more precise, the exact issue involves an infelicity in the way QuantifiedConstraints interacts with recursive type class instances. Consider the following example (from #371): $(singletons [d| data X a = X1 | X2 (Y a) deriving Show data Y a = Y1 | Y2 (X a) deriving Show |]) This will generate the following instances: deriving instance ShowSing (Y a) => Show (Sing (z :: X a)) deriving instance ShowSing (X a) => Show (Sing (z :: Y a)) So far, so good. Now, suppose you try to actually `show` a singleton for X. For example: show (sing @(X1 :: X Bool)) Somewhat surprisingly, this will be rejected by the typechecker with the following error: • Reduction stack overflow; size = 201 When simplifying the following type: Show (Sing z) To see why this happens, observe what goes on if we expand the occurrences of the ShowSing type synonym in the generated instances: deriving instance (forall z. Show (Sing (z :: Y a))) => Show (Sing (z :: X a)) deriving instance (forall z. Show (Sing (z :: X a))) => Show (Sing (z :: Y a)) Due to the way QuantifiedConstraints currently works (as surmised in Trac #15888), when GHC has a Wanted `Show (Sing X1 :: X Bool)` constraint, it chooses the appropriate instance and emits a Wanted `forall z. Show (Sing (z :: Y Bool))` constraint (from the instance context). GHC skolemizes the `z` to `z1` and tries to solve a Wanted `Show (Sing (z1 :: Y Bool))` constraint. GHC chooses the appropriate instance and emits a Wanted `forall z. Show (Sing (z :: X Bool))` constraint. GHC skolemizes the `z` to `z2` and tries to solve a Wanted `Show (Sing (z2 :: X Bool))` constraint... we repeat the process and find ourselves in an infinite loop that eventually overflows the reduction stack. Eep. Until Trac #15888 is fixed, there are two possible ways to work around this problem: 1. Make derived instances' type inference more clever. If you look closely, you'll notice that the `ShowSing (X a)`/`ShowSing (Y a)` constraints in the generated instances are entirely redundant and could safely be left off. But determining this would require significantly improving singletons' Template Haskell capabilities for type inference, which is a path that we usually spurn in favor of keeping the generated code dumb but predictable. 2. Define `ShowSing` as a class (with a single instance) instead of a type synonym. `ShowSing`-as-a-class ties the recursive knot during instance resolution and thus avoids the problems that the type synonym version currently suffers from. Given the two options, (2) is by far the easier option, so that is what we ultimately went with. -} ------------------------------------------------------------ -- TypeLits instances ------------------------------------------------------------ -- These are a bit special because the singleton constructor does not uniquely -- determine the type being used in the constructor's return type (e.g., all Nats -- have the same singleton constructor, SNat). To compensate for this, we display -- the type being used using visible type application. (Thanks to @cumber on #179 -- for suggesting this implementation.) instance Show (SNat n) where showsPrec p n@SNat = showParen (p > appPrec) ( showString "SNat @" . showsPrec appPrec1 (TN.natVal n) ) instance Show (SSymbol s) where showsPrec p s@SSym = showParen (p > appPrec) ( showString "SSym @" . showsPrec appPrec1 (symbolVal s) ) ------------------------------------------------------------ -- Template Haskell-generated instances ------------------------------------------------------------ $(showSingInstances basicTypes) singletons-2.5.1/src/Data/Singletons/Sigma.hs0000644000000000000000000000475107346545000017265 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Sigma -- Copyright : (C) 2017 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines 'Sigma', a dependent pair data type, and related functions. -- ---------------------------------------------------------------------------- module Data.Singletons.Sigma ( Sigma(..), Σ , projSigma1, projSigma2 , mapSigma, zipSigma -- * Defunctionalization symbols , ΣSym0, ΣSym1, ΣSym2 ) where import Data.Kind (Type) import Data.Singletons.Internal import Data.Singletons.Promote -- | A dependent pair. data Sigma (s :: Type) :: (s ~> Type) -> Type where (:&:) :: forall s t fst. Sing (fst :: s) -> t @@ fst -> Sigma s t infixr 4 :&: -- | Unicode shorthand for 'Sigma'. type Σ (s :: Type) (t :: s ~> Type) = Sigma s t -- | Project the first element out of a dependent pair. projSigma1 :: forall s t. SingKind s => Sigma s t -> Demote s projSigma1 (a :&: _) = fromSing a -- | Project the second element out of a dependent pair. -- -- In an ideal setting, the type of 'projSigma2' would be closer to: -- -- @ -- 'projSigma2' :: 'Sing' (sig :: 'Sigma' s t) -> t @@ ProjSigma1 sig -- @ -- -- But promoting 'projSigma1' to a type family is not a simple task. Instead, -- we do the next-best thing, which is to use Church-style elimination. projSigma2 :: forall s t r. (forall (fst :: s). t @@ fst -> r) -> Sigma s t -> r projSigma2 f ((_ :: Sing (fst :: s)) :&: b) = f @fst b -- | Map across a 'Sigma' value in a dependent fashion. mapSigma :: Sing (f :: a ~> b) -> (forall (x :: a). p @@ x -> q @@ (f @@ x)) -> Sigma a p -> Sigma b q mapSigma f g ((x :: Sing (fst :: a)) :&: y) = (f @@ x) :&: (g @fst y) -- | Zip two 'Sigma' values together in a dependent fashion. zipSigma :: Sing (f :: a ~> b ~> c) -> (forall (x :: a) (y :: b). p @@ x -> q @@ y -> r @@ (f @@ x @@ y)) -> Sigma a p -> Sigma b q -> Sigma c r zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) = (f @@ a @@ b) :&: (g @fstA @fstB p q) $(genDefunSymbols [''Σ]) singletons-2.5.1/src/Data/Singletons/Single.hs0000644000000000000000000011663707346545000017455 0ustar0000000000000000{- Data/Singletons/Single.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu This file contains functions to refine constructs to work with singleton types. It is an internal module to the singletons package. -} {-# LANGUAGE TemplateHaskell, TupleSections, ParallelListComp, CPP #-} module Data.Singletons.Single where import Prelude hiding ( exp ) import Language.Haskell.TH hiding ( cxt ) import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..)) import Data.Singletons.Deriving.Infer import Data.Singletons.Deriving.Ord import Data.Singletons.Deriving.Bounded import Data.Singletons.Deriving.Enum import Data.Singletons.Deriving.Show import Data.Singletons.Deriving.Util import Data.Singletons.Util import Data.Singletons.Promote import Data.Singletons.Promote.Defun import Data.Singletons.Promote.Monad ( promoteM ) import Data.Singletons.Promote.Type import Data.Singletons.Names import Data.Singletons.Single.Monad import Data.Singletons.Single.Type import Data.Singletons.Single.Data import Data.Singletons.Single.Defun import Data.Singletons.Single.Fixity import Data.Singletons.Single.Eq import Data.Singletons.Syntax import Data.Singletons.Partition import Language.Haskell.TH.Desugar import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) import Data.Maybe import qualified Data.Set as Set import Data.Set ( Set ) import Control.Monad import Data.List import qualified GHC.LanguageExtensions.Type as LangExt {- How singletons works ~~~~~~~~~~~~~~~~~~~~ Singling, on the surface, doesn't seem all that complicated. Promote the type, and singletonize all the terms. That's essentially what was done singletons < 1.0. But, now we want to deal with higher-order singletons. So, things are a little more complicated. The way to understand all of this is that *every* variable maps to something of type (Sing t), for an appropriately-kinded t. This includes functions, which use the "SLambda" instance of Sing. To apply singleton functions, we use the applySing function. That, in and of itself, wouldn't be too hard, but it's really annoying from the user standpoint. After dutifully singling `map`, a user doesn't want to have to use two `applySing`s to actually use it. So, any let-bound identifier is eta-expanded so that the singled type has the same number of arrows as the original type. (If there is no original type signature, then it has as many arrows as the original had patterns.) Then, we store a use of one of the singFunX functions in the SgM environment so that every use of a let-bound identifier has a proper type (Sing t). It would be consistent to avoid this eta-expansion for local lets (as opposed to top-level lets), but that seemed like more bother than it was worth. It may also be possible to be cleverer about nested eta-expansions and contractions, but that also seemed not to be worth it. Though I haven't tested it, my hope is that the eta-expansions and contractions have no runtime effect, especially because SLambda is a *newtype* instance, not a *data* instance. Note that to maintain the desired invariant, we must also be careful to eta- contract constructors. This is the point of buildDataLets. -} -- | Generate singleton definitions from a type that is already defined. -- For example, the singletons package itself uses -- -- > $(genSingletons [''Bool, ''Maybe, ''Either, ''[]]) -- -- to generate singletons for Prelude types. genSingletons :: DsMonad q => [Name] -> q [Dec] genSingletons names = do checkForRep names ddecs <- concatMapM (singInfo <=< dsInfo <=< reifyWithLocals) names return $ decsToTH ddecs -- | Make promoted and singleton versions of all declarations given, retaining -- the original declarations. -- See for -- further explanation. singletons :: DsMonad q => q [Dec] -> q [Dec] singletons qdecs = do decs <- qdecs ddecs <- withLocalDeclarations decs $ dsDecs decs singDecs <- singTopLevelDecs decs ddecs return (decs ++ decsToTH singDecs) -- | Make promoted and singleton versions of all declarations given, discarding -- the original declarations. Note that a singleton based on a datatype needs -- the original datatype, so this will fail if it sees any datatype declarations. -- Classes, instances, and functions are all fine. singletonsOnly :: DsMonad q => q [Dec] -> q [Dec] singletonsOnly = (>>= wrapDesugar singTopLevelDecs) -- | Create instances of 'SEq' and type-level @(==)@ for each type in the list singEqInstances :: DsMonad q => [Name] -> q [Dec] singEqInstances = concatMapM singEqInstance -- | Create instance of 'SEq' and type-level @(==)@ for the given type singEqInstance :: DsMonad q => Name -> q [Dec] singEqInstance name = do promotion <- promoteEqInstance name dec <- singEqualityInstance sEqClassDesc name return $ dec ++ promotion -- | Create instances of 'SEq' (only -- no instance for @(==)@, which 'SEq' generally -- relies on) for each type in the list singEqInstancesOnly :: DsMonad q => [Name] -> q [Dec] singEqInstancesOnly = concatMapM singEqInstanceOnly -- | Create instances of 'SEq' (only -- no instance for @(==)@, which 'SEq' generally -- relies on) for the given type singEqInstanceOnly :: DsMonad q => Name -> q [Dec] singEqInstanceOnly name = singEqualityInstance sEqClassDesc name -- | Create instances of 'SDecide' for each type in the list. singDecideInstances :: DsMonad q => [Name] -> q [Dec] singDecideInstances = concatMapM singDecideInstance -- | Create instance of 'SDecide' for the given type. singDecideInstance :: DsMonad q => Name -> q [Dec] singDecideInstance name = singEqualityInstance sDecideClassDesc name -- generalized function for creating equality instances singEqualityInstance :: DsMonad q => EqualityClassDesc q -> Name -> q [Dec] singEqualityInstance desc@(_, _, className, _) name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ show className ++ " for it.") name dtvbs <- mapM dsTvb tvbs let data_ty = foldTypeTvbs (DConT name) dtvbs dcons <- concatMapM (dsCon dtvbs data_ty) cons let tyvars = map (DVarT . extractTvbName) dtvbs kind = foldType (DConT name) tyvars (scons, _) <- singM [] $ mapM singCtor dcons eqInstance <- mkEqualityInstance Nothing kind dcons scons desc return $ decToTH eqInstance -- | Create instances of 'SOrd' for the given types singOrdInstances :: DsMonad q => [Name] -> q [Dec] singOrdInstances = concatMapM singOrdInstance -- | Create instance of 'SOrd' for the given type singOrdInstance :: DsMonad q => Name -> q [Dec] singOrdInstance = singInstance mkOrdInstance "Ord" -- | Create instances of 'SBounded' for the given types singBoundedInstances :: DsMonad q => [Name] -> q [Dec] singBoundedInstances = concatMapM singBoundedInstance -- | Create instance of 'SBounded' for the given type singBoundedInstance :: DsMonad q => Name -> q [Dec] singBoundedInstance = singInstance mkBoundedInstance "Bounded" -- | Create instances of 'SEnum' for the given types singEnumInstances :: DsMonad q => [Name] -> q [Dec] singEnumInstances = concatMapM singEnumInstance -- | Create instance of 'SEnum' for the given type singEnumInstance :: DsMonad q => Name -> q [Dec] singEnumInstance = singInstance mkEnumInstance "Enum" -- | Create instance of 'SShow' for the given type -- -- (Not to be confused with 'showShowInstance'.) singShowInstance :: DsMonad q => Name -> q [Dec] singShowInstance = singInstance mkShowInstance "Show" -- | Create instances of 'SShow' for the given types -- -- (Not to be confused with 'showSingInstances'.) singShowInstances :: DsMonad q => [Name] -> q [Dec] singShowInstances = concatMapM singShowInstance -- | Create instance of 'Show' for the given singleton type -- -- (Not to be confused with 'singShowInstance'.) showSingInstance :: DsMonad q => Name -> q [Dec] showSingInstance name = do (tvbs, cons) <- getDataD ("I cannot make an instance of Show for it.") name dtvbs <- mapM dsTvb tvbs let data_ty = foldTypeTvbs (DConT name) dtvbs dcons <- concatMapM (dsCon dtvbs data_ty) cons let tyvars = map (DVarT . extractTvbName) dtvbs kind = foldType (DConT name) tyvars data_decl = DataDecl name dtvbs dcons deriv_show_decl = DerivedDecl { ded_mb_cxt = Nothing , ded_type = kind , ded_decl = data_decl } (show_insts, _) <- singM [] $ singDerivedShowDecs deriv_show_decl pure $ decsToTH show_insts -- | Create instances of 'Show' for the given singleton types -- -- (Not to be confused with 'singShowInstances'.) showSingInstances :: DsMonad q => [Name] -> q [Dec] showSingInstances = concatMapM showSingInstance singInstance :: DsMonad q => DerivDesc q -> String -> Name -> q [Dec] singInstance mk_inst inst_name name = do (tvbs, cons) <- getDataD ("I cannot make an instance of " ++ inst_name ++ " for it.") name dtvbs <- mapM dsTvb tvbs let data_ty = foldTypeTvbs (DConT name) dtvbs dcons <- concatMapM (dsCon dtvbs data_ty) cons let data_decl = DataDecl name dtvbs dcons raw_inst <- mk_inst Nothing data_ty data_decl (a_inst, decs) <- promoteM [] $ promoteInstanceDec Map.empty raw_inst decs' <- singDecsM [] $ (:[]) <$> singInstD a_inst return $ decsToTH (decs ++ decs') singInfo :: DsMonad q => DInfo -> q [DDec] singInfo (DTyConI dec _) = singTopLevelDecs [] [dec] singInfo (DPrimTyConI _name _numArgs _unlifted) = fail "Singling of primitive type constructors not supported" singInfo (DVarI _name _ty _mdec) = fail "Singling of value info not supported" singInfo (DTyVarI _name _ty) = fail "Singling of type variable info not supported" singInfo (DPatSynI {}) = fail "Singling of pattern synonym info not supported" singTopLevelDecs :: DsMonad q => [Dec] -> [DDec] -> q [DDec] singTopLevelDecs locals raw_decls = withLocalDeclarations locals $ do decls <- expand raw_decls -- expand type synonyms PDecs { pd_let_decs = letDecls , pd_class_decs = classes , pd_instance_decs = insts , pd_data_decs = datas , pd_ty_syn_decs = ty_syns , pd_open_type_family_decs = o_tyfams , pd_closed_type_family_decs = c_tyfams , pd_derived_eq_decs = derivedEqDecs , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls ((letDecEnv, classes', insts'), promDecls) <- promoteM locals $ do defunTypeDecls ty_syns c_tyfams o_tyfams promoteDataDecs datas (_, letDecEnv) <- promoteLetDecs noPrefix letDecls classes' <- mapM promoteClassDec classes let meth_sigs = foldMap (lde_types . cd_lde) classes insts' <- mapM (promoteInstanceDec meth_sigs) insts mapM_ promoteDerivedEqDec derivedEqDecs return (letDecEnv, classes', insts') singDecsM locals $ do let letBinds = concatMap buildDataLets datas ++ concatMap buildMethLets classes (newLetDecls, singIDefunDecls, newDecls) <- bindLets letBinds $ singLetDecEnv letDecEnv $ do newDataDecls <- concatMapM singDataD datas newClassDecls <- mapM singClassD classes' newInstDecls <- mapM singInstD insts' newDerivedEqDecs <- concatMapM singDerivedEqDecs derivedEqDecs newDerivedShowDecs <- concatMapM singDerivedShowDecs derivedShowDecs return $ newDataDecls ++ newClassDecls ++ newInstDecls ++ newDerivedEqDecs ++ newDerivedShowDecs return $ promDecls ++ (map DLetDec newLetDecls) ++ singIDefunDecls ++ newDecls -- see comment at top of file buildDataLets :: DataDecl -> [(Name, DExp)] buildDataLets (DataDecl _name _tvbs cons) = concatMap con_num_args cons where con_num_args :: DCon -> [(Name, DExp)] con_num_args (DCon _tvbs _cxt name fields _rty) = (name, wrapSingFun (length (tysOfConFields fields)) (promoteValRhs name) (DConE $ singDataConName name)) : rec_selectors fields rec_selectors :: DConFields -> [(Name, DExp)] rec_selectors (DNormalC {}) = [] rec_selectors (DRecC fields) = let names = map fstOf3 fields in [ (name, wrapSingFun 1 (promoteValRhs name) (DVarE $ singValName name)) | name <- names ] -- see comment at top of file buildMethLets :: UClassDecl -> [(Name, DExp)] buildMethLets (ClassDecl { cd_lde = LetDecEnv { lde_types = meth_sigs } }) = map mk_bind (Map.toList meth_sigs) where mk_bind (meth_name, meth_ty) = ( meth_name , wrapSingFun (countArgs meth_ty) (promoteValRhs meth_name) (DVarE $ singValName meth_name) ) singClassD :: AClassDecl -> SgM DDec singClassD (ClassDecl { cd_cxt = cls_cxt , cd_name = cls_name , cd_tvbs = cls_tvbs , cd_fds = cls_fundeps , cd_lde = LetDecEnv { lde_defns = default_defns , lde_types = meth_sigs , lde_infix = fixities , lde_proms = promoted_defaults , lde_bound_kvs = meth_bound_kvs } }) = bindContext [foldPredTvbs (DConPr cls_name) cls_tvbs] $ do (sing_sigs, _, tyvar_names, cxts, res_kis, singIDefunss) <- unzip6 <$> zipWithM (singTySig no_meth_defns meth_sigs meth_bound_kvs) meth_names (map promoteValRhs meth_names) emitDecs $ concat singIDefunss let default_sigs = catMaybes $ zipWith4 mk_default_sig meth_names sing_sigs tyvar_names res_kis res_ki_map = Map.fromList (zip meth_names (map (fromMaybe always_sig) res_kis)) sing_meths <- mapM (uncurry (singLetDecRHS (Map.fromList tyvar_names) (Map.fromList cxts) res_ki_map)) (Map.toList default_defns) fixities' <- traverse (uncurry singInfixDecl) $ Map.toList fixities cls_cxt' <- mapM singPred cls_cxt return $ DClassD cls_cxt' (singClassName cls_name) cls_tvbs cls_fundeps -- they are fine without modification (map DLetDec (sing_sigs ++ sing_meths ++ fixities') ++ default_sigs) where no_meth_defns = error "Internal error: can't find declared method type" always_sig = error "Internal error: no signature for default method" meth_names = Map.keys meth_sigs mk_default_sig meth_name (DSigD s_name sty) bound_kvs (Just res_ki) = DDefaultSigD s_name <$> add_constraints meth_name sty bound_kvs res_ki mk_default_sig _ _ _ _ = error "Internal error: a singled signature isn't a signature." add_constraints meth_name sty (_, bound_kvs) res_ki = do -- Maybe monad prom_dflt <- Map.lookup meth_name promoted_defaults let default_pred = foldPred (DConPr equalityName) -- NB: Need the res_ki here to prevent ambiguous -- kinds in result-inferred default methods. -- See #175 [ foldApply (promoteValRhs meth_name) tvs `DSigT` res_ki , foldApply prom_dflt tvs ] return $ DForallT tvbs (default_pred : cxt) (ravel args res) where (tvbs, cxt, args, res) = unravel sty bound_kv_set = Set.fromList bound_kvs -- Filter out explicitly bound kind variables. Otherwise, if you had -- the following class (#312): -- -- class Foo a where -- bar :: a -> b -> b -- bar _ x = x -- -- Then it would be singled to: -- -- class SFoo a where -- sBar :: forall b (x :: a) (y :: b). Sing x -> Sing y -> Sing (sBar x y) -- default :: forall b (x :: a) (y :: b). -- (Bar b x y) ~ (BarDefault b x y) => ... -- -- Which applies Bar/BarDefault to b, which shouldn't happen. tvs = map tvbToType $ filter (\tvb -> extractTvbName tvb `Set.member` bound_kv_set) tvbs singInstD :: AInstDecl -> SgM DDec singInstD (InstDecl { id_cxt = cxt, id_name = inst_name, id_arg_tys = inst_tys , id_sigs = inst_sigs, id_meths = ann_meths }) = do bindContext cxt $ do cxt' <- mapM singPred cxt inst_kis <- mapM promoteType inst_tys meths <- concatMapM (uncurry sing_meth) ann_meths return (DInstanceD Nothing cxt' (foldl DAppT (DConT s_inst_name) inst_kis) meths) where s_inst_name = singClassName inst_name sing_meth :: Name -> ALetDecRHS -> SgM [DDec] sing_meth name rhs = do mb_s_info <- dsReify (singValName name) inst_kis <- mapM promoteType inst_tys let mk_subst cls_tvbs = Map.fromList $ zip (map extractTvbName vis_cls_tvbs) inst_kis where -- This is a half-hearted attempt to address the underlying problem -- in #358, where we can sometimes have more class type variables -- (due to implicit kind arguments) than class arguments. This just -- ensures that the explicit type variables are properly mapped -- to the class arguments, leaving the implicit kind variables -- unmapped. That could potentially cause *other* problems, but -- those are perhaps best avoided by using InstanceSigs. At the -- very least, this workaround will make error messages slightly -- less confusing. vis_cls_tvbs = drop (length cls_tvbs - length inst_kis) cls_tvbs sing_meth_ty :: Set Name -> DType -> SgM (DType, [Name], DCxt, DKind) sing_meth_ty bound_kvs inner_ty = do -- Make sure to expand through type synonyms here! Not doing so -- resulted in #167. raw_ty <- expand inner_ty (s_ty, _num_args, tyvar_names, ctxt, _arg_kis, res_ki) <- singType bound_kvs (promoteValRhs name) raw_ty pure (s_ty, tyvar_names, ctxt, res_ki) (s_ty, tyvar_names, ctxt, m_res_ki) <- case Map.lookup name inst_sigs of Just inst_sig -> do -- We have an InstanceSig, so just single that type. Take care to -- avoid binding the variables bound by the instance head as well. let inst_bound = foldMap (fvDType . predToType) cxt <> foldMap fvDType inst_kis (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty inst_bound inst_sig pure (s_ty, tyvar_names, ctxt, Just res_ki) Nothing -> case mb_s_info of -- We don't have an InstanceSig, so we must compute the type to use -- in the singled instance ourselves through reification. Just (DVarI _ (DForallT cls_tvbs _cls_pred s_ty) _) -> do let subst = mk_subst cls_tvbs (sing_tvbs, ctxt, _args, res_ty) = unravel s_ty m_res_ki = case res_ty of _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki) _ -> Nothing pure ( substType subst s_ty , map extractTvbName sing_tvbs , map (substPred subst) ctxt , m_res_ki ) _ -> do mb_info <- dsReify name case mb_info of Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do let subst = mk_subst cls_tvbs cls_kvb_names = foldMap (foldMap fvDType . extractTvbKind) cls_tvbs cls_tvb_names = Set.fromList $ map extractTvbName cls_tvbs cls_bound = cls_kvb_names `Set.union` cls_tvb_names (s_ty, tyvar_names, ctxt, res_ki) <- sing_meth_ty cls_bound inner_ty pure ( substType subst s_ty , tyvar_names , ctxt , Just (substKind subst res_ki) ) _ -> fail $ "Cannot find type of method " ++ show name let kind_map = maybe Map.empty (Map.singleton name) m_res_ki meth' <- singLetDecRHS (Map.singleton name tyvar_names) (Map.singleton name ctxt) kind_map name rhs return $ map DLetDec [DSigD (singValName name) s_ty, meth'] singLetDecEnv :: ALetDecEnv -> SgM a -> SgM ([DLetDec], [DDec], a) -- Return: -- -- 1. The singled let-decs -- 2. SingI instances for any defunctionalization symbols -- (see Data.Singletons.Single.Defun) -- 3. The result of running the `SgM a` action singLetDecEnv (LetDecEnv { lde_defns = defns , lde_types = types , lde_infix = infix_decls , lde_proms = proms , lde_bound_kvs = bound_kvs }) thing_inside = do let prom_list = Map.toList proms (typeSigs, letBinds, tyvarNames, cxts, res_kis, singIDefunss) <- unzip6 <$> mapM (uncurry (singTySig defns types bound_kvs)) prom_list infix_decls' <- traverse (uncurry singInfixDecl) $ Map.toList infix_decls let res_ki_map = Map.fromList [ (name, res_ki) | ((name, _), Just res_ki) <- zip prom_list res_kis ] bindLets letBinds $ do let_decs <- mapM (uncurry (singLetDecRHS (Map.fromList tyvarNames) (Map.fromList cxts) res_ki_map)) (Map.toList defns) thing <- thing_inside return (infix_decls' ++ typeSigs ++ let_decs, concat singIDefunss, thing) singTySig :: Map Name ALetDecRHS -- definitions -> Map Name DType -- type signatures -> Map Name (Set Name) -- bound kind variables -> Name -> DType -- the type is the promoted type, not the type sig! -> SgM ( DLetDec -- the new type signature , (Name, DExp) -- the let-bind entry , (Name, [Name]) -- the scoped tyvar names in the tysig , (Name, DCxt) -- the context of the type signature , Maybe DKind -- the result kind in the tysig , [DDec] -- SingI instances for defun symbols ) singTySig defns types bound_kvs name prom_ty = let sName = singValName name in case Map.lookup name types of Nothing -> do num_args <- guess_num_args (sty, tyvar_names) <- mk_sing_ty num_args singIDefuns <- singDefuns name VarName [] (map (const Nothing) tyvar_names) Nothing return ( DSigD sName sty , (name, wrapSingFun num_args prom_ty (DVarE sName)) , (name, tyvar_names) , (name, []) , Nothing , singIDefuns ) Just ty -> do all_bound_kvs <- lookup_bound_kvs (sty, num_args, tyvar_names, ctxt, arg_kis, res_ki) <- singType all_bound_kvs prom_ty ty bound_cxt <- askContext singIDefuns <- singDefuns name VarName (bound_cxt ++ ctxt) (map Just arg_kis) (Just res_ki) return ( DSigD sName sty , (name, wrapSingFun num_args prom_ty (DVarE sName)) , (name, tyvar_names) , (name, ctxt) , Just res_ki , singIDefuns ) where guess_num_args :: SgM Int guess_num_args = case Map.lookup name defns of Nothing -> fail "Internal error: promotion known for something not let-bound." Just (AValue _ n _) -> return n Just (AFunction _ n _) -> return n lookup_bound_kvs :: SgM (Set Name) lookup_bound_kvs = case Map.lookup name bound_kvs of Nothing -> fail $ "Internal error: " ++ nameBase name ++ " has no type variable " ++ "bindings, despite having a type signature" Just kvs -> pure kvs -- create a Sing t1 -> Sing t2 -> ... type of a given arity and result type mk_sing_ty :: Int -> SgM (DType, [Name]) mk_sing_ty n = do arg_names <- replicateM n (qNewName "arg") return ( DForallT (map DPlainTV arg_names) [] (ravel (map (\nm -> singFamily `DAppT` DVarT nm) arg_names) (singFamily `DAppT` (foldl apply prom_ty (map DVarT arg_names)))) , arg_names ) singLetDecRHS :: Map Name [Name] -> Map Name DCxt -- the context of the type signature -- (might not be known) -> Map Name DKind -- result kind (might not be known) -> Name -> ALetDecRHS -> SgM DLetDec singLetDecRHS bound_names cxts res_kis name ld_rhs = bindContext (Map.findWithDefault [] name cxts) $ case ld_rhs of AValue prom num_arrows exp -> DValD (DVarPa (singValName name)) <$> (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis)) AFunction prom_fun num_arrows clauses -> let tyvar_names = case Map.lookup name bound_names of Nothing -> [] Just ns -> ns res_ki = Map.lookup name res_kis in DFunD (singValName name) <$> mapM (singClause prom_fun num_arrows tyvar_names res_ki) clauses singClause :: DType -- the promoted function -> Int -- the number of arrows in the type. If this is more -- than the number of patterns, we need to eta-expand -- with unSingFun. -> [Name] -- the names of the forall'd vars in the type sig of this -- function. This list should have at least the length as the -- number of patterns in the clause -> Maybe DKind -- result kind, if known -> ADClause -> SgM DClause singClause prom_fun num_arrows bound_names res_ki (ADClause var_proms pats exp) = do -- Fix #166: when (num_arrows - length pats < 0) $ fail $ "Function being promoted to " ++ (pprint (typeToTH prom_fun)) ++ " has too many arguments." (sPats, sigPaExpsSigs) <- evalForPair $ mapM (singPat (Map.fromList var_proms)) pats sBody <- singExp exp res_ki -- when calling unSingFun, the promoted pats aren't in scope, so we use the -- bound_names instead let pattern_bound_names = zipWith const bound_names pats -- this does eta-expansion. See comment at top of file. sBody' = wrapUnSingFun (num_arrows - length pats) (foldl apply prom_fun (map DVarT pattern_bound_names)) sBody return $ DClause sPats $ mkSigPaCaseE sigPaExpsSigs sBody' singPat :: Map Name Name -- from term-level names to type-level names -> ADPat -> QWithAux SingDSigPaInfos SgM DPat singPat var_proms = go where go :: ADPat -> QWithAux SingDSigPaInfos SgM DPat go (ADLitPa _lit) = fail "Singling of literal patterns not yet supported" go (ADVarPa name) = do tyname <- case Map.lookup name var_proms of Nothing -> fail "Internal error: unknown variable when singling pattern" Just tyname -> return tyname pure $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname) go (ADConPa name pats) = DConPa (singDataConName name) <$> mapM go pats go (ADTildePa pat) = do qReportWarning "Lazy pattern converted into regular pattern during singleton generation." go pat go (ADBangPa pat) = DBangPa <$> go pat go (ADSigPa prom_pat pat ty) = do pat' <- go pat -- Normally, calling dPatToDExp would be dangerous, since it fails if the -- supplied pattern contains any wildcard patterns. However, promotePat -- (which produced the pattern we're passing into dPatToDExp) maintains -- an invariant that any promoted pattern signatures will be free of -- wildcard patterns in the underlying pattern. -- See Note [Singling pattern signatures]. addElement (dPatToDExp pat', DSigT prom_pat ty) pure pat' go ADWildPa = pure DWildPa -- | If given a non-empty list of 'SingDSigPaInfos', construct a case expression -- that brings singleton equality constraints into scope via pattern-matching. -- See @Note [Singling pattern signatures]@. mkSigPaCaseE :: SingDSigPaInfos -> DExp -> DExp mkSigPaCaseE exps_with_sigs exp | null exps_with_sigs = exp | otherwise = let (exps, sigs) = unzip exps_with_sigs scrutinee = mkTupleDExp exps pats = map (DSigPa DWildPa . DAppT (DConT singFamilyName)) sigs in DCaseE scrutinee [DMatch (mkTupleDPat pats) exp] -- Note [Annotate case return type] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- -- We're straining GHC's type inference here. One particular trouble area -- is determining the return type of a GADT pattern match. In general, GHC -- cannot infer return types of GADT pattern matches because the return type -- becomes "untouchable" in the case matches. See the OutsideIn paper. But, -- during singletonization, we *know* the return type. So, just add a type -- annotation. See #54. -- Note [Why error is so special] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Some of the transformations that happen before this point produce impossible -- case matches. We must be careful when processing these so as not to make -- an error GHC will complain about. When binding the case-match variables, we -- normally include an equality constraint saying that the scrutinee is equal -- to the matched pattern. But, we can't do this in inaccessible matches, because -- equality is bogus, and GHC (rightly) complains. However, we then have another -- problem, because GHC doesn't have enough information when type-checking the -- RHS of the inaccessible match to deem it type-safe. The solution: treat error -- as super-special, so that GHC doesn't look too hard at singletonized error -- calls. Specifically, DON'T do the applySing stuff. Just use sError, which -- has a custom type (Sing x -> a) anyway. -- Note [Singling pattern signatures] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We want to single a pattern signature, like so: -- -- f :: Maybe a -> a -- f (Just x :: Maybe a) = x -- -- Naïvely, one might expect this to single straightfowardly as: -- -- sF :: forall (z :: Maybe a). Sing z -> Sing (F z) -- sF (SJust sX :: Sing (Just x :: Maybe a)) = sX -- -- But the way GHC typechecks patterns prevents this from working, as GHC won't -- know that the type `z` is actually `Just x` until /after/ the entirety of -- the `SJust sX` pattern has been typechecked. (See Trac #12018 for an -- extended discussion on this topic.) -- -- To work around this design, we resort to a somewhat unsightly trick: -- immediately after matching on all the patterns, we perform a case on every -- pattern with a pattern signature, like so: -- -- sF :: forall (z :: Maybe a). Sing z -> Sing (F z) -- sF (SJust sX :: Sing z) -- = case (SJust sX :: Sing z) of -- (_ :: Sing (Just x :: Maybe a)) -> sX -- -- Now GHC accepts the fact that `z` is `Just x`, and all is well. In order -- to support this construction, the type of singPat is augmented with some -- extra information in the form of SingDSigPaInfos: -- -- type SingDSigPaInfos = [(DExp, DType)] -- -- Where the DExps corresponds to the expressions we case on just after the -- patterns (`SJust sX :: Sing x`, in the example above), and the DTypes -- correspond to the singled pattern signatures to use in the case alternative -- (`Sing (Just x :: Maybe a)` in the example above). singPat appends to the -- list of SingDSigPaInfos whenever it processes a DSigPa (pattern signature), -- and call sites can pass these SingDSigPaInfos to mkSigPaCaseE to construct a -- case expression like the one featured above. -- -- Some interesting consequences of this design: -- -- 1. We must promote DPats to ADPats, a variation of DPat where the annotated -- DSigPa counterpart, ADSigPa, stores the type that the original DPat was -- promoted to. This is necessary since promoting the type might have -- generated fresh variable names, so we need to be able to use the same -- names when singling. -- -- 2. Also when promoting a DSigPa to an ADSigPa, we remove any wildcards from -- the underlying pattern. To see why this is necessary, consider singling -- this example: -- -- g (Just _ :: Maybe a) = "hi" -- -- This must single to something like this: -- -- sG (SJust _ :: Sing z) -- = case (SJust _ :: Sing z) of -- (_ :: Sing (Just _ :: Maybe a)) -> "hi" -- -- But `SJust _` is not a valid expression, and since the minimal th-desugar -- AST lacks as-patterns, we can't replace it with something like -- `sG x@(SJust _ :: Sing z) = case x of ...`. But even if the th-desugar -- AST /did/ have as-patterns, we'd still be in trouble, as `Just _` isn't -- a valid type without the use of -XPartialTypeSignatures, which isn't a -- design we want to force upon others. -- -- We work around both issues by simply converting all wildcard patterns -- from the pattern that has a signature. That means our example becomes: -- -- sG (SJust sWild :: Sing z) -- = case (SJust sWild :: Sing z) of -- (_ :: Sing (Just wild :: Maybe a)) -> "hi" -- -- And now everything is hunky-dory. singExp :: ADExp -> Maybe DKind -- the kind of the expression, if known -> SgM DExp -- See Note [Why error is so special] singExp (ADVarE err `ADAppE` arg) _res_ki | err == errorName = DAppE (DVarE (singValName err)) <$> singExp arg (Just (DConT symbolName)) singExp (ADVarE name) _res_ki = lookupVarE name singExp (ADConE name) _res_ki = lookupConE name singExp (ADLitE lit) _res_ki = singLit lit singExp (ADAppE e1 e2) _res_ki = do e1' <- singExp e1 Nothing e2' <- singExp e2 Nothing -- `applySing undefined x` kills type inference, because GHC can't figure -- out the type of `undefined`. So we don't emit `applySing` there. if isException e1' then return $ e1' `DAppE` e2' else return $ (DVarE applySingName) `DAppE` e1' `DAppE` e2' singExp (ADLamE ty_names prom_lam names exp) _res_ki = do let sNames = map singValName names exp' <- singExp exp Nothing -- we need to bind the type variables... but DLamE doesn't allow SigT patterns. -- So: build a case let caseExp = DCaseE (mkTupleDExp (map DVarE sNames)) [DMatch (mkTupleDPat (map ((DWildPa `DSigPa`) . (singFamily `DAppT`) . DVarT) ty_names)) exp'] return $ wrapSingFun (length names) prom_lam $ DLamE sNames caseExp singExp (ADCaseE exp matches ret_ty) res_ki = -- See Note [Annotate case return type] DSigE <$> (DCaseE <$> singExp exp Nothing <*> mapM (singMatch res_ki) matches) <*> pure (singFamily `DAppT` (ret_ty `maybeSigT` res_ki)) singExp (ADLetE env exp) res_ki = do -- We intentionally discard the SingI instances for exp's defunctionalization -- symbols, as we also do not generate the declarations for the -- defunctionalization symbols in the first place during promotion. (let_decs, _, exp') <- singLetDecEnv env $ singExp exp res_ki pure $ DLetE let_decs exp' singExp (ADSigE prom_exp exp ty) _ = do exp' <- singExp exp (Just ty) pure $ DSigE exp' $ DConT singFamilyName `DAppT` DSigT prom_exp ty -- See Note [DerivedDecl] singDerivedEqDecs :: DerivedEqDecl -> SgM [DDec] singDerivedEqDecs (DerivedDecl { ded_mb_cxt = mb_ctxt , ded_type = ty , ded_decl = DataDecl _ _ cons }) = do (scons, _) <- singM [] $ mapM singCtor cons mb_sctxt <- mapM (mapM singPred) mb_ctxt kind <- promoteType ty sEqInst <- mkEqualityInstance mb_sctxt kind cons scons sEqClassDesc -- Beware! The user might have specified an instance context like this: -- -- deriving instance Eq a => Eq (T a Int) -- -- When we single the context, it will become (SEq a). But we do *not* want -- this for the SDecide instance! The simplest solution is to simply replace -- all occurrences of SEq with SDecide in the context. let mb_sctxtDecide = fmap (map sEqToSDecide) mb_sctxt sDecideInst <- mkEqualityInstance mb_sctxtDecide kind cons scons sDecideClassDesc return [sEqInst, sDecideInst] -- Walk a DPred, replacing all occurrences of SEq with SDecide. sEqToSDecide :: DPred -> DPred sEqToSDecide = modifyConNameDPred $ \n -> -- Why don't we directly compare n to sEqClassName? Because n is almost certainly -- produced from a call to singClassName, which uses unqualified Names. Ugh. if nameBase n == nameBase sEqClassName then sDecideClassName else n -- See Note [DerivedDecl] singDerivedShowDecs :: DerivedShowDecl -> SgM [DDec] singDerivedShowDecs (DerivedDecl { ded_mb_cxt = mb_cxt , ded_type = ty , ded_decl = DataDecl _ _ cons }) = do z <- qNewName "z" -- Derive the Show instance for the singleton type, like this: -- -- deriving instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b)) -- -- Be careful: we want to generate an instance context that uses ShowSing, -- not SShow. show_cxt <- inferConstraintsDef (fmap mkShowSingContext mb_cxt) (DConPr showSingName) ty cons let show_inst = DStandaloneDerivD Nothing show_cxt (DConT showName `DAppT` (singFamily `DAppT` DSigT (DVarT z) ty)) pure [show_inst] isException :: DExp -> Bool isException (DVarE n) = nameBase n == "sUndefined" isException (DConE {}) = False isException (DLitE {}) = False isException (DAppE (DVarE fun) _) | nameBase fun == "sError" = True isException (DAppE fun _) = isException fun isException (DAppTypeE e _) = isException e isException (DLamE _ _) = False isException (DCaseE e _) = isException e isException (DLetE _ e) = isException e isException (DSigE e _) = isException e isException (DStaticE e) = isException e singMatch :: Maybe DKind -- ^ the result kind, if known -> ADMatch -> SgM DMatch singMatch res_ki (ADMatch var_proms pat exp) = do (sPat, sigPaExpsSigs) <- evalForPair $ singPat (Map.fromList var_proms) pat sExp <- singExp exp res_ki return $ DMatch sPat $ mkSigPaCaseE sigPaExpsSigs sExp singLit :: Lit -> SgM DExp singLit (IntegerL n) | n >= 0 = return $ DVarE sFromIntegerName `DAppE` (DVarE singMethName `DSigE` (singFamily `DAppT` DLitT (NumTyLit n))) | otherwise = do sLit <- singLit (IntegerL (-n)) return $ DVarE sNegateName `DAppE` sLit singLit (StringL str) = do let sing_str_lit = DVarE singMethName `DSigE` (singFamily `DAppT` DLitT (StrTyLit str)) os_enabled <- qIsExtEnabled LangExt.OverloadedStrings pure $ if os_enabled then DVarE sFromStringName `DAppE` sing_str_lit else sing_str_lit singLit lit = fail ("Only string and natural number literals can be singled: " ++ show lit) maybeSigT :: DType -> Maybe DKind -> DType maybeSigT ty Nothing = ty maybeSigT ty (Just ki) = ty `DSigT` ki singletons-2.5.1/src/Data/Singletons/Single/0000755000000000000000000000000007346545000017103 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/Single/Data.hs0000644000000000000000000001660107346545000020314 0ustar0000000000000000{- Data/Singletons/Single/Data.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu Singletonizes constructors. -} {-# LANGUAGE ParallelListComp, TupleSections, LambdaCase #-} module Data.Singletons.Single.Data where import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax import Data.Singletons.Single.Defun import Data.Singletons.Single.Monad import Data.Singletons.Single.Type import Data.Singletons.Single.Fixity import Data.Singletons.Promote.Type import Data.Singletons.Util import Data.Singletons.Names import Data.Singletons.Syntax import Control.Monad import qualified Data.Set as Set import Data.Set (Set) -- We wish to consider the promotion of "Rep" to be * -- not a promoted data constructor. singDataD :: DataDecl -> SgM [DDec] singDataD (DataDecl name tvbs ctors) = do let tvbNames = map extractTvbName tvbs k <- promoteType (foldType (DConT name) (map DVarT tvbNames)) ctors' <- mapM singCtor ctors ctorFixities <- -- try to reify the fixity declarations for the constructors and then -- singletonize them. In case the reification fails, we default to an -- empty list of singletonized fixity declarations. -- why this works: -- 1. if we're in a call to 'genSingletons', the data type was defined -- earlier and its constructors are in scope, the reification succeeds. -- 2. if we're in a call to 'singletons', the reification will fail, but -- the fixity declaration will get singletonized by itself (not from -- here, look for other invocations of 'singInfixDecl') singFixityDeclarations [ n | DCon _ _ n _ _ <- ctors ] -- instance for SingKind fromSingClauses <- mapM mkFromSingClause ctors emptyFromSingClause <- mkEmptyFromSingClause toSingClauses <- mapM mkToSingClause ctors emptyToSingClause <- mkEmptyToSingClause let singKindInst = DInstanceD Nothing (map (singKindConstraint . DVarT) tvbNames) (DAppT (DConT singKindClassName) k) [ DTySynInstD demoteName $ DTySynEqn [k] (foldType (DConT name) (map (DAppT demote . DVarT) tvbNames)) , DLetDec $ DFunD fromSingName (fromSingClauses `orIfEmpty` [emptyFromSingClause]) , DLetDec $ DFunD toSingName (toSingClauses `orIfEmpty` [emptyToSingClause]) ] -- e.g. type SNat = (Sing :: Nat -> Type) let kindedSingTy = DArrowT `DAppT` k `DAppT` DConT typeKindName kindedSynInst = DTySynD (singTyConName name) [] (singFamily `DSigT` kindedSingTy) return $ (DDataInstD Data [] singFamilyName [] (Just kindedSingTy) ctors' []) : kindedSynInst : singKindInst : ctorFixities where -- in the Rep case, the names of the constructors are in the wrong scope -- (they're types, not datacons), so we have to reinterpret them. mkConName :: Name -> SgM Name mkConName | nameBase name == nameBase repName = mkDataName . nameBase | otherwise = return mkFromSingClause :: DCon -> SgM DClause mkFromSingClause c = do let (cname, numArgs) = extractNameArgs c cname' <- mkConName cname varNames <- replicateM numArgs (qNewName "b") return $ DClause [DConPa (singDataConName cname) (map DVarPa varNames)] (foldExp (DConE cname') (map (DAppE (DVarE fromSingName) . DVarE) varNames)) mkToSingClause :: DCon -> SgM DClause mkToSingClause (DCon _tvbs _cxt cname fields _rty) = do let types = tysOfConFields fields varNames <- mapM (const $ qNewName "b") types svarNames <- mapM (const $ qNewName "c") types promoted <- mapM promoteType types cname' <- mkConName cname let varPats = zipWith mkToSingVarPat varNames promoted recursiveCalls = zipWith mkRecursiveCall varNames promoted return $ DClause [DConPa cname' varPats] (multiCase recursiveCalls (map (DConPa someSingDataName . listify . DVarPa) svarNames) (DAppE (DConE someSingDataName) (foldExp (DConE (singDataConName cname)) (map DVarE svarNames)))) mkToSingVarPat :: Name -> DKind -> DPat mkToSingVarPat varName ki = DSigPa (DVarPa varName) (DAppT (DConT demoteName) ki) mkRecursiveCall :: Name -> DKind -> DExp mkRecursiveCall var_name ki = DSigE (DAppE (DVarE toSingName) (DVarE var_name)) (DAppT (DConT someSingTypeName) ki) mkEmptyFromSingClause :: SgM DClause mkEmptyFromSingClause = do x <- qNewName "x" pure $ DClause [DVarPa x] $ DCaseE (DVarE x) [] mkEmptyToSingClause :: SgM DClause mkEmptyToSingClause = do x <- qNewName "x" pure $ DClause [DVarPa x] $ DConE someSingDataName `DAppE` DCaseE (DVarE x) [] -- refine a constructor. singCtor :: DCon -> SgM DCon -- polymorphic constructors are handled just -- like monomorphic ones -- the polymorphism in -- the kind is automatic singCtor (DCon _tvbs cxt name fields rty) | not (null cxt) = fail "Singling of constrained constructors not yet supported" | otherwise = do let types = tysOfConFields fields sName = singDataConName name sCon = DConE sName pCon = DConT name indexNames <- mapM (const $ qNewName "n") types let indices = map DVarT indexNames kinds <- mapM promoteType types let bound_kvs = foldMap fvDType kinds args <- zipWithM (buildArgType bound_kvs) types indices rty' <- promoteType rty let tvbs = map DPlainTV (Set.toList bound_kvs) ++ zipWith DKindedTV indexNames kinds kindedIndices = zipWith DSigT indices kinds -- SingI instance for data constructor emitDecs [DInstanceD Nothing (map (DAppPr (DConPr singIName)) indices) (DAppT (DConT singIName) (foldType pCon kindedIndices)) [DLetDec $ DValD (DVarPa singMethName) (foldExp sCon (map (const $ DVarE singMethName) types))]] -- SingI instances for defunctionalization symbols. Note that we don't -- support contexts in constructors at the moment, so it's fine for now to -- just assume that the context is always (). emitDecs =<< singDefuns name DataName [] (map Just kinds) (Just rty') let noBang = Bang NoSourceUnpackedness NoSourceStrictness conFields = case fields of DNormalC dInfix _ -> DNormalC dInfix $ map (noBang,) args DRecC rec_fields -> DRecC [ (singValName field_name, noBang, arg) | (field_name, _, _) <- rec_fields | arg <- args ] return $ DCon tvbs [] sName conFields (DConT singFamilyName `DAppT` foldType pCon indices) where buildArgType :: Set Name -> DType -> DType -> SgM DType buildArgType bound_kvs ty index = do (ty', _, _, _, _, _) <- singType bound_kvs index ty return ty' singletons-2.5.1/src/Data/Singletons/Single/Defun.hs0000644000000000000000000002021107346545000020474 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.Single.Defun -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Creates 'SingI' instances for promoted types' defunctionalization symbols. -- ----------------------------------------------------------------------------- module Data.Singletons.Single.Defun (singDefuns) where import Data.List import Data.Singletons.Names import Data.Singletons.Promote.Defun import Data.Singletons.Single.Monad import Data.Singletons.Single.Type import Data.Singletons.Util import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax -- Given the Name of something, take the defunctionalization symbols for its -- promoted counterpart and create SingI instances for them. As a concrete -- example, if you have: -- -- foo :: Eq a => a -> a -> Bool -- -- Then foo's promoted counterpart, Foo, will have two defunctionalization -- symbols: -- -- FooSym0 :: a ~> a ~> Bool -- FooSym1 :: a -> a ~> Bool -- -- We can declare SingI instances for these two symbols like so: -- -- instance SEq a => SingI (FooSym0 :: a ~> a ~> Bool) where -- sing = singFun2 sFoo -- -- instance (SEq a, SingI x) => SingI (FooSym1 x :: a ~> Bool) where -- sing = singFun1 (sFoo (sing @_ @x)) -- -- Note that singDefuns takes Maybe DKinds for the promoted argument and result -- types, in case we have an entity whose type needs to be inferred. -- See Note [singDefuns and type inference]. -- -- Note that in the particular case of a data constructor, we actually generate -- /two/ SingI instances partial application—one for the defunctionalization -- symbol, and one for the data constructor placed inside TyCon{N}. -- See Note [SingI instances for partially applied constructors]. singDefuns :: Name -- The Name of the thing to promote. -> NameSpace -- Whether the above Name is a value, data constructor, -- or a type constructor. -- See Note [SingI instances for partially applied constructors] -> DCxt -- The type's context. -> [Maybe DKind] -- The promoted argument types (if known). -> Maybe DKind -- The promoted result type (if known). -> SgM [DDec] singDefuns n ns ty_ctxt mb_ty_args mb_ty_res = case mb_ty_args of [] -> pure [] -- If a function has no arguments, then it has no -- defunctionalization symbols, so there's nothing to be done. _ -> do sty_ctxt <- mapM singPred ty_ctxt go 0 sty_ctxt [] mb_ty_args where num_ty_args :: Int num_ty_args = length mb_ty_args -- Sadly, this algorithm is quadratic, because in each iteration of the loop -- we must: -- -- * Construct an arrow type of the form (a ~> ... ~> z), using a suffix of -- the promoted argument types. -- * Append a new type variable to the end of an ordered list. -- -- In practice, this is unlikely to be a bottleneck, as singletons does not -- support functions with more than 7 or so arguments anyways. go :: Int -> DCxt -> [DTyVarBndr] -> [Maybe DKind] -> SgM [DDec] go sym_num sty_ctxt tvbs mb_tyss | sym_num < num_ty_args , mb_ty:mb_tys <- mb_tyss = do new_tvb_name <- qNewName "d" let new_tvb = inferMaybeKindTV new_tvb_name mb_ty insts <- go (sym_num + 1) sty_ctxt (tvbs ++ [new_tvb]) mb_tys pure $ new_insts ++ insts | otherwise = pure [] where sing_fun_num :: Int sing_fun_num = num_ty_args - sym_num mk_sing_fun_expr :: DExp -> DExp mk_sing_fun_expr sing_expr = foldl' (\f tvb_n -> f `DAppE` (DVarE singMethName `DAppTypeE` DVarT tvb_n)) sing_expr (map extractTvbName tvbs) singI_ctxt :: DCxt singI_ctxt = map (DAppPr (DConPr singIName) . tvbToType) tvbs mk_inst_ty :: DType -> DType mk_inst_ty inst_head = case mb_inst_kind of Just inst_kind -> inst_head `DSigT` inst_kind Nothing -> inst_head tvb_tys :: [DType] tvb_tys = map dTyVarBndrToDType tvbs -- Construct the arrow kind used to annotate the defunctionalization -- symbol (e.g., the `a ~> a ~> Bool` in -- `SingI (FooSym0 :: a ~> a ~> Bool)`). -- If any of the argument kinds or result kind isn't known (i.e., is -- Nothing), then we opt not to construct this arrow kind altogether. -- See Note [singDefuns and type inference] mb_inst_kind :: Maybe DType mb_inst_kind = foldr buildTyFunArrow_maybe mb_ty_res mb_tyss new_insts :: [DDec] new_insts | DataName <- ns = -- See Note [SingI instances for partially applied constructors] let s_data_con = DConE $ singDataConName n in [ mk_inst defun_inst_ty s_data_con , mk_inst tycon_inst_ty s_data_con ] | otherwise = [mk_inst defun_inst_ty $ DVarE $ singValName n] where mk_inst :: DType -> DExp -> DDec mk_inst inst_head sing_exp = DInstanceD Nothing (sty_ctxt ++ singI_ctxt) (DConT singIName `DAppT` mk_inst_ty inst_head) [DLetDec $ DValD (DVarPa singMethName) $ wrapSingFun sing_fun_num inst_head $ mk_sing_fun_expr sing_exp ] defun_inst_ty, tycon_inst_ty :: DType defun_inst_ty = foldType (DConT (promoteTySym n sym_num)) tvb_tys tycon_inst_ty = DConT (mkTyConName sing_fun_num) `DAppT` foldType (DConT n) tvb_tys {- Note [singDefuns and type inference] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following function: foo :: a -> Bool foo _ = True singDefuns would give the following SingI instance for FooSym0, with an explicit kind signature: instance SingI (FooSym0 :: a ~> Bool) where ... What happens if we leave off the type signature for foo? foo _ = True Can singDefuns still do its job? Yes! It will simply generate: instance SingI FooSym0 where ... In general, if any of the promoted argument or result types given to singDefun are Nothing, then we avoid crafting an explicit kind signature. You might worry that this could lead to SingI instances being generated that GHC cannot infer the type for, such as: bar x = x == x ==> instance SingI BarSym0 -- Missing an SEq constraint? This is true, but also not unprecedented, as the singled version of bar, sBar, will /also/ fail to typecheck due to a missing SEq constraint. Therefore, this design choice fits within the existing tradition of type inference in singletons. Note [SingI instances for partially applied constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Unlike normal functions, where we generate one SingI instance for each of its partial applications (one per defunctionalization symbol), we generate *two* SingI instances for each partial application of a data constructor. That is, if we have: data D a where K :: a -> D a K has an partial application, so we will generate the following two SingI instances: instance SingI KSym0 where sing = singFun1 SK instance SingI (TyCon1 KSym0) where sing = singFun1 SK The first instance is exactly the same as what we'd generate for a normal, partially applied function's defun symbol. The second one, while functionally equivalent, is a bit dissatisfying: in general, adopting this approach means that we end up generating many instances of the form: instance SingI (TyCon1 S1) instance SingI (TyCon1 S2) ... Ideally, we'd have a single instance SingI (TyCon1 s) to rule them all. But doing so would require writing something akin to: instance (forall a. SingI a => SingI (f a)) => SingI (TyCon1 f) where sing = SLambda $ \(x :: Sing a) -> withSingI x $ sing @_ @(f a) But this would require quantified constraints. Until GHC gains these, we compensate by generating out several SingI (TyCon1 s) instances. -} singletons-2.5.1/src/Data/Singletons/Single/Eq.hs0000644000000000000000000001132607346545000020007 0ustar0000000000000000{- Data/Singletons/Single/Eq.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu Defines functions to generate SEq and SDecide instances. -} module Data.Singletons.Single.Eq where import Language.Haskell.TH.Syntax import Language.Haskell.TH.Desugar import Data.Singletons.Deriving.Infer import Data.Singletons.Util import Data.Singletons.Names import Control.Monad -- making the SEq instance and the SDecide instance are rather similar, -- so we generalize type EqualityClassDesc q = ((DCon, DCon) -> q DClause, q DClause, Name, Name) sEqClassDesc, sDecideClassDesc :: Quasi q => EqualityClassDesc q sEqClassDesc = (mkEqMethClause, mkEmptyEqMethClause, sEqClassName, sEqMethName) sDecideClassDesc = (mkDecideMethClause, mkEmptyDecideMethClause, sDecideClassName, sDecideMethName) mkEqualityInstance :: DsMonad q => Maybe DCxt -> DKind -> [DCon] -- ^ The /original/ constructors (for inferring the instance context) -> [DCon] -- ^ The /singletons/ constructors -> EqualityClassDesc q -> q DDec mkEqualityInstance mb_ctxt k ctors sctors (mkMeth, mkEmpty, className, methName) = do let sctorPairs = [ (sc1, sc2) | sc1 <- sctors, sc2 <- sctors ] methClauses <- if null sctors then (:[]) <$> mkEmpty else mapM mkMeth sctorPairs constraints <- inferConstraintsDef mb_ctxt (DConPr className) k ctors return $ DInstanceD Nothing constraints (DAppT (DConT className) k) [DLetDec $ DFunD methName methClauses] mkEqMethClause :: Quasi q => (DCon, DCon) -> q DClause mkEqMethClause (c1, c2) | lname == rname = do lnames <- replicateM lNumArgs (qNewName "a") rnames <- replicateM lNumArgs (qNewName "b") let lpats = map DVarPa lnames rpats = map DVarPa rnames lvars = map DVarE lnames rvars = map DVarE rnames return $ DClause [DConPa lname lpats, DConPa rname rpats] (allExp (zipWith (\l r -> foldExp (DVarE sEqMethName) [l, r]) lvars rvars)) | otherwise = return $ DClause [DConPa lname (replicate lNumArgs DWildPa), DConPa rname (replicate rNumArgs DWildPa)] (DConE $ singDataConName falseName) where allExp :: [DExp] -> DExp allExp [] = DConE $ singDataConName trueName allExp [one] = one allExp (h:t) = DAppE (DAppE (DVarE $ singValName andName) h) (allExp t) (lname, lNumArgs) = extractNameArgs c1 (rname, rNumArgs) = extractNameArgs c2 mkEmptyEqMethClause :: Applicative q => q DClause mkEmptyEqMethClause = pure $ DClause [DWildPa, DWildPa] $ DConE strueName mkDecideMethClause :: Quasi q => (DCon, DCon) -> q DClause mkDecideMethClause (c1, c2) | lname == rname = if lNumArgs == 0 then return $ DClause [DConPa lname [], DConPa rname []] (DAppE (DConE provedName) (DConE reflName)) else do lnames <- replicateM lNumArgs (qNewName "a") rnames <- replicateM lNumArgs (qNewName "b") contra <- qNewName "contra" let lpats = map DVarPa lnames rpats = map DVarPa rnames lvars = map DVarE lnames rvars = map DVarE rnames refl <- qNewName "refl" return $ DClause [DConPa lname lpats, DConPa rname rpats] (DCaseE (mkTupleDExp $ zipWith (\l r -> foldExp (DVarE sDecideMethName) [l, r]) lvars rvars) ((DMatch (mkTupleDPat (replicate lNumArgs (DConPa provedName [DConPa reflName []]))) (DAppE (DConE provedName) (DConE reflName))) : [DMatch (mkTupleDPat (replicate i DWildPa ++ DConPa disprovedName [DVarPa contra] : replicate (lNumArgs - i - 1) DWildPa)) (DAppE (DConE disprovedName) (DLamE [refl] $ DCaseE (DVarE refl) [DMatch (DConPa reflName []) $ (DAppE (DVarE contra) (DConE reflName))])) | i <- [0..lNumArgs-1] ])) | otherwise = do x <- qNewName "x" return $ DClause [DConPa lname (replicate lNumArgs DWildPa), DConPa rname (replicate rNumArgs DWildPa)] (DAppE (DConE disprovedName) (DLamE [x] (DCaseE (DVarE x) []))) where (lname, lNumArgs) = extractNameArgs c1 (rname, rNumArgs) = extractNameArgs c2 mkEmptyDecideMethClause :: Quasi q => q DClause mkEmptyDecideMethClause = do x <- qNewName "x" pure $ DClause [DVarPa x, DWildPa] $ DConE provedName `DAppE` DCaseE (DVarE x) [] singletons-2.5.1/src/Data/Singletons/Single/Fixity.hs0000644000000000000000000000223407346545000020714 0ustar0000000000000000module Data.Singletons.Single.Fixity where import Prelude hiding ( exp ) import Language.Haskell.TH hiding ( cxt ) import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..)) import Data.Singletons.Util import Data.Singletons.Names import Language.Haskell.TH.Desugar singInfixDecl :: DsMonad q => Name -> Fixity -> q DLetDec singInfixDecl name fixity = do mb_ns <- reifyNameSpace name pure $ DInfixD fixity $ case mb_ns of Just TcClsName -> singTyConName name Just DataName -> singDataConName name Just VarName -> singValName name -- If we can't find the Name for some odd reason, -- fall back to singValName Nothing -> singValName name singFixityDeclaration :: DsMonad q => Name -> q [DDec] singFixityDeclaration name = do mFixity <- qReifyFixity name case mFixity of Nothing -> pure [] Just fixity -> sequenceA [DLetDec <$> singInfixDecl name fixity] singFixityDeclarations :: DsMonad q => [Name] -> q [DDec] singFixityDeclarations = concatMapM trySingFixityDeclaration where trySingFixityDeclaration name = qRecover (return []) (singFixityDeclaration name) singletons-2.5.1/src/Data/Singletons/Single/Monad.hs0000644000000000000000000001654207346545000020505 0ustar0000000000000000{- Data/Singletons/Single/Monad.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu This file defines the SgM monad and its operations, for use during singling. The SgM monad allows reading from a SgEnv environment and is wrapped around a Q. -} {-# LANGUAGE GeneralizedNewtypeDeriving, ParallelListComp, TemplateHaskell #-} module Data.Singletons.Single.Monad ( SgM, bindLets, bindContext, askContext, lookupVarE, lookupConE, wrapSingFun, wrapUnSingFun, singM, singDecsM, emitDecs, emitDecsM ) where import Prelude hiding ( exp ) import Data.Map ( Map ) import qualified Data.Map as Map import Data.Singletons.Promote.Monad ( emitDecs, emitDecsM ) import Data.Singletons.Names import Data.Singletons.Util import Data.Singletons.Internal import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar import Control.Monad.Reader import Control.Monad.Writer import Control.Applicative import Control.Monad.Fail -- environment during singling data SgEnv = SgEnv { sg_let_binds :: Map Name DExp -- from the *original* name , sg_context :: DCxt -- See Note [Tracking the current type signature context] , sg_local_decls :: [Dec] } emptySgEnv :: SgEnv emptySgEnv = SgEnv { sg_let_binds = Map.empty , sg_context = [] , sg_local_decls = [] } -- the singling monad newtype SgM a = SgM (ReaderT SgEnv (WriterT [DDec] Q) a) deriving ( Functor, Applicative, Monad , MonadReader SgEnv, MonadWriter [DDec] , MonadFail, MonadIO ) liftSgM :: Q a -> SgM a liftSgM = SgM . lift . lift instance Quasi SgM where qNewName = liftSgM `comp1` qNewName qReport = liftSgM `comp2` qReport qLookupName = liftSgM `comp2` qLookupName qReify = liftSgM `comp1` qReify qReifyInstances = liftSgM `comp2` qReifyInstances qLocation = liftSgM qLocation qRunIO = liftSgM `comp1` qRunIO qAddDependentFile = liftSgM `comp1` qAddDependentFile qReifyRoles = liftSgM `comp1` qReifyRoles qReifyAnnotations = liftSgM `comp1` qReifyAnnotations qReifyModule = liftSgM `comp1` qReifyModule qAddTopDecls = liftSgM `comp1` qAddTopDecls qAddModFinalizer = liftSgM `comp1` qAddModFinalizer qGetQ = liftSgM qGetQ qPutQ = liftSgM `comp1` qPutQ qReifyFixity = liftSgM `comp1` qReifyFixity qReifyConStrictness = liftSgM `comp1` qReifyConStrictness qIsExtEnabled = liftSgM `comp1` qIsExtEnabled qExtsEnabled = liftSgM qExtsEnabled qAddForeignFilePath = liftSgM `comp2` qAddForeignFilePath qAddTempFile = liftSgM `comp1` qAddTempFile qAddCorePlugin = liftSgM `comp1` qAddCorePlugin qRecover (SgM handler) (SgM body) = do env <- ask (result, aux) <- liftSgM $ qRecover (runWriterT $ runReaderT handler env) (runWriterT $ runReaderT body env) tell aux return result instance DsMonad SgM where localDeclarations = asks sg_local_decls bindLets :: [(Name, DExp)] -> SgM a -> SgM a bindLets lets1 = local (\env@(SgEnv { sg_let_binds = lets2 }) -> env { sg_let_binds = (Map.fromList lets1) `Map.union` lets2 }) -- Add some constraints to the current type signature context. -- See Note [Tracking the current type signature context] bindContext :: DCxt -> SgM a -> SgM a bindContext ctxt1 = local (\env@(SgEnv { sg_context = ctxt2 }) -> env { sg_context = ctxt1 ++ ctxt2 }) -- Retrieve the current type signature context. -- See Note [Tracking the current type signature context] askContext :: SgM DCxt askContext = asks sg_context lookupVarE :: Name -> SgM DExp lookupVarE = lookup_var_con singValName (DVarE . singValName) lookupConE :: Name -> SgM DExp lookupConE = lookup_var_con singDataConName (DConE . singDataConName) lookup_var_con :: (Name -> Name) -> (Name -> DExp) -> Name -> SgM DExp lookup_var_con mk_sing_name mk_exp name = do letExpansions <- asks sg_let_binds sName <- mkDataName (nameBase (mk_sing_name name)) -- we want *term* names! case Map.lookup name letExpansions of Nothing -> do -- try to get it from the global context m_dinfo <- liftM2 (<|>) (dsReify sName) (dsReify name) -- try the unrefined name too -- it's needed to bootstrap Enum case m_dinfo of Just (DVarI _ ty _) -> let num_args = countArgs ty in return $ wrapSingFun num_args (promoteValRhs name) (mk_exp name) _ -> return $ mk_exp name -- lambda-bound Just exp -> return exp wrapSingFun :: Int -> DType -> DExp -> DExp wrapSingFun 0 _ = id wrapSingFun n ty = let wrap_fun = DVarE $ case n of 1 -> 'singFun1 2 -> 'singFun2 3 -> 'singFun3 4 -> 'singFun4 5 -> 'singFun5 6 -> 'singFun6 7 -> 'singFun7 _ -> error "No support for functions of arity > 7." in (wrap_fun `DAppTypeE` ty `DAppE`) wrapUnSingFun :: Int -> DType -> DExp -> DExp wrapUnSingFun 0 _ = id wrapUnSingFun n ty = let unwrap_fun = DVarE $ case n of 1 -> 'unSingFun1 2 -> 'unSingFun2 3 -> 'unSingFun3 4 -> 'unSingFun4 5 -> 'unSingFun5 6 -> 'unSingFun6 7 -> 'unSingFun7 _ -> error "No support for functions of arity > 7." in (unwrap_fun `DAppTypeE` ty `DAppE`) singM :: DsMonad q => [Dec] -> SgM a -> q (a, [DDec]) singM locals (SgM rdr) = do other_locals <- localDeclarations let wr = runReaderT rdr (emptySgEnv { sg_local_decls = other_locals ++ locals }) q = runWriterT wr runQ q singDecsM :: DsMonad q => [Dec] -> SgM [DDec] -> q [DDec] singDecsM locals thing = do (decs1, decs2) <- singM locals thing return $ decs1 ++ decs2 {- Note [Tracking the current type signature context] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Much like we track the let-bound names in scope, we also track the current context. For instance, in the following program: -- (1) f :: forall a. Show a => a -> String -> Bool f x y = g (show x) y where -- (2) g :: forall b. Eq b => b -> b -> Bool g = h where -- (3) h :: b -> b -> Bool h = (==) Here is the context at various points: (1) () (2) (Show a) (3) (Show a, Eq b) We track this informating during singling instead of during promotion, as the promoted versions of things are often type families, which do not have contexts. Why do we bother tracking this at all? Ultimately, because singDefuns (from Data.Singletons.Single.Defun) needs to know the current context in order to generate a correctly typed SingI instance. For instance, if you called singDefuns on the class method bar: class Foo a where bar :: Eq a => a -> Bool Then if you only grabbed the context of `bar` itself, then you'd end up generating the following SingI instance for BarSym0: instance SEq a => SingI (FooSym0 :: a ~> Bool) where ... Which is incorrect—there needs to be an (SFoo a) constraint as well! If we track the current context when singling Foo, then we will correctly propagate this information to singDefuns. -} singletons-2.5.1/src/Data/Singletons/Single/Type.hs0000644000000000000000000000545507346545000020371 0ustar0000000000000000{- Data/Singletons/Single/Type.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu Singletonizes types. -} module Data.Singletons.Single.Type where import Language.Haskell.TH.Desugar import Language.Haskell.TH.Syntax import Data.Singletons.Names import Data.Singletons.Single.Monad import Data.Singletons.Promote.Type import Data.Singletons.Util import Control.Monad import qualified Data.Set as Set import Data.Set (Set) singType :: Set Name -- the set of bound kind variables in this scope -- see Note [Explicitly binding kind variables] -- in Data.Singletons.Promote.Monad -> DType -- the promoted version of the thing classified by... -> DType -- ... this type -> SgM ( DType -- the singletonized type , Int -- the number of arguments , [Name] -- the names of the tyvars used in the sing'd type , DCxt -- the context of the singletonized type , [DKind] -- the kinds of the argument types , DKind ) -- the kind of the result type singType bound_kvs prom ty = do let (_, cxt, args, res) = unravel ty num_args = length args cxt' <- mapM singPred cxt arg_names <- replicateM num_args (qNewName "t") prom_args <- mapM promoteType args prom_res <- promoteType res let args' = map (\n -> singFamily `DAppT` (DVarT n)) arg_names res' = singFamily `DAppT` (foldl apply prom (map DVarT arg_names) `DSigT` prom_res) tau = ravel args' res' -- Make sure to subtract out the bound variables currently in scope, lest we -- accidentally shadow them in this type signature. kv_names_to_bind = foldMap fvDType (prom_args ++ map predToType cxt' ++ [prom_res]) Set.\\ bound_kvs kvs_to_bind = Set.toList kv_names_to_bind let ty' = DForallT (map DPlainTV kvs_to_bind ++ zipWith DKindedTV arg_names prom_args) cxt' tau return (ty', num_args, arg_names, cxt, prom_args, prom_res) singPred :: DPred -> SgM DPred singPred = singPredRec [] singPredRec :: [DType] -> DPred -> SgM DPred singPredRec _cxt (DForallPr {}) = fail "Singling of quantified constraints not yet supported" singPredRec ctx (DAppPr pr ty) = singPredRec (ty : ctx) pr singPredRec _ctx (DSigPr _pr _ki) = fail "Singling of constraints with explicit kinds not yet supported" singPredRec _ctx (DVarPr _n) = fail "Singling of contraint variables not yet supported" singPredRec ctx (DConPr n) | n == equalityName = fail "Singling of type equality constraints not yet supported" | otherwise = do kis <- mapM promoteType ctx let sName = singClassName n return $ foldPred (DConPr sName) kis singPredRec _ctx DWildCardPr = return DWildCardPr -- it just might work singletons-2.5.1/src/Data/Singletons/SuppressUnusedWarnings.hs0000644000000000000000000000125007346545000022735 0ustar0000000000000000-- Data/Singletons/SuppressUnusedWarnings.hs -- -- (c) Richard Eisenberg 2014 -- rae@cs.brynmawr.edu -- -- This declares user-oriented exports that are actually meant to be hidden -- from the user. Why would anyone ever want this? Because what is below -- is dirty, and no one wants to see it. {-# LANGUAGE AllowAmbiguousTypes, PolyKinds #-} module Data.Singletons.SuppressUnusedWarnings where -- | This class (which users should never see) is to be instantiated in order -- to use an otherwise-unused data constructor, such as the "kind-inference" -- data constructor for defunctionalization symbols. class SuppressUnusedWarnings (t :: k) where suppressUnusedWarnings :: () singletons-2.5.1/src/Data/Singletons/Syntax.hs0000644000000000000000000002170707346545000017513 0ustar0000000000000000{- Data/Singletons/Syntax.hs (c) Richard Eisenberg 2014 rae@cs.brynmawr.edu Converts a list of DLetDecs into a LetDecEnv for easier processing, and contains various other AST definitions. -} {-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, DeriveDataTypeable, StandaloneDeriving, FlexibleInstances, ConstraintKinds #-} module Data.Singletons.Syntax where import Prelude hiding ( exp ) import Data.Kind (Constraint, Type) import Language.Haskell.TH.Syntax hiding (Type) import Language.Haskell.TH.Desugar import Data.Map.Strict ( Map ) import qualified Data.Map.Strict as Map import Data.Set ( Set ) import Data.Semigroup (Semigroup(..)) type VarPromotions = [(Name, Name)] -- from term-level name to type-level name -- Information that is accumulated when promoting patterns. data PromDPatInfos = PromDPatInfos { prom_dpat_vars :: VarPromotions -- Maps term-level pattern variables to their promoted, type-level counterparts. , prom_dpat_sig_kvs :: Set Name -- Kind variables bound by DSigPas. -- See Note [Explicitly binding kind variables] in Data.Singletons.Promote.Monad } instance Semigroup PromDPatInfos where PromDPatInfos vars1 sig_kvs1 <> PromDPatInfos vars2 sig_kvs2 = PromDPatInfos (vars1 <> vars2) (sig_kvs1 <> sig_kvs2) instance Monoid PromDPatInfos where mempty = PromDPatInfos mempty mempty -- A list of 'SingDSigPaInfos' is produced when singling pattern signatures, as we -- must case on the 'DExp's and match on them using the supplied 'DType's to -- bring the necessary singleton equality constraints into scope. -- See @Note [Singling pattern signatures]@. type SingDSigPaInfos = [(DExp, DType)] -- The parts of data declarations that are relevant to singletons. data DataDecl = DataDecl Name [DTyVarBndr] [DCon] -- The parts of type synonyms that are relevant to singletons. data TySynDecl = TySynDecl Name [DTyVarBndr] -- The parts of open type families that are relevant to singletons. type OpenTypeFamilyDecl = TypeFamilyDecl 'Open -- The parts of closed type families that are relevant to singletons. type ClosedTypeFamilyDecl = TypeFamilyDecl 'Closed -- The parts of type families that are relevant to singletons. newtype TypeFamilyDecl (info :: FamilyInfo) = TypeFamilyDecl { getTypeFamilyDecl :: DTypeFamilyHead } -- Whether a type family is open or closed. data FamilyInfo = Open | Closed data ClassDecl ann = ClassDecl { cd_cxt :: DCxt , cd_name :: Name , cd_tvbs :: [DTyVarBndr] , cd_fds :: [FunDep] , cd_lde :: LetDecEnv ann } data InstDecl ann = InstDecl { id_cxt :: DCxt , id_name :: Name , id_arg_tys :: [DType] , id_sigs :: Map Name DType , id_meths :: [(Name, LetDecRHS ann)] } type UClassDecl = ClassDecl Unannotated type UInstDecl = InstDecl Unannotated type AClassDecl = ClassDecl Annotated type AInstDecl = InstDecl Annotated {- We see below several datatypes beginning with "A". These are annotated structures, necessary for Promote to communicate key things to Single. In particular, promotion of expressions is *not* deterministic, due to the necessity to create unique names for lets, cases, and lambdas. So, we put these promotions into an annotated AST so that Single can use the right promotions. -} -- A DExp with let, lambda, and type-signature nodes annotated with their -- type-level equivalents data ADExp = ADVarE Name | ADConE Name | ADLitE Lit | ADAppE ADExp ADExp | ADLamE [Name] -- type-level names corresponding to term-level ones DType -- the promoted lambda [Name] ADExp | ADCaseE ADExp [ADMatch] DType -- the type is the return type | ADLetE ALetDecEnv ADExp | ADSigE DType -- the promoted expression ADExp DType -- A DPat with a pattern-signature node annotated with its type-level equivalent data ADPat = ADLitPa Lit | ADVarPa Name | ADConPa Name [ADPat] | ADTildePa ADPat | ADBangPa ADPat | ADSigPa DType -- The promoted pattern. Will not contain any wildcards, -- as per Note [Singling pattern signatures] ADPat DType | ADWildPa data ADMatch = ADMatch VarPromotions ADPat ADExp data ADClause = ADClause VarPromotions [ADPat] ADExp data AnnotationFlag = Annotated | Unannotated -- These are used at the type-level exclusively type Annotated = 'Annotated type Unannotated = 'Unannotated type family IfAnn (ann :: AnnotationFlag) (yes :: k) (no :: k) :: k where IfAnn Annotated yes no = yes IfAnn Unannotated yes no = no data family LetDecRHS :: AnnotationFlag -> Type data instance LetDecRHS Annotated = AFunction DType -- promote function (unapplied) Int -- number of arrows in type [ADClause] | AValue DType -- promoted exp Int -- number of arrows in type ADExp data instance LetDecRHS Unannotated = UFunction [DClause] | UValue DExp type ALetDecRHS = LetDecRHS Annotated type ULetDecRHS = LetDecRHS Unannotated data LetDecEnv ann = LetDecEnv { lde_defns :: Map Name (LetDecRHS ann) , lde_types :: Map Name DType -- type signatures , lde_infix :: Map Name Fixity -- infix declarations , lde_proms :: IfAnn ann (Map Name DType) () -- possibly, promotions , lde_bound_kvs :: IfAnn ann (Map Name (Set Name)) () -- The set of bound variables in scope. -- See Note [Explicitly binding kind variables] -- in Data.Singletons.Promote.Monad } type ALetDecEnv = LetDecEnv Annotated type ULetDecEnv = LetDecEnv Unannotated instance Semigroup ULetDecEnv where LetDecEnv defns1 types1 infx1 _ _ <> LetDecEnv defns2 types2 infx2 _ _ = LetDecEnv (defns1 <> defns2) (types1 <> types2) (infx1 <> infx2) () () instance Monoid ULetDecEnv where mempty = LetDecEnv Map.empty Map.empty Map.empty () () valueBinding :: Name -> ULetDecRHS -> ULetDecEnv valueBinding n v = emptyLetDecEnv { lde_defns = Map.singleton n v } typeBinding :: Name -> DType -> ULetDecEnv typeBinding n t = emptyLetDecEnv { lde_types = Map.singleton n t } infixDecl :: Fixity -> Name -> ULetDecEnv infixDecl f n = emptyLetDecEnv { lde_infix = Map.singleton n f } emptyLetDecEnv :: ULetDecEnv emptyLetDecEnv = mempty buildLetDecEnv :: Quasi q => [DLetDec] -> q ULetDecEnv buildLetDecEnv = go emptyLetDecEnv where go acc [] = return acc go acc (DFunD name clauses : rest) = go (valueBinding name (UFunction clauses) <> acc) rest go acc (DValD (DVarPa name) exp : rest) = go (valueBinding name (UValue exp) <> acc) rest go acc (dec@(DValD {}) : rest) = do flattened <- flattenDValD dec go acc (flattened ++ rest) go acc (DSigD name ty : rest) = go (typeBinding name ty <> acc) rest go acc (DInfixD f n : rest) = go (infixDecl f n <> acc) rest go acc (DPragmaD{} : rest) = go acc rest -- See Note [DerivedDecl] data DerivedDecl (cls :: Type -> Constraint) = DerivedDecl { ded_mb_cxt :: Maybe DCxt , ded_type :: DType , ded_decl :: DataDecl } type DerivedEqDecl = DerivedDecl Eq type DerivedShowDecl = DerivedDecl Show {- Note [DerivedDecl] ~~~~~~~~~~~~~~~~~~~~~ Most derived instances are wholly handled in Data.Singletons.Partition.partitionDecs. There are two notable exceptions to this rule, however: * Eq instances (which are handled entirely outside of partitionDecs) * Show instances (which are partially handled outside of partitionDecs) For these instances, we use a DerivedDecl data type to encode just enough information to recreate the derived instance: 1. Just the instance context, if it's standalone-derived, or Nothing if it's in a deriving clause (ded_mb_cxt) 2. The datatype, applied to some number of type arguments, as in the instance declaration (ded_type) 3. The datatype's original information, as provided through DataDecl (ded_decl) Why are these instances handled outside of partitionDecs? * Deriving Eq in singletons not only derives PEq/SEq instances, but it also derives SDecide instances. This additional complication makes Eq difficult to integrate with the other deriving machinery, so we handle it specially in Data.Singletons.Promote and Data.Singletons.Single (depending on the task at hand). * Deriving Show in singletons not only derives PShow/SShow instances, but it also derives Show instances for singletons types. To make this work, we let partitionDecs handle the PShow/SShow instances, but we also stick the relevant info into a DerivedDecl value for later use in Data.Singletons.Single, where we additionally generate Show instances. -} singletons-2.5.1/src/Data/Singletons/TH.hs0000644000000000000000000001656507346545000016546 0ustar0000000000000000{-# LANGUAGE ExplicitNamespaces, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TH -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- This module contains everything you need to derive your own singletons via -- Template Haskell. -- -- TURN ON @-XScopedTypeVariables@ IN YOUR MODULE IF YOU WANT THIS TO WORK. -- ---------------------------------------------------------------------------- module Data.Singletons.TH ( -- * Primary Template Haskell generation functions singletons, singletonsOnly, genSingletons, promote, promoteOnly, genDefunSymbols, genPromotions, -- ** Functions to generate equality instances promoteEqInstances, promoteEqInstance, singEqInstances, singEqInstance, singEqInstancesOnly, singEqInstanceOnly, singDecideInstances, singDecideInstance, -- ** Functions to generate 'Ord' instances promoteOrdInstances, promoteOrdInstance, singOrdInstances, singOrdInstance, -- ** Functions to generate 'Bounded' instances promoteBoundedInstances, promoteBoundedInstance, singBoundedInstances, singBoundedInstance, -- ** Functions to generate 'Enum' instances promoteEnumInstances, promoteEnumInstance, singEnumInstances, singEnumInstance, -- ** Functions to generate 'Show' instances promoteShowInstances, promoteShowInstance, singShowInstances, singShowInstance, -- ** Utility functions cases, sCases, -- * Basic singleton definitions Sing(SFalse, STrue, STuple0, STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, SLT, SEQ, SGT), module Data.Singletons, -- * Auxiliary definitions -- | These definitions might be mentioned in code generated by Template Haskell, -- so they must be in scope. PEq(..), If, sIf, type (&&), (%&&), SEq(..), POrd(..), SOrd(..), ThenCmp, sThenCmp, SDecide(..), (:~:)(..), Void, Refuted, Decision(..), PBounded(..), SBounded(..), PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum), PShow(..), SShow(..), ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace, ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace, PFunctor(..), SFunctor(..), PFoldable(..), SFoldable(..), PMonoid(..), SMonoid(..), PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..), (:.), (%.), SomeSing(..), Error, sError, ErrorSym0, ErrorSym1, Undefined, sUndefined, UndefinedSym0, TrueSym0, FalseSym0, type (==@#@$), type (==@#@$$), type (==@#@$$$), type (>@#@$), type (>@#@$$), type (>@#@$$$), LTSym0, EQSym0, GTSym0, Tuple0Sym0, Tuple2Sym0, Tuple2Sym1, Tuple2Sym2, Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3, Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4, Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5, Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6, Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7, CompareSym0, CompareSym1, CompareSym2, ThenCmpSym0, ThenCmpSym1, ThenCmpSym2, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, MinBoundSym0, MaxBoundSym0, ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3, ShowStringSym0, ShowStringSym1, ShowStringSym2, ShowParenSym0, ShowParenSym1, ShowParenSym2, ShowSpaceSym0, ShowSpaceSym1, ShowCharSym0, ShowCharSym1, ShowCharSym2, ShowCommaSpaceSym0, ShowCommaSpaceSym1, FmapSym0, FmapSym1, FmapSym2, type (<$@#@$), type (<$@#@$$), type (<$@#@$$$), FoldMapSym0, FoldMapSym1, FoldMapSym2, MemptySym0, MappendSym0, MappendSym1, MappendSym2, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, TraverseSym0, TraverseSym1, TraverseSym2, PureSym0, PureSym1, type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$), LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3, type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$), (:@#@$), (:@#@$$), (:@#@$$$), SuppressUnusedWarnings(..) ) where import Data.Singletons import Data.Singletons.Single import Data.Singletons.Promote import Data.Singletons.Prelude.Applicative import Data.Singletons.Prelude.Base hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr) import Data.Singletons.Prelude.Instances hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl) import Data.Singletons.Prelude.Bool import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Foldable import Data.Singletons.Prelude.Functor hiding (Void) import Data.Singletons.Prelude.Monoid import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Show import Data.Singletons.Prelude.Traversable import Data.Singletons.Decide import Data.Singletons.TypeLits import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.Names import Language.Haskell.TH.Desugar import Language.Haskell.TH import Data.Singletons.Util import Control.Arrow ( first ) -- | The function 'cases' generates a case expression where each right-hand side -- is identical. This may be useful if the type-checker requires knowledge of which -- constructor is used to satisfy equality or type-class constraints, but where -- each constructor is treated the same. cases :: DsMonad q => Name -- ^ The head of the type of the scrutinee. (Like @''Maybe@ or @''Bool@.) -> q Exp -- ^ The scrutinee, in a Template Haskell quote -> q Exp -- ^ The body, in a Template Haskell quote -> q Exp cases tyName expq bodyq = do dinfo <- dsReify tyName case dinfo of Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) -> expToTH <$> buildCases (map extractNameArgs ctors) expq bodyq Just _ -> fail $ "Using <> with something other than a type constructor: " ++ (show tyName) _ -> fail $ "Cannot find " ++ show tyName -- | The function 'sCases' generates a case expression where each right-hand side -- is identical. This may be useful if the type-checker requires knowledge of which -- constructor is used to satisfy equality or type-class constraints, but where -- each constructor is treated the same. For 'sCases', unlike 'cases', the -- scrutinee is a singleton. But make sure to pass in the name of the /original/ -- datatype, preferring @''Maybe@ over @''SMaybe@. sCases :: DsMonad q => Name -- ^ The head of the type the scrutinee's type is based on. -- (Like @''Maybe@ or @''Bool@.) -> q Exp -- ^ The scrutinee, in a Template Haskell quote -> q Exp -- ^ The body, in a Template Haskell quote -> q Exp sCases tyName expq bodyq = do dinfo <- dsReify tyName case dinfo of Just (DTyConI (DDataD _ _ _ _ _ ctors _) _) -> let ctor_stuff = map (first singDataConName . extractNameArgs) ctors in expToTH <$> buildCases ctor_stuff expq bodyq Just _ -> fail $ "Using <> with something other than a type constructor: " ++ (show tyName) _ -> fail $ "Cannot find " ++ show tyName buildCases :: DsMonad m => [(Name, Int)] -> m Exp -- scrutinee -> m Exp -- body -> m DExp buildCases ctor_infos expq bodyq = DCaseE <$> (dsExp =<< expq) <*> mapM (\con -> DMatch (conToPat con) <$> (dsExp =<< bodyq)) ctor_infos where conToPat :: (Name, Int) -> DPat conToPat (name, num_fields) = DConPa name (replicate num_fields DWildPa) singletons-2.5.1/src/Data/Singletons/TypeError.hs0000644000000000000000000001665507346545000020166 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TypeError -- Copyright : (C) 2018 Ryan Scott -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines a drop-in replacement for 'TL.TypeError' (from "GHC.TypeLits") -- that can be used at the value level as well. Since this is a drop-in -- replacement, it is not recommended to import all of "GHC.TypeLits" -- and "Data.Singletons.TypeError" at the same time, as many of the definitons -- in the latter deliberately clash with the former. -- ---------------------------------------------------------------------------- module Data.Singletons.TypeError ( TypeError, sTypeError, typeError, ErrorMessage'(..), ErrorMessage, PErrorMessage, Sing(SText, SShowType, (:%<>:), (:%$$:)), SErrorMessage, ConvertPErrorMessage, showErrorMessage, -- * Defunctionalization symbols TextSym0, TextSym1, ShowTypeSym0, ShowTypeSym1, type (:<>:@#@$), type (:<>:@#@$$), type (:<>:@#@$$$), type (:$$:@#@$), type (:$$:@#@$$), type (:$$:@#@$$$), TypeErrorSym0, TypeErrorSym1 ) where import Data.Kind import Data.Singletons.TH import qualified Data.Text as Text import qualified GHC.TypeLits as TL (ErrorMessage(..), TypeError) import GHC.Stack (HasCallStack) import GHC.TypeLits hiding (ErrorMessage(..), TypeError) import Prelude hiding ((<>)) import Text.PrettyPrint (Doc, text, (<>), ($$)) -- | A description of a custom type error. -- -- This is a variation on 'TL.ErrorMessage' that is parameterized over what -- text type is used in the 'Text' constructor. Instantiating it with -- 'Text.Text' gives you 'ErrorMessage', and instantiating it with 'Symbol' -- gives you 'PErrorMessage'. data ErrorMessage' s = Text s -- ^ Show the text as is. | forall t. ShowType t -- ^ Pretty print the type. -- @ShowType :: k -> ErrorMessage@ | ErrorMessage' s :<>: ErrorMessage' s -- ^ Put two pieces of error message next -- to each other. | ErrorMessage' s :$$: ErrorMessage' s -- ^ Stack two pieces of error message on top -- of each other. infixl 6 :<>: infixl 5 :$$: -- | A value-level `ErrorMessage'` which uses 'Text.Text' as its text type. type ErrorMessage = ErrorMessage' Text.Text -- | A type-level `ErrorMessage'` which uses 'Symbol' as its text kind. type PErrorMessage = ErrorMessage' Symbol data instance Sing :: PErrorMessage -> Type where -- It would be lovely to not have to write those (:: PErrorMessage) kind -- ascriptions in the return types of each constructor. -- See Trac #14111. SText :: Sing t -> Sing ('Text t :: PErrorMessage) SShowType :: Sing ty -> Sing ('ShowType ty :: PErrorMessage) (:%<>:) :: Sing e1 -> Sing e2 -> Sing (e1 ':<>: e2 :: PErrorMessage) (:%$$:) :: Sing e1 -> Sing e2 -> Sing (e1 ':$$: e2 :: PErrorMessage) infixl 6 :%<>: infixl 5 :%$$: type SErrorMessage = (Sing :: PErrorMessage -> Type) instance SingKind PErrorMessage where type Demote PErrorMessage = ErrorMessage fromSing (SText t) = Text (fromSing t) fromSing (SShowType{}) = ShowType (error "Can't single ShowType") fromSing (e1 :%<>: e2) = fromSing e1 :<>: fromSing e2 fromSing (e1 :%$$: e2) = fromSing e1 :$$: fromSing e2 toSing (Text t) = withSomeSing t $ SomeSing . SText toSing (ShowType{}) = SomeSing $ SShowType (error "Can't single ShowType") toSing (e1 :<>: e2) = withSomeSing e1 $ \sE1 -> withSomeSing e2 $ \sE2 -> SomeSing (sE1 :%<>: sE2) toSing (e1 :$$: e2) = withSomeSing e1 $ \sE1 -> withSomeSing e2 $ \sE2 -> SomeSing (sE1 :%$$: sE2) instance SingI t => SingI ('Text t :: PErrorMessage) where sing = SText sing instance SingI ty => SingI ('ShowType ty :: PErrorMessage) where sing = SShowType sing instance (SingI e1, SingI e2) => SingI (e1 ':<>: e2 :: PErrorMessage) where sing = sing :%<>: sing instance (SingI e1, SingI e2) => SingI (e1 ':$$: e2 :: PErrorMessage) where sing = sing :%$$: sing -- | Convert an 'ErrorMessage' into a human-readable 'String'. showErrorMessage :: ErrorMessage -> String showErrorMessage = show . go where go :: ErrorMessage -> Doc go (Text t) = text (Text.unpack t) go (ShowType _) = text "" -- Not much we can do here go (e1 :<>: e2) = go e1 <> go e2 go (e1 :$$: e2) = go e1 $$ go e2 -- | The value-level counterpart to 'TypeError'. -- -- Note that this is not quite as expressive as 'TypeError', as it is unable -- to print the contents of 'ShowType' constructors (it will simply print -- @\"\\"@ in their place). typeError :: HasCallStack => ErrorMessage -> a typeError = error . showErrorMessage -- | Convert a 'PErrorMessage' to a 'TL.ErrorMessage' from "GHC.TypeLits". type family ConvertPErrorMessage (a :: PErrorMessage) :: TL.ErrorMessage where ConvertPErrorMessage ('Text t) = 'TL.Text t ConvertPErrorMessage ('ShowType ty) = 'TL.ShowType ty ConvertPErrorMessage (e1 ':<>: e2) = ConvertPErrorMessage e1 'TL.:<>: ConvertPErrorMessage e2 ConvertPErrorMessage (e1 ':$$: e2) = ConvertPErrorMessage e1 'TL.:$$: ConvertPErrorMessage e2 -- | A drop-in replacement for 'TL.TypeError'. This also exists at the -- value-level as 'typeError'. type family TypeError (a :: PErrorMessage) :: b where -- We cannot define this as a type synonym due to Trac #12048. TypeError a = TL.TypeError (ConvertPErrorMessage a) -- | The singleton for 'typeError'. -- -- Note that this is not quite as expressive as 'TypeError', as it is unable -- to handle 'ShowType' constructors at all. sTypeError :: HasCallStack => Sing err -> Sing (TypeError err) sTypeError = typeError . fromSing $(genDefunSymbols [''ErrorMessage', ''TypeError]) instance SingI (TextSym0 :: Symbol ~> PErrorMessage) where sing = singFun1 SText instance SingI (TyCon1 'Text :: Symbol ~> PErrorMessage) where sing = singFun1 SText instance SingI (ShowTypeSym0 :: t ~> PErrorMessage) where sing = singFun1 SShowType instance SingI (TyCon1 'ShowType :: t ~> PErrorMessage) where sing = singFun1 SShowType instance SingI ((:<>:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where sing = singFun2 (:%<>:) instance SingI (TyCon2 '(:<>:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where sing = singFun2 (:%<>:) instance SingI x => SingI ((:<>:@#@$$) x :: PErrorMessage ~> PErrorMessage) where sing = singFun1 (sing @x :%<>:) instance SingI x => SingI (TyCon1 ('(:<>:) x) :: PErrorMessage ~> PErrorMessage) where sing = singFun1 (sing @x :%<>:) instance SingI ((:$$:@#@$) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where sing = singFun2 (:%$$:) instance SingI (TyCon2 '(:$$:) :: PErrorMessage ~> PErrorMessage ~> PErrorMessage) where sing = singFun2 (:%$$:) instance SingI x => SingI ((:$$:@#@$$) x :: PErrorMessage ~> PErrorMessage) where sing = singFun1 (sing @x :%$$:) instance SingI x => SingI (TyCon1 ('(:$$:) x) :: PErrorMessage ~> PErrorMessage) where sing = singFun1 (sing @x :%$$:) instance SingI TypeErrorSym0 where sing = singFun1 sTypeError singletons-2.5.1/src/Data/Singletons/TypeLits.hs0000644000000000000000000001440007346545000017772 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, ConstraintKinds, GADTs, TypeApplications, TypeFamilies, UndecidableInstances, DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TypeLits -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines and exports singletons useful for the Nat and Symbol kinds. -- ---------------------------------------------------------------------------- {-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.TypeLits ( Nat, Symbol, Sing(SNat, SSym), SNat, SSymbol, withKnownNat, withKnownSymbol, Error, sError, ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, KnownNat, natVal, KnownSymbol, symbolVal, type (^), (%^), type (<=?), (%<=?), TN.Log2, sLog2, Div, sDiv, Mod, sMod, DivMod, sDivMod, Quot, sQuot, Rem, sRem, QuotRem, sQuotRem, -- * Defunctionalization symbols ErrorSym0, ErrorSym1, ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, UndefinedSym0, KnownNatSym0, KnownNatSym1, KnownSymbolSym0, KnownSymbolSym1, type (^@#@$), type (^@#@$$), type (^@#@$$$), type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$), Log2Sym0, Log2Sym1, DivSym0, DivSym1, DivSym2, ModSym0, ModSym1, ModSym2, DivModSym0, DivModSym1, DivModSym2, QuotSym0, QuotSym1, QuotSym2, RemSym0, RemSym1, RemSym2, QuotRemSym0, QuotRemSym1, QuotRemSym2 ) where import Data.Singletons.Internal import Data.Singletons.Prelude.Tuple import Data.Singletons.Promote import Data.Singletons.ShowSing () -- for Show instances import Data.Singletons.TypeLits.Internal import Data.String (IsString(..)) import qualified GHC.TypeNats as TN import GHC.TypeNats (Div, Mod, SomeNat(..)) import Numeric.Natural (Natural) import Unsafe.Coerce -- | This bogus 'Num' instance is helpful for people who want to define -- functions over Nats that will only be used at the type level or -- as singletons. A correct SNum instance for Nat singletons exists. instance Num Nat where (+) = no_term_level_nats (-) = no_term_level_nats (*) = no_term_level_nats negate = no_term_level_nats abs = no_term_level_nats signum = no_term_level_nats fromInteger = no_term_level_nats instance Eq Nat where (==) = no_term_level_nats instance Ord Nat where compare = no_term_level_nats instance Enum Nat where toEnum = no_term_level_nats fromEnum = no_term_level_nats enumFromTo = no_term_level_nats enumFromThenTo = no_term_level_nats instance Show Nat where showsPrec = no_term_level_nats -- | This bogus instance is helpful for people who want to define -- functions over Symbols that will only be used at the type level or -- as singletons. instance Eq Symbol where (==) = no_term_level_syms instance Ord Symbol where compare = no_term_level_syms instance IsString Symbol where fromString = no_term_level_syms instance Semigroup Symbol where (<>) = no_term_level_syms instance Monoid Symbol where mempty = no_term_level_syms instance Show Symbol where showsPrec = no_term_level_syms no_term_level_nats :: a no_term_level_nats = error "The kind `Nat` may not be used at the term level." no_term_level_syms :: a no_term_level_syms = error "The kind `Symbol` may not be used at the term level." -- These are often useful in TypeLits-heavy code $(genDefunSymbols [''KnownNat, ''KnownSymbol]) ------------------------------------------------------------ -- Log2, Div, Mod, DivMod, and friends ------------------------------------------------------------ {- | Adapted from GHC's source code. Compute the logarithm of a number in the given base, rounded down to the closest integer. -} genLog2 :: Natural -> Natural genLog2 x = exactLoop 0 x where exactLoop s i | i == 1 = s | i < 2 = s | otherwise = let s1 = s + 1 in s1 `seq` case divMod i 2 of (j,r) | r == 0 -> exactLoop s1 j | otherwise -> underLoop s1 j underLoop s i | i < 2 = s | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i 2) sLog2 :: Sing x -> Sing (TN.Log2 x) sLog2 sx = let x = fromSing sx in case x of 0 -> error "log2 of 0" _ -> case TN.someNatVal (genLog2 x) of SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) $(genDefunSymbols [''TN.Log2]) instance SingI Log2Sym0 where sing = singFun1 sLog2 sDiv :: Sing x -> Sing y -> Sing (Div x y) sDiv sx sy = let x = fromSing sx y = fromSing sy res = TN.someNatVal (x `div` y) in case res of SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) infixl 7 `sDiv` $(genDefunSymbols [''Div]) instance SingI DivSym0 where sing = singFun2 sDiv instance SingI x => SingI (DivSym1 x) where sing = singFun1 $ sDiv (sing @x) sMod :: Sing x -> Sing y -> Sing (Mod x y) sMod sx sy = let x = fromSing sx y = fromSing sy res = TN.someNatVal (x `mod` y) in case res of SomeNat (_ :: Proxy res) -> unsafeCoerce (SNat :: Sing res) infixl 7 `sMod` $(genDefunSymbols [''Mod]) instance SingI ModSym0 where sing = singFun2 sMod instance SingI x => SingI (ModSym1 x) where sing = singFun1 $ sMod $ sing @x $(promoteOnly [d| divMod :: Nat -> Nat -> (Nat, Nat) divMod x y = (div x y, mod x y) quotRem :: Nat -> Nat -> (Nat, Nat) quotRem = divMod quot :: Nat -> Nat -> Nat quot = div infixl 7 `quot` rem :: Nat -> Nat -> Nat rem = mod infixl 7 `rem` |]) sDivMod :: Sing x -> Sing y -> Sing (DivMod x y) sDivMod sx sy = let x = fromSing sx y = fromSing sy (q,r) = x `divMod` y qRes = TN.someNatVal q rRes = TN.someNatVal r in case (qRes, rRes) of (SomeNat (_ :: Proxy q), SomeNat (_ :: Proxy r)) -> unsafeCoerce (STuple2 (SNat :: Sing q) (SNat :: Sing r)) sQuotRem :: Sing x -> Sing y -> Sing (QuotRem x y) sQuotRem = sDivMod sQuot :: Sing x -> Sing y -> Sing (Quot x y) sQuot = sDiv infixl 7 `sQuot` sRem :: Sing x -> Sing y -> Sing (Rem x y) sRem = sMod infixl 7 `sRem` singletons-2.5.1/src/Data/Singletons/TypeLits/0000755000000000000000000000000007346545000017437 5ustar0000000000000000singletons-2.5.1/src/Data/Singletons/TypeLits/Internal.hs0000644000000000000000000001674707346545000021566 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TypeLits.Internal -- Copyright : (C) 2014 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- Defines and exports singletons useful for the Nat and Symbol kinds. -- This exports the internal, unsafe constructors. Use Data.Singletons.TypeLits -- for a safe interface. -- ---------------------------------------------------------------------------- {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, FlexibleInstances, UndecidableInstances, ScopedTypeVariables, RankNTypes, GADTs, FlexibleContexts, TypeOperators, ConstraintKinds, TemplateHaskell, StandaloneDeriving, TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Data.Singletons.TypeLits.Internal ( Sing(..), Nat, Symbol, SNat, SSymbol, withKnownNat, withKnownSymbol, Error, sError, ErrorWithoutStackTrace, sErrorWithoutStackTrace, Undefined, sUndefined, KnownNat, TN.natVal, KnownSymbol, symbolVal, type (^), (%^), type (<=?), (%<=?), -- * Defunctionalization symbols ErrorSym0, ErrorSym1, ErrorWithoutStackTraceSym0, ErrorWithoutStackTraceSym1, UndefinedSym0, type (^@#@$), type (^@#@$$), type (^@#@$$$), type (<=?@#@$), type (<=?@#@$$), type (<=?@#@$$$) ) where import Data.Singletons.Promote import Data.Singletons.Internal import Data.Singletons.Prelude.Eq import Data.Singletons.Prelude.Ord as O import Data.Singletons.Decide import Data.Singletons.Prelude.Bool import GHC.Stack (HasCallStack) import GHC.TypeLits as TL import qualified GHC.TypeNats as TN import Data.Proxy ( Proxy(..) ) import Numeric.Natural (Natural) import Unsafe.Coerce import qualified Data.Text as T import Data.Text ( Text ) ---------------------------------------------------------------------- ---- TypeLits singletons --------------------------------------------- ---------------------------------------------------------------------- data instance Sing (n :: Nat) = KnownNat n => SNat instance KnownNat n => SingI n where sing = SNat instance SingKind Nat where type Demote Nat = Natural fromSing (SNat :: Sing n) = TN.natVal (Proxy :: Proxy n) toSing n = case TN.someNatVal n of SomeNat (_ :: Proxy n) -> SomeSing (SNat :: Sing n) data instance Sing (n :: Symbol) = KnownSymbol n => SSym instance KnownSymbol n => SingI n where sing = SSym instance SingKind Symbol where type Demote Symbol = Text fromSing (SSym :: Sing n) = T.pack (symbolVal (Proxy :: Proxy n)) toSing s = case someSymbolVal (T.unpack s) of SomeSymbol (_ :: Proxy n) -> SomeSing (SSym :: Sing n) -- SDecide instances: instance SDecide Nat where (SNat :: Sing n) %~ (SNat :: Sing m) | Just r <- TN.sameNat (Proxy :: Proxy n) (Proxy :: Proxy m) = Proved r | otherwise = Disproved (\_ -> error errStr) where errStr = "Broken Nat singletons" instance SDecide Symbol where (SSym :: Sing n) %~ (SSym :: Sing m) | Just r <- sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m) = Proved r | otherwise = Disproved (\_ -> error errStr) where errStr = "Broken Symbol singletons" -- PEq instances instance PEq Nat instance PEq Symbol -- need SEq instances for TypeLits kinds instance SEq Nat where (SNat :: Sing n) %== (SNat :: Sing m) = case sameNat (Proxy :: Proxy n) (Proxy :: Proxy m) of Just Refl -> STrue Nothing -> unsafeCoerce SFalse instance SEq Symbol where (SSym :: Sing n) %== (SSym :: Sing m) = case sameSymbol (Proxy :: Proxy n) (Proxy :: Proxy m) of Just Refl -> STrue Nothing -> unsafeCoerce SFalse -- POrd instances instance POrd Nat where type (a :: Nat) `Compare` (b :: Nat) = a `TN.CmpNat` b instance POrd Symbol where type (a :: Symbol) `Compare` (b :: Symbol) = a `TL.CmpSymbol` b -- | Kind-restricted synonym for 'Sing' for @Nat@s type SNat (x :: Nat) = Sing x -- | Kind-restricted synonym for 'Sing' for @Symbol@s type SSymbol (x :: Symbol) = Sing x -- SOrd instances instance SOrd Nat where a `sCompare` b = case fromSing a `compare` fromSing b of LT -> unsafeCoerce SLT EQ -> unsafeCoerce SEQ GT -> unsafeCoerce SGT instance SOrd Symbol where a `sCompare` b = case fromSing a `compare` fromSing b of LT -> unsafeCoerce SLT EQ -> unsafeCoerce SEQ GT -> unsafeCoerce SGT -- Convenience functions -- | Given a singleton for @Nat@, call something requiring a -- @KnownNat@ instance. withKnownNat :: Sing n -> (KnownNat n => r) -> r withKnownNat SNat f = f -- | Given a singleton for @Symbol@, call something requiring -- a @KnownSymbol@ instance. withKnownSymbol :: Sing n -> (KnownSymbol n => r) -> r withKnownSymbol SSym f = f -- | The promotion of 'error'. This version is more poly-kinded for -- easier use. type family Error (str :: k0) :: k where {} $(genDefunSymbols [''Error]) instance SingI (ErrorSym0 :: Symbol ~> a) where sing = singFun1 sError -- | The singleton for 'error' sError :: HasCallStack => Sing (str :: Symbol) -> a sError sstr = error (T.unpack (fromSing sstr)) -- | The promotion of 'errorWithoutStackTrace'. This version is more -- poly-kinded for easier use. type family ErrorWithoutStackTrace (str :: k0) :: k where {} $(genDefunSymbols [''ErrorWithoutStackTrace]) instance SingI (ErrorWithoutStackTraceSym0 :: Symbol ~> a) where sing = singFun1 sErrorWithoutStackTrace -- | The singleton for 'errorWithoutStackTrace'. sErrorWithoutStackTrace :: Sing (str :: Symbol) -> a sErrorWithoutStackTrace sstr = errorWithoutStackTrace (T.unpack (fromSing sstr)) -- | The promotion of 'undefined'. type family Undefined :: k where {} $(genDefunSymbols [''Undefined]) -- | The singleton for 'undefined'. sUndefined :: HasCallStack => a sUndefined = undefined -- | The singleton analogue of '(TN.^)' for 'Nat's. (%^) :: Sing a -> Sing b -> Sing (a ^ b) sa %^ sb = let a = fromSing sa b = fromSing sb ex = TN.someNatVal (a ^ b) in case ex of SomeNat (_ :: Proxy ab) -> unsafeCoerce (SNat :: Sing ab) infixr 8 %^ -- Defunctionalization symbols for type-level (^) $(genDefunSymbols [''(^)]) instance SingI (^@#@$) where sing = singFun2 (%^) instance SingI x => SingI ((^@#@$$) x) where sing = singFun1 (sing @x %^) -- | The singleton analogue of 'TN.<=?' -- -- Note that, because of historical reasons in GHC's 'TN.Nat' API, 'TN.<=?' -- is incompatible (unification-wise) with 'O.<=' and the 'PEq', 'SEq', -- 'POrd', and 'SOrd' instances for 'Nat'. @(a '<=?' b) ~ 'True@ does not -- imply anything about @a 'O.<=' b@ or any other 'PEq' / 'POrd' -- relationships. -- -- (Be aware that 'O.<=' in the paragraph above refers to 'O.<=' from the -- 'POrd' typeclass, exported from "Data.Singletons.Prelude.Ord", and /not/ -- the 'TN.<=' from "GHC.TypeNats". The latter is simply a type alias for -- @(a 'TN.<=?' b) ~ 'True@.) -- -- This is provided here for the sake of completeness and for compatibility -- with libraries with APIs built around '<=?'. New code should use -- 'CmpNat', exposed through this library through the 'POrd' and 'SOrd' -- instances for 'Nat'. (%<=?) :: Sing a -> Sing b -> Sing (a <=? b) sa %<=? sb = unsafeCoerce (sa %<= sb) infix 4 %<=? -- Defunctionalization symbols for (<=?) $(genDefunSymbols [''(<=?)]) instance SingI (<=?@#@$) where sing = singFun2 (%<=?) instance SingI x => SingI ((<=?@#@$$) x) where sing = singFun1 (sing @x %<=?) singletons-2.5.1/src/Data/Singletons/TypeRepTYPE.hs0000644000000000000000000000766407346545000020325 0ustar0000000000000000{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleInstances, GADTs, UndecidableInstances, ScopedTypeVariables, MagicHash, TypeOperators, PolyKinds #-} {-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Singletons.TypeRepTYPE -- Copyright : (C) 2013 Richard Eisenberg -- License : BSD-style (see LICENSE) -- Maintainer : Ryan Scott -- Stability : experimental -- Portability : non-portable -- -- This module defines singleton instances making 'TypeRep' the singleton for -- the kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@), an instantiation of -- which is the famous kind 'Type'. The definitions don't fully line up with -- what is expected within the singletons library, so expect unusual results! -- ---------------------------------------------------------------------------- module Data.Singletons.TypeRepTYPE ( Sing(STypeRep), -- | Here is the definition of the singleton for @'TYPE' rep@: -- -- > newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where -- > STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a -- -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and -- 'TestCoercion' are also supplied. SomeTypeRepTYPE(..) ) where import Data.Kind (Type) import Data.Singletons.Prelude.Instances import Data.Singletons.Internal import Data.Singletons.Prelude.Eq import Data.Singletons.Decide import Data.Type.Equality ((:~:)(..)) import GHC.Exts (RuntimeRep, TYPE) import Type.Reflection import Type.Reflection.Unsafe import Unsafe.Coerce -- | A choice of singleton for the kind @'TYPE' rep@ (for some 'RuntimeRep' -- @rep@), an instantiation of which is the famous kind 'Type'. -- -- Conceivably, one could generalize this instance to `Sing :: k -> Type` for -- /any/ kind @k@, and remove all other 'Sing' instances. We don't adopt this -- design, however, since it is far more convenient in practice to work with -- explicit singleton values than 'TypeRep's (for instance, 'TypeRep's are -- more difficult to pattern match on, and require extra runtime checks). -- -- We cannot produce explicit singleton values for everything in @'TYPE' rep@, -- however, since it is an open kind, so we reach for 'TypeRep' in this one -- particular case. newtype instance Sing :: forall (rep :: RuntimeRep). TYPE rep -> Type where STypeRep :: forall (rep :: RuntimeRep) (a :: TYPE rep). TypeRep a -> Sing a deriving (Eq, Ord, Show) -- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to -- kind @'TYPE' rep@ (for some 'RuntimeRep' @rep@). data SomeTypeRepTYPE :: RuntimeRep -> Type where SomeTypeRepTYPE :: forall (rep :: RuntimeRep) (a :: TYPE rep). !(TypeRep a) -> SomeTypeRepTYPE rep instance Eq (SomeTypeRepTYPE rep) where SomeTypeRepTYPE a == SomeTypeRepTYPE b = case eqTypeRep a b of Just HRefl -> True Nothing -> False instance Ord (SomeTypeRepTYPE rep) where SomeTypeRepTYPE a `compare` SomeTypeRepTYPE b = typeRepFingerprint a `compare` typeRepFingerprint b instance Show (SomeTypeRepTYPE rep) where showsPrec p (SomeTypeRepTYPE ty) = showsPrec p ty instance Typeable a => SingI (a :: TYPE rep) where sing = STypeRep typeRep instance SingKind (TYPE rep) where type Demote (TYPE rep) = SomeTypeRepTYPE rep fromSing (STypeRep tr) = SomeTypeRepTYPE tr toSing (SomeTypeRepTYPE tr) = SomeSing $ STypeRep tr instance PEq (TYPE rep) instance SEq (TYPE rep) where STypeRep tra %== STypeRep trb = case eqTypeRep tra trb of Just HRefl -> STrue Nothing -> unsafeCoerce SFalse -- the Data.Typeable interface isn't strong enough -- to enable us to define this without unsafeCoerce instance SDecide (TYPE rep) where STypeRep tra %~ STypeRep trb = case eqTypeRep tra trb of Just HRefl -> Proved Refl Nothing -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed") singletons-2.5.1/src/Data/Singletons/Util.hs0000644000000000000000000004333207346545000017140 0ustar0000000000000000{- Data/Singletons/Util.hs (c) Richard Eisenberg 2013 rae@cs.brynmawr.edu This file contains helper functions internal to the singletons package. Users of the package should not need to consult this file. -} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes, TemplateHaskell, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances, MagicHash, UnboxedTuples, LambdaCase, NoMonomorphismRestriction #-} module Data.Singletons.Util where import Prelude hiding ( exp, foldl, concat, mapM, any, pred ) import Language.Haskell.TH.Syntax hiding ( lift ) import Language.Haskell.TH.Desugar import Data.Char import Control.Monad hiding ( mapM ) import Control.Monad.Writer hiding ( mapM ) import Control.Monad.Reader hiding ( mapM ) import qualified Data.Map as Map import Data.List.NonEmpty (NonEmpty(..)) import Data.Map ( Map ) import qualified Data.Monoid as Monoid import Data.Semigroup as Semigroup import Data.Foldable import Data.Functor.Identity import Data.Traversable import Data.Generics import Data.Maybe import Data.Void import Control.Monad.Fail ( MonadFail ) -- The list of types that singletons processes by default basicTypes :: [Name] basicTypes = [ ''Maybe , ''[] , ''Either , ''NonEmpty , ''Void ] ++ boundedBasicTypes boundedBasicTypes :: [Name] boundedBasicTypes = [ ''(,) , ''(,,) , ''(,,,) , ''(,,,,) , ''(,,,,,) , ''(,,,,,,) , ''Identity ] ++ enumBasicTypes enumBasicTypes :: [Name] enumBasicTypes = [ ''Bool, ''Ordering, ''() ] semigroupBasicTypes :: [Name] semigroupBasicTypes = [ ''Dual , ''All , ''Any , ''Sum , ''Product -- , ''Endo see https://github.com/goldfirere/singletons/issues/82 {- , ''Alt singletons doesn't support higher kinds :( see https://github.com/goldfirere/singletons/issues/150 -} , ''Min , ''Max , ''Semigroup.First , ''Semigroup.Last , ''WrappedMonoid ] monoidBasicTypes :: [Name] monoidBasicTypes = [ ''Monoid.First , ''Monoid.Last ] -- like reportWarning, but generalized to any Quasi qReportWarning :: Quasi q => String -> q () qReportWarning = qReport False -- like reportError, but generalized to any Quasi qReportError :: Quasi q => String -> q () qReportError = qReport True -- | Generate a new Unique qNewUnique :: DsMonad q => q Int qNewUnique = do Name _ flav <- qNewName "x" case flav of NameU n -> return n _ -> error "Internal error: `qNewName` didn't return a NameU" checkForRep :: Quasi q => [Name] -> q () checkForRep names = when (any ((== "Rep") . nameBase) names) (fail $ "A data type named <> is a special case.\n" ++ "Promoting it will not work as expected.\n" ++ "Please choose another name for your data type.") checkForRepInDecls :: Quasi q => [DDec] -> q () checkForRepInDecls decls = checkForRep (allNamesIn decls) tysOfConFields :: DConFields -> [DType] tysOfConFields (DNormalC _ stys) = map snd stys tysOfConFields (DRecC vstys) = map (\(_,_,ty) -> ty) vstys -- extract the name and number of arguments to a constructor extractNameArgs :: DCon -> (Name, Int) extractNameArgs = liftSnd length . extractNameTypes -- extract the name and types of constructor arguments extractNameTypes :: DCon -> (Name, [DType]) extractNameTypes (DCon _ _ n fields _) = (n, tysOfConFields fields) extractName :: DCon -> Name extractName (DCon _ _ n _ _) = n -- | is a valid Haskell infix data constructor (i.e., does it begin with a colon?) isInfixDataCon :: String -> Bool isInfixDataCon (':':_) = True isInfixDataCon _ = False -- | Is an identifier a legal data constructor name in Haskell? That is, is its -- first character an uppercase letter (prefix) or a colon (infix)? isDataConName :: Name -> Bool isDataConName n = let first = head (nameBase n) in isUpper first || first == ':' -- | Is an identifier uppercase? -- -- Note that this will always return 'False' for infix names, since the concept -- of upper- and lower-case doesn't make sense for non-alphabetic characters. -- If you want to check if a name is legal as a data constructor, use the -- 'isDataConName' function. isUpcase :: Name -> Bool isUpcase n = let first = head (nameBase n) in isUpper first -- Make an identifier uppercase. If the identifier is infix, this acts as the -- identity function. upcase :: Name -> Name upcase = mkName . toUpcaseStr noPrefix -- make an identifier uppercase and return it as a String toUpcaseStr :: (String, String) -- (alpha, symb) prefixes to prepend -> Name -> String toUpcaseStr (alpha, symb) n | isHsLetter first = upcase_alpha | otherwise = upcase_symb where str = nameBase n first = head str upcase_alpha = alpha ++ (toUpper first) : tail str upcase_symb = symb ++ str noPrefix :: (String, String) noPrefix = ("", "") -- Put an uppercase prefix on a constructor name. Takes two prefixes: -- one for identifiers and one for symbols. -- -- This is different from 'prefixName' in that infix constructor names always -- start with a colon, so we must insert the prefix after the colon in order -- for the new name to be syntactically valid. prefixConName :: String -> String -> Name -> Name prefixConName pre tyPre n = case (nameBase n) of (':' : rest) -> mkName (':' : tyPre ++ rest) alpha -> mkName (pre ++ alpha) -- Put a prefix on a name. Takes two prefixes: one for identifiers -- and one for symbols. prefixName :: String -> String -> Name -> Name prefixName pre tyPre n = let str = nameBase n first = head str in if isHsLetter first then mkName (pre ++ str) else mkName (tyPre ++ str) -- Put a suffix on a name. Takes two suffixes: one for identifiers -- and one for symbols. suffixName :: String -> String -> Name -> Name suffixName ident symb n = let str = nameBase n first = head str in if isHsLetter first then mkName (str ++ ident) else mkName (str ++ symb) -- convert a number into both alphanumeric and symoblic forms uniquePrefixes :: String -- alphanumeric prefix -> String -- symbolic prefix -> Int -> (String, String) -- (alphanum, symbolic) uniquePrefixes alpha symb n = (alpha ++ n_str, symb ++ convert n_str) where n_str = show n convert [] = [] convert (d : ds) = let d' = case d of '0' -> '!' '1' -> '#' '2' -> '$' '3' -> '%' '4' -> '&' '5' -> '*' '6' -> '+' '7' -> '.' '8' -> '/' '9' -> '>' _ -> error "non-digit in show #" in d' : convert ds -- extract the kind from a TyVarBndr extractTvbKind :: DTyVarBndr -> Maybe DKind extractTvbKind (DPlainTV _) = Nothing extractTvbKind (DKindedTV _ k) = Just k -- extract the name from a TyVarBndr. extractTvbName :: DTyVarBndr -> Name extractTvbName (DPlainTV n) = n extractTvbName (DKindedTV n _) = n tvbToType :: DTyVarBndr -> DType tvbToType = DVarT . extractTvbName inferMaybeKindTV :: Name -> Maybe DKind -> DTyVarBndr inferMaybeKindTV n Nothing = DPlainTV n inferMaybeKindTV n (Just k) = DKindedTV n k resultSigToMaybeKind :: DFamilyResultSig -> Maybe DKind resultSigToMaybeKind DNoSig = Nothing resultSigToMaybeKind (DKindSig k) = Just k resultSigToMaybeKind (DTyVarSig (DPlainTV _)) = Nothing resultSigToMaybeKind (DTyVarSig (DKindedTV _ k)) = Just k -- Reconstruct arrow kind from the list of kinds ravel :: [DType] -> DType -> DType ravel [] res = res ravel (h:t) res = DAppT (DAppT DArrowT h) (ravel t res) -- | Convert a 'DPred' to a 'DType'. predToType :: DPred -> DType predToType (DForallPr tvbs cxt p) = DForallT tvbs cxt (predToType p) predToType (DAppPr p t) = DAppT (predToType p) t predToType (DSigPr p k) = DSigT (predToType p) k predToType (DVarPr n) = DVarT n predToType (DConPr n) = DConT n predToType DWildCardPr = DWildCardT -- count the number of arguments in a type countArgs :: DType -> Int countArgs ty = length args where (_, _, args, _) = unravel ty -- changes all TyVars not to be NameU's. Workaround for GHC#11812 noExactTyVars :: Data a => a -> a noExactTyVars = everywhere go where go :: Data a => a -> a go = mkT fix_tvb `extT` fix_ty `extT` fix_inj_ann no_exact_name :: Name -> Name no_exact_name (Name (OccName occ) (NameU unique)) = mkName (occ ++ show unique) no_exact_name n = n fix_tvb (DPlainTV n) = DPlainTV (no_exact_name n) fix_tvb (DKindedTV n k) = DKindedTV (no_exact_name n) k fix_ty (DVarT n) = DVarT (no_exact_name n) fix_ty ty = ty fix_inj_ann (InjectivityAnn lhs rhs) = InjectivityAnn (no_exact_name lhs) (map no_exact_name rhs) substKind :: Map Name DKind -> DKind -> DKind substKind = substType -- | Non–capture-avoiding substitution. (If you want capture-avoiding -- substitution, use @substTy@ from "Language.Haskell.TH.Desugar.Subst". substType :: Map Name DType -> DType -> DType substType subst ty | Map.null subst = ty substType subst (DForallT tvbs cxt inner_ty) = DForallT tvbs' cxt' inner_ty' where (subst', tvbs') = mapAccumL subst_tvb subst tvbs cxt' = map (substPred subst') cxt inner_ty' = substType subst' inner_ty substType subst (DAppT ty1 ty2) = substType subst ty1 `DAppT` substType subst ty2 substType subst (DSigT ty ki) = substType subst ty `DSigT` substType subst ki substType subst (DVarT n) = case Map.lookup n subst of Just ki -> ki Nothing -> DVarT n substType _ ty@(DConT {}) = ty substType _ ty@(DArrowT) = ty substType _ ty@(DLitT {}) = ty substType _ ty@DWildCardT = ty substPred :: Map Name DType -> DPred -> DPred substPred subst pred | Map.null subst = pred substPred subst (DForallPr tvbs cxt inner_pred) = DForallPr tvbs' cxt' inner_pred' where (subst', tvbs') = mapAccumL subst_tvb subst tvbs cxt' = map (substPred subst') cxt inner_pred' = substPred subst' inner_pred substPred subst (DAppPr pred ty) = DAppPr (substPred subst pred) (substType subst ty) substPred subst (DSigPr pred ki) = DSigPr (substPred subst pred) (substKind subst ki) substPred _ pred@(DVarPr {}) = pred substPred _ pred@(DConPr {}) = pred substPred _ pred@DWildCardPr = pred subst_tvb :: Map Name DKind -> DTyVarBndr -> (Map Name DKind, DTyVarBndr) subst_tvb s tvb@(DPlainTV n) = (Map.delete n s, tvb) subst_tvb s (DKindedTV n k) = (Map.delete n s, DKindedTV n (substKind s k)) cuskify :: DTyVarBndr -> DTyVarBndr cuskify (DPlainTV tvname) = DKindedTV tvname $ DConT typeKindName cuskify tvb = tvb -- apply a type to a list of types foldType :: DType -> [DType] -> DType foldType = foldl DAppT -- apply a type to a list of type variable binders foldTypeTvbs :: DType -> [DTyVarBndr] -> DType foldTypeTvbs ty = foldType ty . map tvbToType -- apply a pred to a list of types foldPred :: DPred -> [DType] -> DPred foldPred = foldl DAppPr -- apply a pred to a list of type variable binders foldPredTvbs :: DPred -> [DTyVarBndr] -> DPred foldPredTvbs pr = foldPred pr . map tvbToType -- | Decompose an applied type into its individual components. For example, this: -- -- @ -- Either Int Char -- @ -- -- would be unfolded to this: -- -- @ -- Either :| [Int, Char] -- @ unfoldType :: DType -> NonEmpty DType unfoldType = go [] where go :: [DType] -> DType -> NonEmpty DType go acc (DAppT t1 t2) = go (t2:acc) t1 go acc (DSigT t _) = go acc t go acc (DForallT _ _ t) = go acc t go acc t = t :| acc -- Construct a data type's variable binders, possibly using fresh variables -- from the data type's kind signature. buildDataDTvbs :: DsMonad q => [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr] buildDataDTvbs tvbs mk = do extra_tvbs <- mkExtraDKindBinders $ fromMaybe (DConT typeKindName) mk pure $ tvbs ++ extra_tvbs -- apply an expression to a list of expressions foldExp :: DExp -> [DExp] -> DExp foldExp = foldl DAppE -- is a function type? isFunTy :: DType -> Bool isFunTy (DAppT (DAppT DArrowT _) _) = True isFunTy (DForallT _ _ _) = True isFunTy _ = False -- choose the first non-empty list orIfEmpty :: [a] -> [a] -> [a] orIfEmpty [] x = x orIfEmpty x _ = x -- build a pattern match over several expressions, each with only one pattern multiCase :: [DExp] -> [DPat] -> DExp -> DExp multiCase [] [] body = body multiCase scruts pats body = DCaseE (mkTupleDExp scruts) [DMatch (mkTupleDPat pats) body] -- Make a desugar function into a TH function. wrapDesugar :: (Desugar th ds, DsMonad q) => (th -> ds -> q ds) -> th -> q th wrapDesugar f th = do ds <- desugar th fmap sweeten $ f th ds -- a monad transformer for writing a monoid alongside returning a Q newtype QWithAux m q a = QWA { runQWA :: WriterT m q a } deriving ( Functor, Applicative, Monad, MonadTrans , MonadWriter m, MonadReader r , MonadFail, MonadIO ) -- make a Quasi instance for easy lifting instance (Quasi q, Monoid m) => Quasi (QWithAux m q) where qNewName = lift `comp1` qNewName qReport = lift `comp2` qReport qLookupName = lift `comp2` qLookupName qReify = lift `comp1` qReify qReifyInstances = lift `comp2` qReifyInstances qLocation = lift qLocation qRunIO = lift `comp1` qRunIO qAddDependentFile = lift `comp1` qAddDependentFile qReifyRoles = lift `comp1` qReifyRoles qReifyAnnotations = lift `comp1` qReifyAnnotations qReifyModule = lift `comp1` qReifyModule qAddTopDecls = lift `comp1` qAddTopDecls qAddModFinalizer = lift `comp1` qAddModFinalizer qGetQ = lift qGetQ qPutQ = lift `comp1` qPutQ qReifyFixity = lift `comp1` qReifyFixity qReifyConStrictness = lift `comp1` qReifyConStrictness qIsExtEnabled = lift `comp1` qIsExtEnabled qExtsEnabled = lift qExtsEnabled qAddForeignFilePath = lift `comp2` qAddForeignFilePath qAddTempFile = lift `comp1` qAddTempFile qAddCorePlugin = lift `comp1` qAddCorePlugin qRecover exp handler = do (result, aux) <- lift $ qRecover (evalForPair exp) (evalForPair handler) tell aux return result instance (DsMonad q, Monoid m) => DsMonad (QWithAux m q) where localDeclarations = lift localDeclarations -- helper functions for composition comp1 :: (b -> c) -> (a -> b) -> a -> c comp1 = (.) comp2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d comp2 f g a b = f (g a b) -- run a computation with an auxiliary monoid, discarding the monoid result evalWithoutAux :: Quasi q => QWithAux m q a -> q a evalWithoutAux = liftM fst . runWriterT . runQWA -- run a computation with an auxiliary monoid, returning only the monoid result evalForAux :: Quasi q => QWithAux m q a -> q m evalForAux = execWriterT . runQWA -- run a computation with an auxiliary monoid, return both the result -- of the computation and the monoid result evalForPair :: QWithAux m q a -> q (a, m) evalForPair = runWriterT . runQWA -- in a computation with an auxiliary map, add a binding to the map addBinding :: (Quasi q, Ord k) => k -> v -> QWithAux (Map.Map k v) q () addBinding k v = tell (Map.singleton k v) -- in a computation with an auxiliar list, add an element to the list addElement :: Quasi q => elt -> QWithAux [elt] q () addElement elt = tell [elt] -- | Call 'lookupTypeNameWithLocals' first to ensure we have a 'Name' in the -- type namespace, then call 'dsReify'. -- See also Note [Using dsReifyTypeNameInfo when promoting instances] -- in Data.Singletons.Promote. dsReifyTypeNameInfo :: DsMonad q => Name -> q (Maybe DInfo) dsReifyTypeNameInfo ty_name = do mb_name <- lookupTypeNameWithLocals (nameBase ty_name) case mb_name of Just n -> dsReify n Nothing -> pure Nothing -- lift concatMap into a monad -- could this be more efficient? concatMapM :: (Monad monad, Monoid monoid, Traversable t) => (a -> monad monoid) -> t a -> monad monoid concatMapM fn list = do bss <- mapM fn list return $ fold bss -- make a one-element list listify :: a -> [a] listify = (:[]) fstOf3 :: (a,b,c) -> a fstOf3 (a,_,_) = a liftFst :: (a -> b) -> (a, c) -> (b, c) liftFst f (a, c) = (f a, c) liftSnd :: (a -> b) -> (c, a) -> (c, b) liftSnd f (c, a) = (c, f a) snocView :: [a] -> ([a], a) snocView [] = error "snocView nil" snocView [x] = ([], x) snocView (x : xs) = liftFst (x:) (snocView xs) partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) partitionWith f = go [] [] where go bs cs [] = (reverse bs, reverse cs) go bs cs (a:as) = case f a of Left b -> go (b:bs) cs as Right c -> go bs (c:cs) as partitionWithM :: Monad m => (a -> m (Either b c)) -> [a] -> m ([b], [c]) partitionWithM f = go [] [] where go bs cs [] = return (reverse bs, reverse cs) go bs cs (a:as) = do fa <- f a case fa of Left b -> go (b:bs) cs as Right c -> go bs (c:cs) as partitionLetDecs :: [DDec] -> ([DLetDec], [DDec]) partitionLetDecs = partitionWith (\case DLetDec ld -> Left ld dec -> Right dec) {-# INLINEABLE zipWith3M #-} zipWith3M :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWith3M f (a:as) (b:bs) = (:) <$> f a b <*> zipWith3M f as bs zipWith3M _ _ _ = return [] mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d]) mapAndUnzip3M _ [] = return ([],[],[]) mapAndUnzip3M f (x:xs) = do (r1, r2, r3) <- f x (rs1, rs2, rs3) <- mapAndUnzip3M f xs return (r1:rs1, r2:rs2, r3:rs3) -- is it a letter or underscore? isHsLetter :: Char -> Bool isHsLetter c = isLetter c || c == '_' singletons-2.5.1/tests/0000755000000000000000000000000007346545000013237 5ustar0000000000000000singletons-2.5.1/tests/ByHand.hs0000644000000000000000000006474707346545000014762 0ustar0000000000000000{- ByHand.hs (c) Richard Eisenberg 2012 rae@cs.brynmawr.edu Shows the derivations for the singleton definitions done by hand. This file is a great way to understand the singleton encoding better. -} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors -Wno-orphans #-} {-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures, GADTs, FlexibleInstances, FlexibleContexts, UndecidableInstances, RankNTypes, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, ScopedTypeVariables, LambdaCase, TemplateHaskell, EmptyCase, AllowAmbiguousTypes, TypeApplications, EmptyCase #-} module ByHand where import Data.Kind (Type) import Prelude hiding (Bool, False, True, Maybe, Just, Nothing, Either, Left, Right, map, zipWith, (&&), (||), (+), (-)) import Unsafe.Coerce import Data.Type.Equality hiding (type (==), apply) import Data.Proxy import Data.Singletons import Data.Singletons.Decide ----------------------------------- -- Original ADTs ------------------ ----------------------------------- data Nat :: Type where Zero :: Nat Succ :: Nat -> Nat deriving Eq data Bool :: Type where False :: Bool True :: Bool data Maybe :: Type -> Type where Nothing :: Maybe a Just :: a -> Maybe a deriving Eq -- Defined using names to avoid fighting with concrete syntax data List :: Type -> Type where Nil :: List a Cons :: a -> List a -> List a deriving Eq data Either :: Type -> Type -> Type where Left :: a -> Either a b Right :: b -> Either a b ----------------------------------- -- One-time definitions ----------- ----------------------------------- -- Promoted equality type class class PEq k where type (==) (a :: k) (b :: k) :: Bool -- omitting definition of /= -- Singleton type equality type class class SEq k where (%==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a == b) -- omitting definition of %/= type family If cond tru fls where If True tru fls = tru If False tru fls = fls sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c) sIf STrue b _ = b sIf SFalse _ c = c ----------------------------------- -- Auto-generated code ------------ ----------------------------------- -- Nat data instance Sing :: Nat -> Type where SZero :: Sing Zero SSucc :: Sing n -> Sing (Succ n) data SuccSym0 :: Nat ~> Nat type instance Apply SuccSym0 x = Succ x type family EqualsNat (a :: Nat) (b :: Nat) where EqualsNat Zero Zero = True EqualsNat (Succ a) (Succ b) = a == b EqualsNat (n1 :: Nat) (n2 :: Nat) = False instance PEq Nat where type a == b = EqualsNat a b instance SEq Nat where SZero %== SZero = STrue SZero %== (SSucc _) = SFalse (SSucc _) %== SZero = SFalse (SSucc n) %== (SSucc n') = n %== n' instance SDecide Nat where SZero %~ SZero = Proved Refl (SSucc m) %~ (SSucc n) = case m %~ n of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) SZero %~ (SSucc _) = Disproved (\case) (SSucc _) %~ SZero = Disproved (\case) instance SingI Zero where sing = SZero instance SingI n => SingI (Succ n) where sing = SSucc sing instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero fromSing (SSucc n) = Succ (fromSing n) toSing Zero = SomeSing SZero toSing (Succ n) = withSomeSing n (\n' -> SomeSing $ SSucc n') -- Bool data instance Sing :: Bool -> Type where SFalse :: Sing False STrue :: Sing True (&&) :: Bool -> Bool -> Bool False && _ = False True && x = x type family (a :: Bool) && (b :: Bool) :: Bool where False && _ = False True && x = x (%&&) :: forall (a :: Bool) (b :: Bool). Sing a -> Sing b -> Sing (a && b) SFalse %&& SFalse = SFalse SFalse %&& STrue = SFalse STrue %&& SFalse = SFalse STrue %&& STrue = STrue instance SingI False where sing = SFalse instance SingI True where sing = STrue instance SingKind Bool where type Demote Bool = Bool fromSing SFalse = False fromSing STrue = True toSing False = SomeSing SFalse toSing True = SomeSing STrue -- Maybe data instance Sing :: Maybe k -> Type where SNothing :: Sing Nothing SJust :: forall k (a :: k). Sing a -> Sing (Just a) type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) where EqualsMaybe Nothing Nothing = True EqualsMaybe (Just a) (Just a') = a == a' EqualsMaybe (x :: Maybe k) (y :: Maybe k) = False instance PEq a => PEq (Maybe a) where type m1 == m2 = EqualsMaybe m1 m2 instance SDecide k => SDecide (Maybe k) where SNothing %~ SNothing = Proved Refl (SJust x) %~ (SJust y) = case x %~ y of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) SNothing %~ (SJust _) = Disproved (\case) (SJust _) %~ SNothing = Disproved (\case) instance SEq k => SEq (Maybe k) where SNothing %== SNothing = STrue SNothing %== (SJust _) = SFalse (SJust _) %== SNothing = SFalse (SJust a) %== (SJust a') = a %== a' instance SingI (Nothing :: Maybe k) where sing = SNothing instance SingI a => SingI (Just (a :: k)) where sing = SJust sing instance SingKind k => SingKind (Maybe k) where type Demote (Maybe k) = Maybe (Demote k) fromSing SNothing = Nothing fromSing (SJust a) = Just (fromSing a) toSing Nothing = SomeSing SNothing toSing (Just x) = case toSing x :: SomeSing k of SomeSing x' -> SomeSing $ SJust x' -- List data instance Sing :: List k -> Type where SNil :: Sing Nil SCons :: forall k (h :: k) (t :: List k). Sing h -> Sing t -> Sing (Cons h t) type NilSym0 = Nil data ConsSym0 :: a ~> List a ~> List a type instance Apply ConsSym0 a = ConsSym1 a data ConsSym1 :: a -> List a ~> List a type instance Apply (ConsSym1 a) b = ConsSym2 a b type ConsSym2 a b = Cons a b type family EqualsList (a :: List k) (b :: List k) where EqualsList Nil Nil = True EqualsList (Cons a b) (Cons a' b') = (a == a') && (b == b') EqualsList (x :: List k) (y :: List k) = False instance PEq a => PEq (List a) where type l1 == l2 = EqualsList l1 l2 instance SEq k => SEq (List k) where SNil %== SNil = STrue SNil %== (SCons _ _) = SFalse (SCons _ _) %== SNil = SFalse (SCons a b) %== (SCons a' b') = (a %== a') %&& (b %== b') instance SDecide k => SDecide (List k) where SNil %~ SNil = Proved Refl (SCons h1 t1) %~ (SCons h2 t2) = case (h1 %~ h2, t1 %~ t2) of (Proved Refl, Proved Refl) -> Proved Refl (Disproved contra, _) -> Disproved (\Refl -> contra Refl) (_, Disproved contra) -> Disproved (\Refl -> contra Refl) SNil %~ (SCons _ _) = Disproved (\case) (SCons _ _) %~ SNil = Disproved (\case) instance SingI Nil where sing = SNil instance (SingI h, SingI t) => SingI (Cons (h :: k) (t :: List k)) where sing = SCons sing sing instance SingKind k => SingKind (List k) where type Demote (List k) = List (Demote k) fromSing SNil = Nil fromSing (SCons h t) = Cons (fromSing h) (fromSing t) toSing Nil = SomeSing SNil toSing (Cons h t) = case ( toSing h :: SomeSing k , toSing t :: SomeSing (List k) ) of (SomeSing h', SomeSing t') -> SomeSing $ SCons h' t' -- Either data instance Sing :: Either k1 k2 -> Type where SLeft :: forall k1 (a :: k1). Sing a -> Sing (Left a) SRight :: forall k2 (b :: k2). Sing b -> Sing (Right b) instance (SingI a) => SingI (Left (a :: k)) where sing = SLeft sing instance (SingI b) => SingI (Right (b :: k)) where sing = SRight sing instance (SingKind k1, SingKind k2) => SingKind (Either k1 k2) where type Demote (Either k1 k2) = Either (Demote k1) (Demote k2) fromSing (SLeft x) = Left (fromSing x) fromSing (SRight x) = Right (fromSing x) toSing (Left x) = case toSing x :: SomeSing k1 of SomeSing x' -> SomeSing $ SLeft x' toSing (Right x) = case toSing x :: SomeSing k2 of SomeSing x' -> SomeSing $ SRight x' instance (SDecide k1, SDecide k2) => SDecide (Either k1 k2) where (SLeft x) %~ (SLeft y) = case x %~ y of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) (SRight x) %~ (SRight y) = case x %~ y of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) (SLeft _) %~ (SRight _) = Disproved (\case) (SRight _) %~ (SLeft _) = Disproved (\case) -- Composite data Composite :: Type -> Type -> Type where MkComp :: Either (Maybe a) b -> Composite a b data instance Sing :: Composite k1 k2 -> Type where SMkComp :: forall k1 k2 (a :: Either (Maybe k1) k2). Sing a -> Sing (MkComp a) instance SingI a => SingI (MkComp (a :: Either (Maybe k1) k2)) where sing = SMkComp sing instance (SingKind k1, SingKind k2) => SingKind (Composite k1 k2) where type Demote (Composite k1 k2) = Composite (Demote k1) (Demote k2) fromSing (SMkComp x) = MkComp (fromSing x) toSing (MkComp x) = case toSing x :: SomeSing (Either (Maybe k1) k2) of SomeSing x' -> SomeSing $ SMkComp x' instance (SDecide k1, SDecide k2) => SDecide (Composite k1 k2) where (SMkComp x) %~ (SMkComp y) = case x %~ y of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) -- Empty data Empty data instance Sing :: Empty -> Type instance SingKind Empty where type Demote Empty = Empty fromSing = \case toSing x = SomeSing (case x of) -- Type data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) data Rep = Nat | Maybe Rep | Vec Rep Nat data instance Sing :: Type -> Type where SNat :: Sing Nat SMaybe :: Sing a -> Sing (Maybe a) SVec :: Sing a -> Sing n -> Sing (Vec a n) instance SingI Nat where sing = SNat instance SingI a => SingI (Maybe a) where sing = SMaybe sing instance (SingI a, SingI n) => SingI (Vec a n) where sing = SVec sing sing instance SingKind Type where type Demote Type = Rep fromSing SNat = Nat fromSing (SMaybe a) = Maybe (fromSing a) fromSing (SVec a n) = Vec (fromSing a) (fromSing n) toSing Nat = SomeSing SNat toSing (Maybe a) = case toSing a :: SomeSing Type of SomeSing a' -> SomeSing $ SMaybe a' toSing (Vec a n) = case ( toSing a :: SomeSing Type , toSing n :: SomeSing Nat) of (SomeSing a', SomeSing n') -> SomeSing $ SVec a' n' instance SDecide Type where SNat %~ SNat = Proved Refl SNat %~ (SMaybe {}) = Disproved (\case) SNat %~ (SVec {}) = Disproved (\case) (SMaybe {}) %~ SNat = Disproved (\case) (SMaybe a) %~ (SMaybe b) = case a %~ b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\Refl -> contra Refl) (SMaybe {}) %~ (SVec {}) = Disproved (\case) (SVec {}) %~ SNat = Disproved (\case) (SVec {}) %~ (SMaybe {}) = Disproved (\case) (SVec a1 n1) %~ (SVec a2 n2) = case (a1 %~ a2, n1 %~ n2) of (Proved Refl, Proved Refl) -> Proved Refl (Disproved contra, _) -> Disproved (\Refl -> contra Refl) (_, Disproved contra) -> Disproved (\Refl -> contra Refl) type family EqualsType (a :: Type) (b :: Type) where EqualsType a a = True EqualsType _ _ = False instance PEq Type where type a == b = EqualsType a b instance SEq Type where a %== b = case a %~ b of Proved Refl -> STrue Disproved _ -> unsafeCoerce SFalse ----------------------------------- -- Some example functions --------- ----------------------------------- isJust :: Maybe a -> Bool isJust Nothing = False isJust (Just _) = True type family IsJust (a :: Maybe k) :: Bool where IsJust Nothing = False IsJust (Just a) = True -- defunctionalization symbols data IsJustSym0 :: Maybe a ~> Bool type instance Apply IsJustSym0 a = IsJust a sIsJust :: Sing a -> Sing (IsJust a) sIsJust SNothing = SFalse sIsJust (SJust _) = STrue pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n type family Pred (a :: Nat) :: Nat where Pred Zero = Zero Pred (Succ n) = n data PredSym0 :: Nat ~> Nat type instance Apply PredSym0 a = Pred a sPred :: forall (t :: Nat). Sing t -> Sing (Pred t) sPred SZero = SZero sPred (SSucc n) = n map :: (a -> b) -> List a -> List b map _ Nil = Nil map f (Cons h t) = Cons (f h) (map f t) type family Map (f :: k1 ~> k2) (l :: List k1) :: List k2 where Map f Nil = Nil Map f (Cons h t) = Cons (Apply f h) (Map f t) -- defunctionalization symbols data MapSym1 :: (a ~> b) -> List a ~> List b data MapSym0 :: (a ~> b) ~> List a ~> List b type instance Apply (MapSym1 f) xs = Map f xs type instance Apply MapSym0 f = MapSym1 f sMap :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). (forall b. Proxy f -> Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a) sMap _ SNil = SNil sMap f (SCons h t) = SCons (f Proxy h) (sMap f t) -- Alternative implementation of sMap with Proxy outside of callback. -- Not generated by the library. sMap2 :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). Proxy f -> (forall b. Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a) sMap2 _ _ SNil = SNil sMap2 p f (SCons h t) = SCons (f h) (sMap2 p f t) -- test sMap foo :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)) foo = sMap (\(_ :: Proxy (TyCon1 Succ)) -> SSucc) (SCons (SSucc SZero) (SCons SZero SNil)) -- test sMap2 bar :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil)) bar = sMap2 (Proxy :: Proxy SuccSym0) (SSucc) (SCons (SSucc SZero) (SCons SZero SNil)) baz :: Sing (Cons Zero (Cons Zero Nil)) baz = sMap2 (Proxy :: Proxy PredSym0) (sPred) (SCons (SSucc SZero) (SCons SZero SNil)) zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys zipWith _ [] (_:_) = [] zipWith _ (_:_) [] = [] zipWith _ [] [] = [] type family ZipWith (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b) :: List c where ZipWith f (Cons x xs) (Cons y ys) = Cons (Apply (Apply f x) y) (ZipWith f xs ys) ZipWith f Nil (Cons z1 z2) = Nil ZipWith f (Cons z1 z2) Nil = Nil ZipWith f Nil Nil = Nil data ZipWithSym2 :: (a ~> b ~> c) -> List a -> List b ~> List c data ZipWithSym1 :: (a ~> b ~> c) -> List a ~> List b ~> List c data ZipWithSym0 :: (a ~> b ~> c) ~> List a ~> List b ~> List c type instance Apply (ZipWithSym2 f xs) ys = ZipWith f xs ys type instance Apply (ZipWithSym1 f) xs = ZipWithSym2 f xs type instance Apply ZipWithSym0 f = ZipWithSym1 f sZipWith :: forall a b c (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b). (forall (t1 :: a). Proxy k1 -> Sing t1 -> forall (t2 :: b). Sing t2 -> Sing (Apply (Apply k1 t1) t2)) -> Sing k2 -> Sing k3 -> Sing (ZipWith k1 k2 k3) sZipWith f (SCons x xs) (SCons y ys) = SCons (f Proxy x y) (sZipWith f xs ys) sZipWith _ SNil (SCons _ _) = SNil sZipWith _ (SCons _ _) SNil = SNil sZipWith _ SNil SNil = SNil either :: (a -> c) -> (b -> c) -> Either a b -> c either l _ (Left x) = l x either _ r (Right x) = r x type family Either_ (l :: a ~> c) (r :: b ~> c) (e :: Either a b) :: c where Either_ l r (Left x) = Apply l x Either_ l r (Right x) = Apply r x -- defunctionalization symbols data Either_Sym2 :: (a ~> c) -> (b ~> c) -> Either a b ~> c data Either_Sym1 :: (a ~> c) -> (b ~> c) ~> Either a b ~> c data Either_Sym0 :: (a ~> c) ~> (b ~> c) ~> Either a b ~> c type instance Apply (Either_Sym2 k1 k2) k3 = Either_ k1 k2 k3 type instance Apply (Either_Sym1 k1) k2 = Either_Sym2 k1 k2 type instance Apply Either_Sym0 k1 = Either_Sym1 k1 sEither :: forall a b c (l :: a ~> c) (r :: b ~> c) (e :: Either a b). (forall n. Proxy l -> Sing n -> Sing (Apply l n)) -> (forall n. Proxy r -> Sing n -> Sing (Apply r n)) -> Sing e -> Sing (Either_ l r e) sEither l _ (SLeft x) = l Proxy x sEither _ r (SRight x) = r Proxy x -- Alternative implementation of sEither with Proxy outside of callbacks. -- Not generated by the library. sEither2 :: forall a b c (l :: a ~> c) (r :: b ~> c) (e :: Either a b). Proxy l -> Proxy r -> (forall n. Sing n -> Sing (Apply l n)) -> (forall n. Sing n -> Sing (Apply r n)) -> Sing e -> Sing (Either_ l r e) sEither2 _ _ l _ (SLeft x) = l x sEither2 _ _ _ r (SRight x) = r x eitherFoo :: Sing (Succ (Succ Zero)) eitherFoo = sEither (\(_ :: Proxy SuccSym0) -> SSucc) (\(_ :: Proxy PredSym0) -> sPred) (SLeft (SSucc SZero)) eitherBar :: Sing Zero eitherBar = sEither2 (Proxy :: Proxy SuccSym0) (Proxy :: Proxy PredSym0) SSucc sPred (SRight (SSucc SZero)) eitherToNat :: Either Nat Nat -> Nat eitherToNat (Left x) = x eitherToNat (Right x) = x type family EitherToNat (e :: Either Nat Nat) :: Nat where EitherToNat (Left x) = x EitherToNat (Right x) = x sEitherToNat :: Sing a -> Sing (EitherToNat a) sEitherToNat (SLeft x) = x sEitherToNat (SRight x) = x liftMaybe :: (a -> b) -> Maybe a -> Maybe b liftMaybe _ Nothing = Nothing liftMaybe f (Just a) = Just (f a) type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where LiftMaybe f Nothing = Nothing LiftMaybe f (Just a) = Just (Apply f a) data LiftMaybeSym1 :: (a ~> b) -> Maybe a ~> Maybe b data LiftMaybeSym0 :: (a ~> b) ~> Maybe a ~> Maybe b type instance Apply (LiftMaybeSym1 k1) k2 = LiftMaybe k1 k2 type instance Apply LiftMaybeSym0 k1 = LiftMaybeSym1 k1 sLiftMaybe :: forall a b (f :: a ~> b) (x :: Maybe a). (forall (y :: a). Proxy f -> Sing y -> Sing (Apply f y)) -> Sing x -> Sing (LiftMaybe f x) sLiftMaybe _ SNothing = SNothing sLiftMaybe f (SJust a) = SJust (f Proxy a) (+) :: Nat -> Nat -> Nat Zero + x = x (Succ x) + y = Succ (x + y) type family (+) (m :: Nat) (n :: Nat) :: Nat where Zero + x = x (Succ x) + y = Succ (x + y) -- defunctionalization symbols data (+$$) :: Nat -> Nat ~> Nat data (+$) :: Nat ~> Nat ~> Nat type instance Apply ((+$$) k1) k2 = (+) k1 k2 type instance Apply (+$) k1 = (+$$) k1 (%+) :: Sing m -> Sing n -> Sing (m + n) SZero %+ x = x (SSucc x) %+ y = SSucc (x %+ y) (-) :: Nat -> Nat -> Nat Zero - _ = Zero (Succ x) - Zero = Succ x (Succ x) - (Succ y) = x - y type family (-) (m :: Nat) (n :: Nat) :: Nat where Zero - x = Zero (Succ x) - Zero = Succ x (Succ x) - (Succ y) = x - y data (-$$) :: Nat -> Nat ~> Nat data (-$) :: Nat ~> Nat ~> Nat type instance Apply ((-$$) k1) k2 = (-) k1 k2 type instance Apply (-$) k1 = (-$$) k1 (%-) :: Sing m -> Sing n -> Sing (m - n) SZero %- _ = SZero (SSucc x) %- SZero = SSucc x (SSucc x) %- (SSucc y) = x %- y isZero :: Nat -> Bool isZero n = if n == Zero then True else False type family IsZero (n :: Nat) :: Bool where IsZero n = If (n == Zero) True False data IsZeroSym0 :: Nat ~> Bool type instance Apply IsZeroSym0 a = IsZero a sIsZero :: Sing n -> Sing (IsZero n) sIsZero n = sIf (n %== SZero) STrue SFalse (||) :: Bool -> Bool -> Bool False || x = x True || _ = True type family (a :: Bool) || (b :: Bool) :: Bool where False || x = x True || x = True data (||$$) :: Bool -> Bool ~> Bool data (||$) :: Bool ~> Bool ~> Bool type instance Apply ((||$$) a) b = (||) a b type instance Apply (||$) a = (||$$) a (%||) :: Sing a -> Sing b -> Sing (a || b) SFalse %|| x = x STrue %|| _ = STrue {- contains :: Eq a => a -> List a -> Bool contains _ Nil = False contains elt (Cons h t) = (elt == h) || contains elt t -} type family Contains (a :: k) (b :: List k) :: Bool where Contains elt Nil = False Contains elt (Cons h t) = (elt == h) || (Contains elt t) data ContainsSym1 :: a -> List a ~> Bool data ContainsSym0 :: a ~> List a ~> Bool type instance Apply (ContainsSym1 a) b = Contains a b type instance Apply ContainsSym0 a = ContainsSym1 a {- sContains :: forall k. SEq k => forall (a :: k). Sing a -> forall (list :: List k). Sing list -> Sing (Contains a list) sContains _ SNil = SFalse sContains elt (SCons h t) = (elt %== h) %|| (sContains elt t) -} sContains :: forall a (t1 :: a) (t2 :: List a). SEq a => Sing t1 -> Sing t2 -> Sing (Contains t1 t2) sContains _ SNil = let lambda :: forall wild. Sing (Contains wild Nil) lambda = SFalse in lambda sContains elt (SCons h t) = let lambda :: forall elt h t. (elt ~ t1, (Cons h t) ~ t2) => Sing elt -> Sing h -> Sing t -> Sing (Contains elt (Cons h t)) lambda elt' h' t' = (elt' %== h') %|| sContains elt' t' in lambda elt h t {- cont :: Eq a => a -> List a -> Bool cont = \elt list -> case list of Nil -> False Cons h t -> (elt == h) || cont elt t -} type family Cont :: a ~> List a ~> Bool where Cont = Lambda10Sym0 data Lambda10Sym0 f where KindInferenceLambda10Sym0 :: (Lambda10Sym0 @@ arg) ~ Lambda10Sym1 arg => Proxy arg -> Lambda10Sym0 f type instance Lambda10Sym0 `Apply` x = Lambda10Sym1 x data Lambda10Sym1 a f where KindInferenceLambda10Sym1 :: (Lambda10Sym1 a @@ arg) ~ Lambda10Sym2 a arg => Proxy arg -> Lambda10Sym1 a f type instance (Lambda10Sym1 a) `Apply` b = Lambda10Sym2 a b type Lambda10Sym2 a b = Lambda10 a b type family Lambda10 a b where Lambda10 elt list = Case10 elt list list type family Case10 a b scrut where Case10 elt list Nil = False Case10 elt list (Cons h t) = (||$) @@ ((==$) @@ elt @@ h) @@ (Cont @@ elt @@ t) data (==$) f where (:###==$) :: ((==$) @@ arg) ~ (==$$) arg => Proxy arg -> (==$) f type instance (==$) `Apply` x = (==$$) x data (==$$) a f where (:###==$$) :: ((==$$) x @@ arg) ~ (==$$$) x arg => Proxy arg -> (==$$) x y type instance (==$$) a `Apply` b = (==$$$) a b type (==$$$) a b = (==) a b impNat :: forall m n. SingI n => Proxy n -> Sing m -> Sing (n + m) impNat _ sm = (sing :: Sing n) %+ sm callImpNat :: forall n m. Sing n -> Sing m -> Sing (n + m) callImpNat sn sm = withSingI sn (impNat (Proxy :: Proxy n) sm) instance Show (Sing (n :: Nat)) where show SZero = "SZero" show (SSucc n) = "SSucc (" ++ (show n) ++ ")" {- findIndices :: (a -> Bool) -> [a] -> [Nat] findIndices p ls = loop Zero ls where loop _ [] = [] loop n (x:xs) | p x = n : loop (Succ n) xs | otherwise = loop (Succ n) xs -} findIndices' :: forall a. (a -> Bool) -> [a] -> [Nat] findIndices' p ls = let loop :: Nat -> [a] -> [Nat] loop _ [] = [] loop n (x:xs) = case p x of True -> n : loop (Succ n) xs False -> loop (Succ n) xs in loop Zero ls type family FindIndices (f :: a ~> Bool) (ls :: List a) :: List Nat where FindIndices p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls type family Let123Loop p ls (arg1 :: Nat) (arg2 :: List a) :: List Nat where Let123Loop p ls z Nil = Nil Let123Loop p ls n (x `Cons` xs) = Case123 p ls n x xs (p @@ x) type family Case123 p ls n x xs scrut where Case123 p ls n x xs True = n `Cons` ((Let123LoopSym2 p ls) @@ (Succ n) @@ xs) Case123 p ls n x xs False = (Let123LoopSym2 p ls) @@ (Succ n) @@ xs data Let123LoopSym2 a b c where Let123LoopSym2KindInfernece :: ((Let123LoopSym2 a b @@ z) ~ Let123LoopSym3 a b z) => Proxy z -> Let123LoopSym2 a b c type instance Apply (Let123LoopSym2 a b) c = Let123LoopSym3 a b c data Let123LoopSym3 a b c d where KindInferenceLet123LoopSym3 :: ((Let123LoopSym3 a b c @@ z) ~ Let123LoopSym4 a b c z) => Proxy z -> Let123LoopSym3 a b c d type instance Apply (Let123LoopSym3 a b c) d = Let123LoopSym4 a b c d type Let123LoopSym4 a b c d = Let123Loop a b c d data FindIndicesSym0 a where KindInferenceFindIndicesSym0 :: (FindIndicesSym0 @@ z) ~ FindIndicesSym1 z => Proxy z -> FindIndicesSym0 a type instance Apply FindIndicesSym0 a = FindIndicesSym1 a data FindIndicesSym1 a b where KindInferenceFindIndicesSym1 :: (FindIndicesSym1 a @@ z) ~ FindIndicesSym2 a z => Proxy z -> FindIndicesSym1 a b type instance Apply (FindIndicesSym1 a) b = FindIndicesSym2 a b type FindIndicesSym2 a b = FindIndices a b sFindIndices :: forall a (t1 :: a ~> Bool) (t2 :: (List a)). Sing t1 -> Sing t2 -> Sing (FindIndicesSym0 @@ t1 @@ t2) sFindIndices sP sLs = let sLoop :: forall (u1 :: Nat). Sing u1 -> forall (u2 :: List a). Sing u2 -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2) sLoop _ SNil = SNil sLoop sN (sX `SCons` sXs) = case sP @@ sX of STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@ ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs) SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs in (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs fI :: forall a. (a -> Bool) -> [a] -> [Nat] fI = \p ls -> let loop :: Nat -> [a] -> [Nat] loop _ [] = [] loop n (x:xs) = case p x of True -> n : loop (Succ n) xs False -> loop (Succ n) xs in loop Zero ls type FI = Lambda22Sym0 type FISym0 = FI type family Lambda22 p ls where Lambda22 p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls data Lambda22Sym0 a where KindInferenceLambda22Sym0 :: (Lambda22Sym0 @@ z) ~ Lambda22Sym1 z => Proxy z -> Lambda22Sym0 a type instance Apply Lambda22Sym0 a = Lambda22Sym1 a data Lambda22Sym1 a b where KindInferenceLambda22Sym1 :: (Lambda22Sym1 a @@ z) ~ Lambda22Sym2 a z => Proxy z -> Lambda22Sym1 a b type instance Apply (Lambda22Sym1 a) b = Lambda22Sym2 a b type Lambda22Sym2 a b = Lambda22 a b {- sFI :: forall a (t1 :: a ~> Bool) (t2 :: List a). Sing t1 -> Sing t2 -> Sing (FISym0 @@ t1 @@ t2) sFI = unSingFun2 (singFun2 @FI (\p ls -> let lambda :: forall {-(t1 :: a ~> Bool)-} t1 t2. Sing t1 -> Sing t2 -> Sing (Lambda22Sym0 @@ t1 @@ t2) lambda sP sLs = let sLoop :: (Lambda22Sym0 @@ t1 @@ t2) ~ (Let123LoopSym2 t1 t2 @@ Zero @@ t2) => forall (u1 :: Nat). Sing u1 -> forall {-(u2 :: List a)-} u2. Sing u2 -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2) sLoop _ SNil = SNil sLoop sN (sX `SCons` sXs) = case sP @@ sX of STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@ ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs) SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs in (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs in lambda p ls )) -} ------------------------------------------------------------ data G a where MkG :: G Bool data instance Sing :: G a -> Type where SMkG :: Sing MkG singletons-2.5.1/tests/ByHand2.hs0000644000000000000000000001154507346545000015030 0ustar0000000000000000{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators, DefaultSignatures, ScopedTypeVariables, InstanceSigs, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} module ByHand2 where import Prelude hiding ( Eq(..), Ord(..), Bool(..), Ordering(..), not ) import Data.Kind (Type) import Data.Singletons (Sing) data Nat = Zero | Succ Nat data Bool = False | True data Ordering = LT | EQ | GT not :: Bool -> Bool not False = True not True = False class Eq a where (==) :: a -> a -> Bool (/=) :: a -> a -> Bool infix 4 ==, /= x == y = not (x /= y) x /= y = not (x == y) instance Eq Nat where Zero == Zero = True Zero == Succ _ = False Succ _ == Zero = False Succ x == Succ y = x == y data instance Sing :: Bool -> Type where SFalse :: Sing 'False STrue :: Sing 'True data instance Sing :: Nat -> Type where SZero :: Sing 'Zero SSucc :: Sing n -> Sing ('Succ n) type family Not (x :: Bool) :: Bool where Not 'True = 'False Not 'False = 'True sNot :: Sing b -> Sing (Not b) sNot STrue = SFalse sNot SFalse = STrue class PEq a where type (==) (x :: a) (y :: a) :: Bool type (/=) (x :: a) (y :: a) :: Bool type x == y = Not (x /= y) type x /= y = Not (x == y) instance PEq Nat where type 'Zero == 'Zero = 'True type 'Succ x == 'Zero = 'False type 'Zero == 'Succ x = 'False type 'Succ x == 'Succ y = x == y class SEq a where (%==) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x == y) (%/=) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y) default (%==) :: ((x == y) ~ (Not (x /= y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x == y) x %== y = sNot (x %/= y) default (%/=) :: ((x /= y) ~ (Not (x == y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y) x %/= y = sNot (x %== y) instance SEq Nat where (%==) :: forall (x :: Nat) (y :: Nat). Sing x -> Sing y -> Sing (x == y) SZero %== SZero = STrue SSucc _ %== SZero = SFalse SZero %== SSucc _ = SFalse SSucc x %== SSucc y = x %== y instance Eq Ordering where LT == LT = True LT == EQ = False LT == GT = False EQ == LT = False EQ == EQ = True EQ == GT = False GT == LT = False GT == EQ = False GT == GT = True class Eq a => Ord a where compare :: a -> a -> Ordering (<) :: a -> a -> Bool x < y = compare x y == LT class PEq a => POrd a where type Compare (x :: a) (y :: a) :: Ordering type (<) (x :: a) (y :: a) :: Bool type x < y = Compare x y == 'LT instance Ord Nat where compare Zero Zero = EQ compare Zero (Succ _) = LT compare (Succ _) Zero = GT compare (Succ a) (Succ b) = compare a b instance POrd Nat where type Compare 'Zero 'Zero = 'EQ type Compare 'Zero ('Succ x) = 'LT type Compare ('Succ x) 'Zero = 'GT type Compare ('Succ x) ('Succ y) = Compare x y data instance Sing :: Ordering -> Type where SLT :: Sing 'LT SEQ :: Sing 'EQ SGT :: Sing 'GT instance PEq Ordering where type 'LT == 'LT = 'True type 'LT == 'EQ = 'False type 'LT == 'GT = 'False type 'EQ == 'LT = 'False type 'EQ == 'EQ = 'True type 'EQ == 'GT = 'False type 'GT == 'LT = 'False type 'GT == 'EQ = 'False type 'GT == 'GT = 'True instance SEq Ordering where SLT %== SLT = STrue SLT %== SEQ = SFalse SLT %== SGT = SFalse SEQ %== SLT = SFalse SEQ %== SEQ = STrue SEQ %== SGT = SFalse SGT %== SLT = SFalse SGT %== SEQ = SFalse SGT %== SGT = STrue class SEq a => SOrd a where sCompare :: Sing (x :: a) -> Sing (y :: a) -> Sing (Compare x y) (%<) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x < y) default (%<) :: ((x < y) ~ (Compare x y == 'LT)) => Sing (x :: a) -> Sing (y :: a) -> Sing (x < y) x %< y = sCompare x y %== SLT instance SOrd Nat where sCompare SZero SZero = SEQ sCompare SZero (SSucc _) = SLT sCompare (SSucc _) SZero = SGT sCompare (SSucc x) (SSucc y) = sCompare x y class Pointed a where point :: a class PPointed a where type Point :: a class SPointed a where sPoint :: Sing (Point :: a) instance Pointed Nat where point = Zero instance PPointed Nat where type Point = 'Zero instance SPointed Nat where sPoint = SZero -------------------------------- class FD a b | a -> b where meth :: a -> a l2r :: a -> b instance FD Bool Nat where meth = not l2r False = Zero l2r True = Succ Zero t1 = meth True t2 = l2r False class PFD a b | a -> b where type Meth (x :: a) :: a type L2r (x :: a) :: b instance PFD Bool Nat where type Meth a = Not a type L2r 'False = 'Zero type L2r 'True = 'Succ 'Zero type T1 = Meth 'True type T2 = L2r 'False class SFD a b | a -> b where sMeth :: forall (x :: a). Sing x -> Sing (Meth x :: a) sL2r :: forall (x :: a). Sing x -> Sing (L2r x :: b) instance SFD Bool Nat where sMeth x = sNot x sL2r SFalse = SZero sL2r STrue = SSucc SZero sT1 = sMeth STrue sT2 :: Sing (T2 :: Nat) sT2 = sL2r SFalse singletons-2.5.1/tests/SingletonsTestSuite.hs0000644000000000000000000001047507346545000017601 0ustar0000000000000000module Main ( main ) where import Test.Tasty ( TestTree, defaultMain, testGroup ) import SingletonsTestSuiteUtils ( compileAndDumpStdTest, compileAndDumpTest , testCompileAndDumpGroup, ghcOpts -- , cleanFiles ) main :: IO () main = do -- cleanFiles We really need to parallelize the testsuite. defaultMain tests tests :: TestTree tests = testGroup "Testsuite" $ [ testCompileAndDumpGroup "Singletons" [ compileAndDumpStdTest "Nat" , compileAndDumpStdTest "Empty" , compileAndDumpStdTest "Maybe" , compileAndDumpStdTest "BoxUnBox" , compileAndDumpStdTest "Operators" , compileAndDumpStdTest "HigherOrder" , compileAndDumpStdTest "Contains" , compileAndDumpStdTest "AsPattern" , compileAndDumpStdTest "DataValues" , compileAndDumpStdTest "EqInstances" , compileAndDumpStdTest "CaseExpressions" , compileAndDumpStdTest "Star" , compileAndDumpStdTest "ReturnFunc" , compileAndDumpStdTest "Lambdas" , compileAndDumpStdTest "LambdasComprehensive" , compileAndDumpStdTest "Error" , compileAndDumpStdTest "TopLevelPatterns" , compileAndDumpStdTest "LetStatements" , compileAndDumpStdTest "LambdaCase" , compileAndDumpStdTest "Sections" , compileAndDumpStdTest "PatternMatching" , compileAndDumpStdTest "Records" , compileAndDumpStdTest "T29" , compileAndDumpStdTest "T33" , compileAndDumpStdTest "T54" , compileAndDumpStdTest "Classes" , compileAndDumpStdTest "Classes2" , compileAndDumpStdTest "FunDeps" , compileAndDumpStdTest "T78" , compileAndDumpStdTest "OrdDeriving" , compileAndDumpStdTest "BoundedDeriving" , compileAndDumpStdTest "BadBoundedDeriving" , compileAndDumpStdTest "EnumDeriving" , compileAndDumpStdTest "BadEnumDeriving" , compileAndDumpStdTest "Fixity" , compileAndDumpStdTest "Undef" , compileAndDumpStdTest "T124" , compileAndDumpStdTest "T136" , compileAndDumpStdTest "T136b" , compileAndDumpStdTest "T153" , compileAndDumpStdTest "T157" , compileAndDumpStdTest "T159" , compileAndDumpStdTest "T167" , compileAndDumpStdTest "T145" , compileAndDumpStdTest "PolyKinds" , compileAndDumpStdTest "PolyKindsApp" , compileAndDumpStdTest "T160" , compileAndDumpStdTest "T163" , compileAndDumpStdTest "T166" , compileAndDumpStdTest "T172" , compileAndDumpStdTest "T175" , compileAndDumpStdTest "T176" , compileAndDumpStdTest "T178" , compileAndDumpStdTest "T183" , compileAndDumpStdTest "T184" , compileAndDumpStdTest "T187" , compileAndDumpStdTest "T190" , compileAndDumpStdTest "ShowDeriving" , compileAndDumpStdTest "EmptyShowDeriving" , compileAndDumpStdTest "StandaloneDeriving" , compileAndDumpStdTest "T197" , compileAndDumpStdTest "T197b" , compileAndDumpStdTest "T200" , compileAndDumpStdTest "T206" , compileAndDumpStdTest "T209" , compileAndDumpStdTest "T216" , compileAndDumpStdTest "T226" , compileAndDumpStdTest "T229" , compileAndDumpStdTest "T249" , compileAndDumpStdTest "OverloadedStrings" , compileAndDumpStdTest "T271" , compileAndDumpStdTest "T287" , compileAndDumpStdTest "TypeRepTYPE" , compileAndDumpStdTest "T297" , compileAndDumpStdTest "T312" , compileAndDumpStdTest "T313" , compileAndDumpStdTest "T316" , compileAndDumpStdTest "T322" , compileAndDumpStdTest "NatSymbolReflexive" , compileAndDumpStdTest "T323" , compileAndDumpStdTest "T332" , compileAndDumpStdTest "T342" , compileAndDumpStdTest "FunctorLikeDeriving" , compileAndDumpStdTest "T353" , compileAndDumpStdTest "T358" , compileAndDumpStdTest "T371" ], testCompileAndDumpGroup "Promote" [ compileAndDumpStdTest "Constructors" , compileAndDumpStdTest "GenDefunSymbols" , compileAndDumpStdTest "Newtypes" , compileAndDumpStdTest "Pragmas" , compileAndDumpStdTest "Prelude" , compileAndDumpStdTest "T180" , compileAndDumpStdTest "T361" ], testGroup "Database client" [ compileAndDumpTest "GradingClient/Database" ghcOpts , compileAndDumpTest "GradingClient/Main" ghcOpts ], testCompileAndDumpGroup "InsertionSort" [ compileAndDumpStdTest "InsertionSortImp" ] ] singletons-2.5.1/tests/SingletonsTestSuiteUtils.hs0000644000000000000000000001711107346545000020614 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module SingletonsTestSuiteUtils ( compileAndDumpTest , compileAndDumpStdTest , testCompileAndDumpGroup , ghcOpts , cleanFiles ) where import Build_singletons ( ghcPath, ghcFlags, rootDir ) import Control.Exception ( Exception, throw ) import Data.List ( intercalate ) import System.Exit ( ExitCode(..) ) import System.FilePath ( takeBaseName, pathSeparator ) import System.IO ( IOMode(..), hGetContents, openFile ) import System.FilePath ( () ) import System.Process ( CreateProcess(..), StdStream(..) , createProcess, proc, waitForProcess , callCommand ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.Golden ( goldenVsFileDiff ) -- Some infractructure for handling external process errors newtype ProcessException = ProcessException String deriving newtype (Eq, Ord, Show) deriving anyclass Exception -- directory storing compile-and-run tests and golden files goldenPath :: FilePath goldenPath = rootDir "tests/compile-and-dump/" ghcVersion :: String ghcVersion = ".ghc86" -- GHC options used when running the tests ghcOpts :: [String] ghcOpts = ghcFlags ++ [ "-v0" , "-c" , "-ddump-splices" , "-dsuppress-uniques" , "-fforce-recomp" , "-fprint-explicit-kinds" , "-O0" , "-i" ++ goldenPath , "-XTemplateHaskell" , "-XDataKinds" , "-XKindSignatures" , "-XTypeFamilies" , "-XTypeOperators" , "-XMultiParamTypeClasses" , "-XGADTs" , "-XFlexibleInstances" , "-XUndecidableInstances" , "-XRankNTypes" , "-XScopedTypeVariables" , "-XPolyKinds" , "-XFlexibleContexts" , "-XIncoherentInstances" , "-XLambdaCase" , "-XUnboxedTuples" , "-XInstanceSigs" , "-XDefaultSignatures" , "-XCPP" , "-XStandaloneDeriving" , "-XTypeApplications" , "-XEmptyCase" , "-XNoStarIsType" ] -- Compile a test using specified GHC options. Save output to file, filter with -- sed and compare it with golden file. This function also builds golden file -- from a template file. Putting it here is a bit of a hack but it's easy and it -- works. -- -- First parameter is a path to the test file relative to goldenPath directory -- with no ".hs". compileAndDumpTest :: FilePath -> [String] -> TestTree compileAndDumpTest testName opts = goldenVsFileDiff (takeBaseName testName) (\ref new -> ["diff", "-w", "-B", ref, new]) -- see Note [Diff options] goldenFilePath actualFilePath compileWithGHC where testPath = testName ++ ".hs" templateFilePath = goldenPath ++ testName ++ ghcVersion ++ ".template" goldenFilePath = goldenPath ++ testName ++ ".golden" actualFilePath = goldenPath ++ testName ++ ".actual" compileWithGHC :: IO () compileWithGHC = do hActualFile <- openFile actualFilePath WriteMode (_, _, _, pid) <- createProcess (proc ghcPath (testPath : opts)) { std_out = UseHandle hActualFile , std_err = UseHandle hActualFile , cwd = Just goldenPath } _ <- waitForProcess pid -- see Note [Ignore exit code] filterWithSed actualFilePath -- see Note [Normalization with sed] buildGoldenFile templateFilePath goldenFilePath return () -- Compile-and-dump test using standard GHC options defined by the testsuite. -- It takes two parameters: name of a file containing a test (no ".hs" -- extension) and directory where the test is located (relative to -- goldenPath). Test name and path are passed separately so that this function -- can be used easily with testCompileAndDumpGroup. compileAndDumpStdTest :: FilePath -> FilePath -> TestTree compileAndDumpStdTest testName testPath = compileAndDumpTest (testPath ++ (pathSeparator : testName)) ghcOpts -- A convenience function for defining a group of compile-and-dump tests stored -- in the same subdirectory. It takes the name of subdirectory and list of -- functions that given the name of subdirectory create a TestTree. Designed for -- use with compileAndDumpStdTest. testCompileAndDumpGroup :: FilePath -> [FilePath -> TestTree] -> TestTree testCompileAndDumpGroup testDir tests = testGroup testDir $ map ($ testDir) tests -- Note [Ignore exit code] -- ~~~~~~~~~~~~~~~~~~~~~~~ ---- It may happen that compilation of a source file fails. We could find out -- whether that happened by inspecting the exit code of GHC process. But it -- would be tricky to get a helpful message from the failing test: we would need -- to display stderr which we just wrote into a file. Luckliy we don't have to -- do that - we can ignore the problem here and let the test fail when the -- actual file is compared with the golden file. -- Note [Diff options] -- ~~~~~~~~~~~~~~~~~~~ -- -- We use following diff options: -- -w - Ignore all white space. -- -B - Ignore changes whose lines are all blank. -- Note [Normalization with sed] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- -- Output file is normalized with sed. Line numbers generated in splices: -- -- Foo:(40,3)-(42,4) -- Foo.hs:7:3: -- Equals_1235967303 -- -- are turned into: -- -- Foo:(0,0)-(0,0) -- Foo.hs:0:0: -- Equals_0123456789 -- -- This allows to insert comments into test file without the need to modify the -- golden file to adjust line numbers. -- -- Note that GNU sed (on Linux) and BSD sed (on MacOS) are slightly different. -- We use conditional compilation to deal with this. filterWithSed :: FilePath -> IO () filterWithSed file = runProcessWithOpts CreatePipe "sed" #ifdef darwin_HOST_OS [ "-i", "''" #else [ "-i" #endif , "-e", "'s/([0-9]*,[0-9]*)-([0-9]*,[0-9]*)/(0,0)-(0,0)/g'" , "-e", "'s/:[0-9][0-9]*:[0-9][0-9]*/:0:0/g'" , "-e", "'s/:[0-9]*:[0-9]*-[0-9]*/:0:0:/g'" , "-e", "'s/[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/0123456789/g'" , "-e", "'s/[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/0123456789876543210/g'" , "-e", "'s/[!#$%&*+./>]\\{10\\}/%%%%%%%%%%/g'" , "-e", "'s/[!#$%&*+./>]\\{19\\}/%%%%%%%%%%%%%%%%%%%/g'" -- Remove pretty-printed references to the singletons package -- (e.g., turn `singletons-2.4.1:Sing` into `Sing`) to make the output -- more stable. , "-e", "'s/singletons-[0-9]\\+\\(\\.[0-9]\\+\\)*://g'" , file ] buildGoldenFile :: FilePath -> FilePath -> IO () buildGoldenFile templateFilePath goldenFilePath = do hGoldenFile <- openFile goldenFilePath WriteMode runProcessWithOpts (UseHandle hGoldenFile) "awk" [ "-f", goldenPath "buildGoldenFiles.awk" , templateFilePath ] runProcessWithOpts :: StdStream -> String -> [String] -> IO () runProcessWithOpts stdout program opts = do (_, _, Just serr, pid) <- createProcess (proc "bash" ["-c", (intercalate " " (program : opts))]) { std_out = stdout , std_err = CreatePipe } ecode <- waitForProcess pid case ecode of ExitSuccess -> return () ExitFailure _ -> do err <- hGetContents serr -- Text would be faster than String, but this is -- a corner case so probably not worth it. throw $ ProcessException ("Error when running " ++ program ++ ":\n" ++ err) cleanFiles :: IO () cleanFiles = callCommand $ "rm -f " ++ rootDir "tests/compile-and-dump/*/*.{hi,o}" singletons-2.5.1/tests/compile-and-dump/GradingClient/0000755000000000000000000000000007346545000021104 5ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/GradingClient/Database.ghc86.template0000755000000000000000000034674507346545000025311 0ustar0000000000000000GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Nat = Zero | Succ Nat deriving (Eq, Ord) |] ======> data Nat = Zero | Succ Nat deriving (Eq, Ord) type ZeroSym0 = Zero type SuccSym1 (t0123456789876543210 :: Nat) = Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat where SuccSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where Equals_0123456789876543210 Zero Zero = TrueSym0 Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 instance PEq Nat where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: Nat -> Type where SZero :: Sing Zero SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) type SNat = (Sing :: Nat -> Type) instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero fromSing (SSucc b) = Succ (fromSing b) toSing Zero = SomeSing SZero toSing (Succ (b :: Demote Nat)) = case toSing b :: SomeSing Nat of { SomeSing c -> SomeSing (SSucc c) } instance SOrd Nat => SOrd Nat where sCompare :: forall (t1 :: Nat) (t2 :: Nat). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) -> Type) t1) t2) sCompare SZero SZero = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil) sCompare SZero (SSucc _) = SLT sCompare (SSucc _) SZero = SGT instance SEq Nat => SEq Nat where (%==) SZero SZero = STrue (%==) SZero (SSucc _) = SFalse (%==) (SSucc _) SZero = SFalse (%==) (SSucc a) (SSucc b) = ((%==) a) b instance SDecide Nat => SDecide Nat where (%~) SZero SZero = Proved Refl (%~) SZero (SSucc _) = Disproved (\ x -> case x of) (%~) (SSucc _) SZero = Disproved (\ x -> case x of) (%~) (SSucc a) (SSucc b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SingI Zero where sing = SZero instance SingI n => SingI (Succ (n :: Nat)) where sing = SSucc sing instance SingI (SuccSym0 :: (~>) Nat Nat) where sing = (singFun1 @SuccSym0) SSucc instance SingI (TyCon1 Succ :: (~>) Nat Nat) where sing = (singFun1 @(TyCon1 Succ)) SSucc GradingClient/Database.hs:(0,0)-(0,0): Splicing declarations singletons [d| append :: Schema -> Schema -> Schema append (Sch s1) (Sch s2) = Sch (s1 ++ s2) attrNotIn :: Attribute -> Schema -> Bool attrNotIn _ (Sch []) = True attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) = (name /= name') && (attrNotIn (Attr name u) (Sch t)) disjoint :: Schema -> Schema -> Bool disjoint (Sch []) _ = True disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) occurs :: [AChar] -> Schema -> Bool occurs _ (Sch []) = False occurs name (Sch ((Attr name' _) : attrs)) = name == name' || occurs name (Sch attrs) lookup :: [AChar] -> Schema -> U lookup _ (Sch []) = undefined lookup name (Sch ((Attr name' u) : attrs)) = if name == name' then u else lookup name (Sch attrs) data U = BOOL | STRING | NAT | VEC U Nat deriving (Read, Eq, Show) data AChar = CA | CB | CC | CD | CE | CF | CG | CH | CI | CJ | CK | CL | CM | CN | CO | CP | CQ | CR | CS | CT | CU | CV | CW | CX | CY | CZ deriving (Read, Show, Eq) data Attribute = Attr [AChar] U data Schema = Sch [Attribute] |] ======> data U = BOOL | STRING | NAT | VEC U Nat deriving (Read, Eq, Show) data AChar = CA | CB | CC | CD | CE | CF | CG | CH | CI | CJ | CK | CL | CM | CN | CO | CP | CQ | CR | CS | CT | CU | CV | CW | CX | CY | CZ deriving (Read, Show, Eq) data Attribute = Attr [AChar] U data Schema = Sch [Attribute] append :: Schema -> Schema -> Schema append (Sch s1) (Sch s2) = Sch (s1 ++ s2) attrNotIn :: Attribute -> Schema -> Bool attrNotIn _ (Sch []) = True attrNotIn (Attr name u) (Sch (Attr name' _ : t)) = ((name /= name') && (attrNotIn ((Attr name) u)) (Sch t)) disjoint :: Schema -> Schema -> Bool disjoint (Sch []) _ = True disjoint (Sch (h : t)) s = ((attrNotIn h) s && (disjoint (Sch t)) s) occurs :: [AChar] -> Schema -> Bool occurs _ (Sch []) = False occurs name (Sch (Attr name' _ : attrs)) = ((name == name') || (occurs name) (Sch attrs)) lookup :: [AChar] -> Schema -> U lookup _ (Sch []) = undefined lookup name (Sch (Attr name' u : attrs)) = if (name == name') then u else (lookup name) (Sch attrs) type BOOLSym0 = BOOL type STRINGSym0 = STRING type NATSym0 = NAT type VECSym2 (t0123456789876543210 :: U) (t0123456789876543210 :: Nat) = VEC t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (VECSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) VECSym1KindInference) ()) data VECSym1 (t0123456789876543210 :: U) :: (~>) Nat U where VECSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (VECSym1 t0123456789876543210) arg) (VECSym2 t0123456789876543210 arg) => VECSym1 t0123456789876543210 t0123456789876543210 type instance Apply (VECSym1 t0123456789876543210) t0123456789876543210 = VEC t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings VECSym0 where suppressUnusedWarnings = snd (((,) VECSym0KindInference) ()) data VECSym0 :: (~>) U ((~>) Nat U) where VECSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) => VECSym0 t0123456789876543210 type instance Apply VECSym0 t0123456789876543210 = VECSym1 t0123456789876543210 type CASym0 = CA type CBSym0 = CB type CCSym0 = CC type CDSym0 = CD type CESym0 = CE type CFSym0 = CF type CGSym0 = CG type CHSym0 = CH type CISym0 = CI type CJSym0 = CJ type CKSym0 = CK type CLSym0 = CL type CMSym0 = CM type CNSym0 = CN type COSym0 = CO type CPSym0 = CP type CQSym0 = CQ type CRSym0 = CR type CSSym0 = CS type CTSym0 = CT type CUSym0 = CU type CVSym0 = CV type CWSym0 = CW type CXSym0 = CX type CYSym0 = CY type CZSym0 = CZ type AttrSym2 (t0123456789876543210 :: [AChar]) (t0123456789876543210 :: U) = Attr t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (AttrSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) AttrSym1KindInference) ()) data AttrSym1 (t0123456789876543210 :: [AChar]) :: (~>) U Attribute where AttrSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (AttrSym1 t0123456789876543210) arg) (AttrSym2 t0123456789876543210 arg) => AttrSym1 t0123456789876543210 t0123456789876543210 type instance Apply (AttrSym1 t0123456789876543210) t0123456789876543210 = Attr t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings AttrSym0 where suppressUnusedWarnings = snd (((,) AttrSym0KindInference) ()) data AttrSym0 :: (~>) [AChar] ((~>) U Attribute) where AttrSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) => AttrSym0 t0123456789876543210 type instance Apply AttrSym0 t0123456789876543210 = AttrSym1 t0123456789876543210 type SchSym1 (t0123456789876543210 :: [Attribute]) = Sch t0123456789876543210 instance SuppressUnusedWarnings SchSym0 where suppressUnusedWarnings = snd (((,) SchSym0KindInference) ()) data SchSym0 :: (~>) [Attribute] Schema where SchSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) => SchSym0 t0123456789876543210 type instance Apply SchSym0 t0123456789876543210 = Sch t0123456789876543210 type Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference :: forall name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 u0123456789876543210 attrs0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 u0123456789876543210 name'0123456789876543210 name0123456789876543210) attrs0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 u0123456789876543210 name'0123456789876543210 name0123456789876543210 attrs0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall name0123456789876543210 name'0123456789876543210 u0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 name0123456789876543210 name'0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 u0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name'0123456789876543210 name0123456789876543210) u0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym3 name'0123456789876543210 name0123456789876543210 u0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall name0123456789876543210 name'0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 name'0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210) name'0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 name0123456789876543210 name'0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall name0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 name0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 name0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs where Let0123456789876543210Scrutinee_0123456789876543210 name name' u attrs = Apply (Apply (==@#@$) name) name' type family Case_0123456789876543210 name name' u attrs t where Case_0123456789876543210 name name' u attrs 'True = u Case_0123456789876543210 name name' u attrs 'False = Apply (Apply LookupSym0 name) (Apply SchSym0 attrs) type LookupSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = Lookup a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (LookupSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) LookupSym1KindInference) ()) data LookupSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema U where LookupSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (LookupSym1 a0123456789876543210) arg) (LookupSym2 a0123456789876543210 arg) => LookupSym1 a0123456789876543210 a0123456789876543210 type instance Apply (LookupSym1 a0123456789876543210) a0123456789876543210 = Lookup a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings LookupSym0 where suppressUnusedWarnings = snd (((,) LookupSym0KindInference) ()) data LookupSym0 :: (~>) [AChar] ((~>) Schema U) where LookupSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) => LookupSym0 a0123456789876543210 type instance Apply LookupSym0 a0123456789876543210 = LookupSym1 a0123456789876543210 type OccursSym2 (a0123456789876543210 :: [AChar]) (a0123456789876543210 :: Schema) = Occurs a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (OccursSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) OccursSym1KindInference) ()) data OccursSym1 (a0123456789876543210 :: [AChar]) :: (~>) Schema Bool where OccursSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (OccursSym1 a0123456789876543210) arg) (OccursSym2 a0123456789876543210 arg) => OccursSym1 a0123456789876543210 a0123456789876543210 type instance Apply (OccursSym1 a0123456789876543210) a0123456789876543210 = Occurs a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings OccursSym0 where suppressUnusedWarnings = snd (((,) OccursSym0KindInference) ()) data OccursSym0 :: (~>) [AChar] ((~>) Schema Bool) where OccursSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) => OccursSym0 a0123456789876543210 type instance Apply OccursSym0 a0123456789876543210 = OccursSym1 a0123456789876543210 type AttrNotInSym2 (a0123456789876543210 :: Attribute) (a0123456789876543210 :: Schema) = AttrNotIn a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (AttrNotInSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) AttrNotInSym1KindInference) ()) data AttrNotInSym1 (a0123456789876543210 :: Attribute) :: (~>) Schema Bool where AttrNotInSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (AttrNotInSym1 a0123456789876543210) arg) (AttrNotInSym2 a0123456789876543210 arg) => AttrNotInSym1 a0123456789876543210 a0123456789876543210 type instance Apply (AttrNotInSym1 a0123456789876543210) a0123456789876543210 = AttrNotIn a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings AttrNotInSym0 where suppressUnusedWarnings = snd (((,) AttrNotInSym0KindInference) ()) data AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool) where AttrNotInSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) => AttrNotInSym0 a0123456789876543210 type instance Apply AttrNotInSym0 a0123456789876543210 = AttrNotInSym1 a0123456789876543210 type DisjointSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = Disjoint a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (DisjointSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) DisjointSym1KindInference) ()) data DisjointSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Bool where DisjointSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (DisjointSym1 a0123456789876543210) arg) (DisjointSym2 a0123456789876543210 arg) => DisjointSym1 a0123456789876543210 a0123456789876543210 type instance Apply (DisjointSym1 a0123456789876543210) a0123456789876543210 = Disjoint a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings DisjointSym0 where suppressUnusedWarnings = snd (((,) DisjointSym0KindInference) ()) data DisjointSym0 :: (~>) Schema ((~>) Schema Bool) where DisjointSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) => DisjointSym0 a0123456789876543210 type instance Apply DisjointSym0 a0123456789876543210 = DisjointSym1 a0123456789876543210 type AppendSym2 (a0123456789876543210 :: Schema) (a0123456789876543210 :: Schema) = Append a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (AppendSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) AppendSym1KindInference) ()) data AppendSym1 (a0123456789876543210 :: Schema) :: (~>) Schema Schema where AppendSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (AppendSym1 a0123456789876543210) arg) (AppendSym2 a0123456789876543210 arg) => AppendSym1 a0123456789876543210 a0123456789876543210 type instance Apply (AppendSym1 a0123456789876543210) a0123456789876543210 = Append a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings AppendSym0 where suppressUnusedWarnings = snd (((,) AppendSym0KindInference) ()) data AppendSym0 :: (~>) Schema ((~>) Schema Schema) where AppendSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) => AppendSym0 a0123456789876543210 type instance Apply AppendSym0 a0123456789876543210 = AppendSym1 a0123456789876543210 type family Lookup (a :: [AChar]) (a :: Schema) :: U where Lookup _ (Sch '[]) = UndefinedSym0 Lookup name (Sch ( '(:) (Attr name' u) attrs)) = Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) type family Occurs (a :: [AChar]) (a :: Schema) :: Bool where Occurs _ (Sch '[]) = FalseSym0 Occurs name (Sch ( '(:) (Attr name' _) attrs)) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) name) name')) (Apply (Apply OccursSym0 name) (Apply SchSym0 attrs)) type family AttrNotIn (a :: Attribute) (a :: Schema) :: Bool where AttrNotIn _ (Sch '[]) = TrueSym0 AttrNotIn (Attr name u) (Sch ( '(:) (Attr name' _) t)) = Apply (Apply (&&@#@$) (Apply (Apply (/=@#@$) name) name')) (Apply (Apply AttrNotInSym0 (Apply (Apply AttrSym0 name) u)) (Apply SchSym0 t)) type family Disjoint (a :: Schema) (a :: Schema) :: Bool where Disjoint (Sch '[]) _ = TrueSym0 Disjoint (Sch ( '(:) h t)) s = Apply (Apply (&&@#@$) (Apply (Apply AttrNotInSym0 h) s)) (Apply (Apply DisjointSym0 (Apply SchSym0 t)) s) type family Append (a :: Schema) (a :: Schema) :: Schema where Append (Sch s1) (Sch s2) = Apply SchSym0 (Apply (Apply (++@#@$) s1) s2) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: U) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ BOOL a_0123456789876543210 = Apply (Apply ShowStringSym0 "BOOL") a_0123456789876543210 ShowsPrec_0123456789876543210 _ STRING a_0123456789876543210 = Apply (Apply ShowStringSym0 "STRING") a_0123456789876543210 ShowsPrec_0123456789876543210 _ NAT a_0123456789876543210 = Apply (Apply ShowStringSym0 "NAT") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (VEC arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "VEC ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: U) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) U ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow U where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: AChar) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ CA a_0123456789876543210 = Apply (Apply ShowStringSym0 "CA") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CB a_0123456789876543210 = Apply (Apply ShowStringSym0 "CB") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CC a_0123456789876543210 = Apply (Apply ShowStringSym0 "CC") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CD a_0123456789876543210 = Apply (Apply ShowStringSym0 "CD") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CE a_0123456789876543210 = Apply (Apply ShowStringSym0 "CE") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CF a_0123456789876543210 = Apply (Apply ShowStringSym0 "CF") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CG a_0123456789876543210 = Apply (Apply ShowStringSym0 "CG") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CH a_0123456789876543210 = Apply (Apply ShowStringSym0 "CH") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CI a_0123456789876543210 = Apply (Apply ShowStringSym0 "CI") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CJ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CJ") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CK a_0123456789876543210 = Apply (Apply ShowStringSym0 "CK") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CL a_0123456789876543210 = Apply (Apply ShowStringSym0 "CL") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CM a_0123456789876543210 = Apply (Apply ShowStringSym0 "CM") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CN a_0123456789876543210 = Apply (Apply ShowStringSym0 "CN") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CO a_0123456789876543210 = Apply (Apply ShowStringSym0 "CO") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CP a_0123456789876543210 = Apply (Apply ShowStringSym0 "CP") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CQ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CQ") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CR a_0123456789876543210 = Apply (Apply ShowStringSym0 "CR") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CS a_0123456789876543210 = Apply (Apply ShowStringSym0 "CS") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CT a_0123456789876543210 = Apply (Apply ShowStringSym0 "CT") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CU a_0123456789876543210 = Apply (Apply ShowStringSym0 "CU") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CV a_0123456789876543210 = Apply (Apply ShowStringSym0 "CV") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CW a_0123456789876543210 = Apply (Apply ShowStringSym0 "CW") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CX a_0123456789876543210 = Apply (Apply ShowStringSym0 "CX") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CY a_0123456789876543210 = Apply (Apply ShowStringSym0 "CY") a_0123456789876543210 ShowsPrec_0123456789876543210 _ CZ a_0123456789876543210 = Apply (Apply ShowStringSym0 "CZ") a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: AChar) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) AChar ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow AChar where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: U) (b :: U) :: Bool where Equals_0123456789876543210 BOOL BOOL = TrueSym0 Equals_0123456789876543210 STRING STRING = TrueSym0 Equals_0123456789876543210 NAT NAT = TrueSym0 Equals_0123456789876543210 (VEC a a) (VEC b b) = (&&) ((==) a b) ((==) a b) Equals_0123456789876543210 (_ :: U) (_ :: U) = FalseSym0 instance PEq U where type (==) a b = Equals_0123456789876543210 a b type family Equals_0123456789876543210 (a :: AChar) (b :: AChar) :: Bool where Equals_0123456789876543210 CA CA = TrueSym0 Equals_0123456789876543210 CB CB = TrueSym0 Equals_0123456789876543210 CC CC = TrueSym0 Equals_0123456789876543210 CD CD = TrueSym0 Equals_0123456789876543210 CE CE = TrueSym0 Equals_0123456789876543210 CF CF = TrueSym0 Equals_0123456789876543210 CG CG = TrueSym0 Equals_0123456789876543210 CH CH = TrueSym0 Equals_0123456789876543210 CI CI = TrueSym0 Equals_0123456789876543210 CJ CJ = TrueSym0 Equals_0123456789876543210 CK CK = TrueSym0 Equals_0123456789876543210 CL CL = TrueSym0 Equals_0123456789876543210 CM CM = TrueSym0 Equals_0123456789876543210 CN CN = TrueSym0 Equals_0123456789876543210 CO CO = TrueSym0 Equals_0123456789876543210 CP CP = TrueSym0 Equals_0123456789876543210 CQ CQ = TrueSym0 Equals_0123456789876543210 CR CR = TrueSym0 Equals_0123456789876543210 CS CS = TrueSym0 Equals_0123456789876543210 CT CT = TrueSym0 Equals_0123456789876543210 CU CU = TrueSym0 Equals_0123456789876543210 CV CV = TrueSym0 Equals_0123456789876543210 CW CW = TrueSym0 Equals_0123456789876543210 CX CX = TrueSym0 Equals_0123456789876543210 CY CY = TrueSym0 Equals_0123456789876543210 CZ CZ = TrueSym0 Equals_0123456789876543210 (_ :: AChar) (_ :: AChar) = FalseSym0 instance PEq AChar where type (==) a b = Equals_0123456789876543210 a b sLookup :: forall (t :: [AChar]) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply LookupSym0 t) t :: U) sOccurs :: forall (t :: [AChar]) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply OccursSym0 t) t :: Bool) sAttrNotIn :: forall (t :: Attribute) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply AttrNotInSym0 t) t :: Bool) sDisjoint :: forall (t :: Schema) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply DisjointSym0 t) t :: Bool) sAppend :: forall (t :: Schema) (t :: Schema). Sing t -> Sing t -> Sing (Apply (Apply AppendSym0 t) t :: Schema) sLookup _ (SSch SNil) = sUndefined sLookup (sName :: Sing name) (SSch (SCons (SAttr (sName' :: Sing name') (sU :: Sing u)) (sAttrs :: Sing attrs))) = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) sScrutinee_0123456789876543210 = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) sName' in (case sScrutinee_0123456789876543210 of STrue -> sU SFalse -> (applySing ((applySing ((singFun2 @LookupSym0) sLookup)) sName)) ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) :: Sing (Case_0123456789876543210 name name' u attrs (Let0123456789876543210Scrutinee_0123456789876543210Sym4 name name' u attrs) :: U) sOccurs _ (SSch SNil) = SFalse sOccurs (sName :: Sing name) (SSch (SCons (SAttr (sName' :: Sing name') _) (sAttrs :: Sing attrs))) = (applySing ((applySing ((singFun2 @(||@#@$)) (%||))) ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sName)) sName'))) ((applySing ((applySing ((singFun2 @OccursSym0) sOccurs)) sName)) ((applySing ((singFun1 @SchSym0) SSch)) sAttrs)) sAttrNotIn _ (SSch SNil) = STrue sAttrNotIn (SAttr (sName :: Sing name) (sU :: Sing u)) (SSch (SCons (SAttr (sName' :: Sing name') _) (sT :: Sing t))) = (applySing ((applySing ((singFun2 @(&&@#@$)) (%&&))) ((applySing ((applySing ((singFun2 @(/=@#@$)) (%/=))) sName)) sName'))) ((applySing ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sName)) sU))) ((applySing ((singFun1 @SchSym0) SSch)) sT)) sDisjoint (SSch SNil) _ = STrue sDisjoint (SSch (SCons (sH :: Sing h) (sT :: Sing t))) (sS :: Sing s) = (applySing ((applySing ((singFun2 @(&&@#@$)) (%&&))) ((applySing ((applySing ((singFun2 @AttrNotInSym0) sAttrNotIn)) sH)) sS))) ((applySing ((applySing ((singFun2 @DisjointSym0) sDisjoint)) ((applySing ((singFun1 @SchSym0) SSch)) sT))) sS) sAppend (SSch (sS1 :: Sing s1)) (SSch (sS2 :: Sing s2)) = (applySing ((singFun1 @SchSym0) SSch)) ((applySing ((applySing ((singFun2 @(++@#@$)) (%++))) sS1)) sS2) instance SingI (LookupSym0 :: (~>) [AChar] ((~>) Schema U)) where sing = (singFun2 @LookupSym0) sLookup instance SingI d => SingI (LookupSym1 (d :: [AChar]) :: (~>) Schema U) where sing = (singFun1 @(LookupSym1 (d :: [AChar]))) (sLookup (sing @d)) instance SingI (OccursSym0 :: (~>) [AChar] ((~>) Schema Bool)) where sing = (singFun2 @OccursSym0) sOccurs instance SingI d => SingI (OccursSym1 (d :: [AChar]) :: (~>) Schema Bool) where sing = (singFun1 @(OccursSym1 (d :: [AChar]))) (sOccurs (sing @d)) instance SingI (AttrNotInSym0 :: (~>) Attribute ((~>) Schema Bool)) where sing = (singFun2 @AttrNotInSym0) sAttrNotIn instance SingI d => SingI (AttrNotInSym1 (d :: Attribute) :: (~>) Schema Bool) where sing = (singFun1 @(AttrNotInSym1 (d :: Attribute))) (sAttrNotIn (sing @d)) instance SingI (DisjointSym0 :: (~>) Schema ((~>) Schema Bool)) where sing = (singFun2 @DisjointSym0) sDisjoint instance SingI d => SingI (DisjointSym1 (d :: Schema) :: (~>) Schema Bool) where sing = (singFun1 @(DisjointSym1 (d :: Schema))) (sDisjoint (sing @d)) instance SingI (AppendSym0 :: (~>) Schema ((~>) Schema Schema)) where sing = (singFun2 @AppendSym0) sAppend instance SingI d => SingI (AppendSym1 (d :: Schema) :: (~>) Schema Schema) where sing = (singFun1 @(AppendSym1 (d :: Schema))) (sAppend (sing @d)) data instance Sing :: U -> Type where SBOOL :: Sing BOOL SSTRING :: Sing STRING SNAT :: Sing NAT SVEC :: forall (n :: U) (n :: Nat). (Sing (n :: U)) -> (Sing (n :: Nat)) -> Sing (VEC n n) type SU = (Sing :: U -> Type) instance SingKind U where type Demote U = U fromSing SBOOL = BOOL fromSing SSTRING = STRING fromSing SNAT = NAT fromSing (SVEC b b) = (VEC (fromSing b)) (fromSing b) toSing BOOL = SomeSing SBOOL toSing STRING = SomeSing SSTRING toSing NAT = SomeSing SNAT toSing (VEC (b :: Demote U) (b :: Demote Nat)) = case ((,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) } data instance Sing :: AChar -> Type where SCA :: Sing CA SCB :: Sing CB SCC :: Sing CC SCD :: Sing CD SCE :: Sing CE SCF :: Sing CF SCG :: Sing CG SCH :: Sing CH SCI :: Sing CI SCJ :: Sing CJ SCK :: Sing CK SCL :: Sing CL SCM :: Sing CM SCN :: Sing CN SCO :: Sing CO SCP :: Sing CP SCQ :: Sing CQ SCR :: Sing CR SCS :: Sing CS SCT :: Sing CT SCU :: Sing CU SCV :: Sing CV SCW :: Sing CW SCX :: Sing CX SCY :: Sing CY SCZ :: Sing CZ type SAChar = (Sing :: AChar -> Type) instance SingKind AChar where type Demote AChar = AChar fromSing SCA = CA fromSing SCB = CB fromSing SCC = CC fromSing SCD = CD fromSing SCE = CE fromSing SCF = CF fromSing SCG = CG fromSing SCH = CH fromSing SCI = CI fromSing SCJ = CJ fromSing SCK = CK fromSing SCL = CL fromSing SCM = CM fromSing SCN = CN fromSing SCO = CO fromSing SCP = CP fromSing SCQ = CQ fromSing SCR = CR fromSing SCS = CS fromSing SCT = CT fromSing SCU = CU fromSing SCV = CV fromSing SCW = CW fromSing SCX = CX fromSing SCY = CY fromSing SCZ = CZ toSing CA = SomeSing SCA toSing CB = SomeSing SCB toSing CC = SomeSing SCC toSing CD = SomeSing SCD toSing CE = SomeSing SCE toSing CF = SomeSing SCF toSing CG = SomeSing SCG toSing CH = SomeSing SCH toSing CI = SomeSing SCI toSing CJ = SomeSing SCJ toSing CK = SomeSing SCK toSing CL = SomeSing SCL toSing CM = SomeSing SCM toSing CN = SomeSing SCN toSing CO = SomeSing SCO toSing CP = SomeSing SCP toSing CQ = SomeSing SCQ toSing CR = SomeSing SCR toSing CS = SomeSing SCS toSing CT = SomeSing SCT toSing CU = SomeSing SCU toSing CV = SomeSing SCV toSing CW = SomeSing SCW toSing CX = SomeSing SCX toSing CY = SomeSing SCY toSing CZ = SomeSing SCZ data instance Sing :: Attribute -> Type where SAttr :: forall (n :: [AChar]) (n :: U). (Sing (n :: [AChar])) -> (Sing (n :: U)) -> Sing (Attr n n) type SAttribute = (Sing :: Attribute -> Type) instance SingKind Attribute where type Demote Attribute = Attribute fromSing (SAttr b b) = (Attr (fromSing b)) (fromSing b) toSing (Attr (b :: Demote [AChar]) (b :: Demote U)) = case ((,) (toSing b :: SomeSing [AChar])) (toSing b :: SomeSing U) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) } data instance Sing :: Schema -> Type where SSch :: forall (n :: [Attribute]). (Sing (n :: [Attribute])) -> Sing (Sch n) type SSchema = (Sing :: Schema -> Type) instance SingKind Schema where type Demote Schema = Schema fromSing (SSch b) = Sch (fromSing b) toSing (Sch (b :: Demote [Attribute])) = case toSing b :: SomeSing [Attribute] of { SomeSing c -> SomeSing (SSch c) } instance (SShow U, SShow Nat) => SShow U where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: U) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) U ((~>) Symbol Symbol)) -> Type) t1) t2) t3) sShowsPrec _ SBOOL (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "BOOL"))) sA_0123456789876543210 sShowsPrec _ SSTRING (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "STRING"))) sA_0123456789876543210 sShowsPrec _ SNAT (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "NAT"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SVEC (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "VEC ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 instance SShow AChar where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: AChar) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) AChar ((~>) Symbol Symbol)) -> Type) t1) t2) t3) sShowsPrec _ SCA (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CA"))) sA_0123456789876543210 sShowsPrec _ SCB (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CB"))) sA_0123456789876543210 sShowsPrec _ SCC (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CC"))) sA_0123456789876543210 sShowsPrec _ SCD (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CD"))) sA_0123456789876543210 sShowsPrec _ SCE (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CE"))) sA_0123456789876543210 sShowsPrec _ SCF (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CF"))) sA_0123456789876543210 sShowsPrec _ SCG (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CG"))) sA_0123456789876543210 sShowsPrec _ SCH (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CH"))) sA_0123456789876543210 sShowsPrec _ SCI (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CI"))) sA_0123456789876543210 sShowsPrec _ SCJ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CJ"))) sA_0123456789876543210 sShowsPrec _ SCK (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CK"))) sA_0123456789876543210 sShowsPrec _ SCL (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CL"))) sA_0123456789876543210 sShowsPrec _ SCM (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CM"))) sA_0123456789876543210 sShowsPrec _ SCN (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CN"))) sA_0123456789876543210 sShowsPrec _ SCO (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CO"))) sA_0123456789876543210 sShowsPrec _ SCP (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CP"))) sA_0123456789876543210 sShowsPrec _ SCQ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CQ"))) sA_0123456789876543210 sShowsPrec _ SCR (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CR"))) sA_0123456789876543210 sShowsPrec _ SCS (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CS"))) sA_0123456789876543210 sShowsPrec _ SCT (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CT"))) sA_0123456789876543210 sShowsPrec _ SCU (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CU"))) sA_0123456789876543210 sShowsPrec _ SCV (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CV"))) sA_0123456789876543210 sShowsPrec _ SCW (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CW"))) sA_0123456789876543210 sShowsPrec _ SCX (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CX"))) sA_0123456789876543210 sShowsPrec _ SCY (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CY"))) sA_0123456789876543210 sShowsPrec _ SCZ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "CZ"))) sA_0123456789876543210 instance (SEq U, SEq Nat) => SEq U where (%==) SBOOL SBOOL = STrue (%==) SBOOL SSTRING = SFalse (%==) SBOOL SNAT = SFalse (%==) SBOOL (SVEC _ _) = SFalse (%==) SSTRING SBOOL = SFalse (%==) SSTRING SSTRING = STrue (%==) SSTRING SNAT = SFalse (%==) SSTRING (SVEC _ _) = SFalse (%==) SNAT SBOOL = SFalse (%==) SNAT SSTRING = SFalse (%==) SNAT SNAT = STrue (%==) SNAT (SVEC _ _) = SFalse (%==) (SVEC _ _) SBOOL = SFalse (%==) (SVEC _ _) SSTRING = SFalse (%==) (SVEC _ _) SNAT = SFalse (%==) (SVEC a a) (SVEC b b) = ((%&&) (((%==) a) b)) (((%==) a) b) instance (SDecide U, SDecide Nat) => SDecide U where (%~) SBOOL SBOOL = Proved Refl (%~) SBOOL SSTRING = Disproved (\ x -> case x of) (%~) SBOOL SNAT = Disproved (\ x -> case x of) (%~) SBOOL (SVEC _ _) = Disproved (\ x -> case x of) (%~) SSTRING SBOOL = Disproved (\ x -> case x of) (%~) SSTRING SSTRING = Proved Refl (%~) SSTRING SNAT = Disproved (\ x -> case x of) (%~) SSTRING (SVEC _ _) = Disproved (\ x -> case x of) (%~) SNAT SBOOL = Disproved (\ x -> case x of) (%~) SNAT SSTRING = Disproved (\ x -> case x of) (%~) SNAT SNAT = Proved Refl (%~) SNAT (SVEC _ _) = Disproved (\ x -> case x of) (%~) (SVEC _ _) SBOOL = Disproved (\ x -> case x of) (%~) (SVEC _ _) SSTRING = Disproved (\ x -> case x of) (%~) (SVEC _ _) SNAT = Disproved (\ x -> case x of) (%~) (SVEC a a) (SVEC b b) = case ((,) (((%~) a) b)) (((%~) a) b) of (,) (Proved Refl) (Proved Refl) -> Proved Refl (,) (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,) _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SEq AChar where (%==) SCA SCA = STrue (%==) SCA SCB = SFalse (%==) SCA SCC = SFalse (%==) SCA SCD = SFalse (%==) SCA SCE = SFalse (%==) SCA SCF = SFalse (%==) SCA SCG = SFalse (%==) SCA SCH = SFalse (%==) SCA SCI = SFalse (%==) SCA SCJ = SFalse (%==) SCA SCK = SFalse (%==) SCA SCL = SFalse (%==) SCA SCM = SFalse (%==) SCA SCN = SFalse (%==) SCA SCO = SFalse (%==) SCA SCP = SFalse (%==) SCA SCQ = SFalse (%==) SCA SCR = SFalse (%==) SCA SCS = SFalse (%==) SCA SCT = SFalse (%==) SCA SCU = SFalse (%==) SCA SCV = SFalse (%==) SCA SCW = SFalse (%==) SCA SCX = SFalse (%==) SCA SCY = SFalse (%==) SCA SCZ = SFalse (%==) SCB SCA = SFalse (%==) SCB SCB = STrue (%==) SCB SCC = SFalse (%==) SCB SCD = SFalse (%==) SCB SCE = SFalse (%==) SCB SCF = SFalse (%==) SCB SCG = SFalse (%==) SCB SCH = SFalse (%==) SCB SCI = SFalse (%==) SCB SCJ = SFalse (%==) SCB SCK = SFalse (%==) SCB SCL = SFalse (%==) SCB SCM = SFalse (%==) SCB SCN = SFalse (%==) SCB SCO = SFalse (%==) SCB SCP = SFalse (%==) SCB SCQ = SFalse (%==) SCB SCR = SFalse (%==) SCB SCS = SFalse (%==) SCB SCT = SFalse (%==) SCB SCU = SFalse (%==) SCB SCV = SFalse (%==) SCB SCW = SFalse (%==) SCB SCX = SFalse (%==) SCB SCY = SFalse (%==) SCB SCZ = SFalse (%==) SCC SCA = SFalse (%==) SCC SCB = SFalse (%==) SCC SCC = STrue (%==) SCC SCD = SFalse (%==) SCC SCE = SFalse (%==) SCC SCF = SFalse (%==) SCC SCG = SFalse (%==) SCC SCH = SFalse (%==) SCC SCI = SFalse (%==) SCC SCJ = SFalse (%==) SCC SCK = SFalse (%==) SCC SCL = SFalse (%==) SCC SCM = SFalse (%==) SCC SCN = SFalse (%==) SCC SCO = SFalse (%==) SCC SCP = SFalse (%==) SCC SCQ = SFalse (%==) SCC SCR = SFalse (%==) SCC SCS = SFalse (%==) SCC SCT = SFalse (%==) SCC SCU = SFalse (%==) SCC SCV = SFalse (%==) SCC SCW = SFalse (%==) SCC SCX = SFalse (%==) SCC SCY = SFalse (%==) SCC SCZ = SFalse (%==) SCD SCA = SFalse (%==) SCD SCB = SFalse (%==) SCD SCC = SFalse (%==) SCD SCD = STrue (%==) SCD SCE = SFalse (%==) SCD SCF = SFalse (%==) SCD SCG = SFalse (%==) SCD SCH = SFalse (%==) SCD SCI = SFalse (%==) SCD SCJ = SFalse (%==) SCD SCK = SFalse (%==) SCD SCL = SFalse (%==) SCD SCM = SFalse (%==) SCD SCN = SFalse (%==) SCD SCO = SFalse (%==) SCD SCP = SFalse (%==) SCD SCQ = SFalse (%==) SCD SCR = SFalse (%==) SCD SCS = SFalse (%==) SCD SCT = SFalse (%==) SCD SCU = SFalse (%==) SCD SCV = SFalse (%==) SCD SCW = SFalse (%==) SCD SCX = SFalse (%==) SCD SCY = SFalse (%==) SCD SCZ = SFalse (%==) SCE SCA = SFalse (%==) SCE SCB = SFalse (%==) SCE SCC = SFalse (%==) SCE SCD = SFalse (%==) SCE SCE = STrue (%==) SCE SCF = SFalse (%==) SCE SCG = SFalse (%==) SCE SCH = SFalse (%==) SCE SCI = SFalse (%==) SCE SCJ = SFalse (%==) SCE SCK = SFalse (%==) SCE SCL = SFalse (%==) SCE SCM = SFalse (%==) SCE SCN = SFalse (%==) SCE SCO = SFalse (%==) SCE SCP = SFalse (%==) SCE SCQ = SFalse (%==) SCE SCR = SFalse (%==) SCE SCS = SFalse (%==) SCE SCT = SFalse (%==) SCE SCU = SFalse (%==) SCE SCV = SFalse (%==) SCE SCW = SFalse (%==) SCE SCX = SFalse (%==) SCE SCY = SFalse (%==) SCE SCZ = SFalse (%==) SCF SCA = SFalse (%==) SCF SCB = SFalse (%==) SCF SCC = SFalse (%==) SCF SCD = SFalse (%==) SCF SCE = SFalse (%==) SCF SCF = STrue (%==) SCF SCG = SFalse (%==) SCF SCH = SFalse (%==) SCF SCI = SFalse (%==) SCF SCJ = SFalse (%==) SCF SCK = SFalse (%==) SCF SCL = SFalse (%==) SCF SCM = SFalse (%==) SCF SCN = SFalse (%==) SCF SCO = SFalse (%==) SCF SCP = SFalse (%==) SCF SCQ = SFalse (%==) SCF SCR = SFalse (%==) SCF SCS = SFalse (%==) SCF SCT = SFalse (%==) SCF SCU = SFalse (%==) SCF SCV = SFalse (%==) SCF SCW = SFalse (%==) SCF SCX = SFalse (%==) SCF SCY = SFalse (%==) SCF SCZ = SFalse (%==) SCG SCA = SFalse (%==) SCG SCB = SFalse (%==) SCG SCC = SFalse (%==) SCG SCD = SFalse (%==) SCG SCE = SFalse (%==) SCG SCF = SFalse (%==) SCG SCG = STrue (%==) SCG SCH = SFalse (%==) SCG SCI = SFalse (%==) SCG SCJ = SFalse (%==) SCG SCK = SFalse (%==) SCG SCL = SFalse (%==) SCG SCM = SFalse (%==) SCG SCN = SFalse (%==) SCG SCO = SFalse (%==) SCG SCP = SFalse (%==) SCG SCQ = SFalse (%==) SCG SCR = SFalse (%==) SCG SCS = SFalse (%==) SCG SCT = SFalse (%==) SCG SCU = SFalse (%==) SCG SCV = SFalse (%==) SCG SCW = SFalse (%==) SCG SCX = SFalse (%==) SCG SCY = SFalse (%==) SCG SCZ = SFalse (%==) SCH SCA = SFalse (%==) SCH SCB = SFalse (%==) SCH SCC = SFalse (%==) SCH SCD = SFalse (%==) SCH SCE = SFalse (%==) SCH SCF = SFalse (%==) SCH SCG = SFalse (%==) SCH SCH = STrue (%==) SCH SCI = SFalse (%==) SCH SCJ = SFalse (%==) SCH SCK = SFalse (%==) SCH SCL = SFalse (%==) SCH SCM = SFalse (%==) SCH SCN = SFalse (%==) SCH SCO = SFalse (%==) SCH SCP = SFalse (%==) SCH SCQ = SFalse (%==) SCH SCR = SFalse (%==) SCH SCS = SFalse (%==) SCH SCT = SFalse (%==) SCH SCU = SFalse (%==) SCH SCV = SFalse (%==) SCH SCW = SFalse (%==) SCH SCX = SFalse (%==) SCH SCY = SFalse (%==) SCH SCZ = SFalse (%==) SCI SCA = SFalse (%==) SCI SCB = SFalse (%==) SCI SCC = SFalse (%==) SCI SCD = SFalse (%==) SCI SCE = SFalse (%==) SCI SCF = SFalse (%==) SCI SCG = SFalse (%==) SCI SCH = SFalse (%==) SCI SCI = STrue (%==) SCI SCJ = SFalse (%==) SCI SCK = SFalse (%==) SCI SCL = SFalse (%==) SCI SCM = SFalse (%==) SCI SCN = SFalse (%==) SCI SCO = SFalse (%==) SCI SCP = SFalse (%==) SCI SCQ = SFalse (%==) SCI SCR = SFalse (%==) SCI SCS = SFalse (%==) SCI SCT = SFalse (%==) SCI SCU = SFalse (%==) SCI SCV = SFalse (%==) SCI SCW = SFalse (%==) SCI SCX = SFalse (%==) SCI SCY = SFalse (%==) SCI SCZ = SFalse (%==) SCJ SCA = SFalse (%==) SCJ SCB = SFalse (%==) SCJ SCC = SFalse (%==) SCJ SCD = SFalse (%==) SCJ SCE = SFalse (%==) SCJ SCF = SFalse (%==) SCJ SCG = SFalse (%==) SCJ SCH = SFalse (%==) SCJ SCI = SFalse (%==) SCJ SCJ = STrue (%==) SCJ SCK = SFalse (%==) SCJ SCL = SFalse (%==) SCJ SCM = SFalse (%==) SCJ SCN = SFalse (%==) SCJ SCO = SFalse (%==) SCJ SCP = SFalse (%==) SCJ SCQ = SFalse (%==) SCJ SCR = SFalse (%==) SCJ SCS = SFalse (%==) SCJ SCT = SFalse (%==) SCJ SCU = SFalse (%==) SCJ SCV = SFalse (%==) SCJ SCW = SFalse (%==) SCJ SCX = SFalse (%==) SCJ SCY = SFalse (%==) SCJ SCZ = SFalse (%==) SCK SCA = SFalse (%==) SCK SCB = SFalse (%==) SCK SCC = SFalse (%==) SCK SCD = SFalse (%==) SCK SCE = SFalse (%==) SCK SCF = SFalse (%==) SCK SCG = SFalse (%==) SCK SCH = SFalse (%==) SCK SCI = SFalse (%==) SCK SCJ = SFalse (%==) SCK SCK = STrue (%==) SCK SCL = SFalse (%==) SCK SCM = SFalse (%==) SCK SCN = SFalse (%==) SCK SCO = SFalse (%==) SCK SCP = SFalse (%==) SCK SCQ = SFalse (%==) SCK SCR = SFalse (%==) SCK SCS = SFalse (%==) SCK SCT = SFalse (%==) SCK SCU = SFalse (%==) SCK SCV = SFalse (%==) SCK SCW = SFalse (%==) SCK SCX = SFalse (%==) SCK SCY = SFalse (%==) SCK SCZ = SFalse (%==) SCL SCA = SFalse (%==) SCL SCB = SFalse (%==) SCL SCC = SFalse (%==) SCL SCD = SFalse (%==) SCL SCE = SFalse (%==) SCL SCF = SFalse (%==) SCL SCG = SFalse (%==) SCL SCH = SFalse (%==) SCL SCI = SFalse (%==) SCL SCJ = SFalse (%==) SCL SCK = SFalse (%==) SCL SCL = STrue (%==) SCL SCM = SFalse (%==) SCL SCN = SFalse (%==) SCL SCO = SFalse (%==) SCL SCP = SFalse (%==) SCL SCQ = SFalse (%==) SCL SCR = SFalse (%==) SCL SCS = SFalse (%==) SCL SCT = SFalse (%==) SCL SCU = SFalse (%==) SCL SCV = SFalse (%==) SCL SCW = SFalse (%==) SCL SCX = SFalse (%==) SCL SCY = SFalse (%==) SCL SCZ = SFalse (%==) SCM SCA = SFalse (%==) SCM SCB = SFalse (%==) SCM SCC = SFalse (%==) SCM SCD = SFalse (%==) SCM SCE = SFalse (%==) SCM SCF = SFalse (%==) SCM SCG = SFalse (%==) SCM SCH = SFalse (%==) SCM SCI = SFalse (%==) SCM SCJ = SFalse (%==) SCM SCK = SFalse (%==) SCM SCL = SFalse (%==) SCM SCM = STrue (%==) SCM SCN = SFalse (%==) SCM SCO = SFalse (%==) SCM SCP = SFalse (%==) SCM SCQ = SFalse (%==) SCM SCR = SFalse (%==) SCM SCS = SFalse (%==) SCM SCT = SFalse (%==) SCM SCU = SFalse (%==) SCM SCV = SFalse (%==) SCM SCW = SFalse (%==) SCM SCX = SFalse (%==) SCM SCY = SFalse (%==) SCM SCZ = SFalse (%==) SCN SCA = SFalse (%==) SCN SCB = SFalse (%==) SCN SCC = SFalse (%==) SCN SCD = SFalse (%==) SCN SCE = SFalse (%==) SCN SCF = SFalse (%==) SCN SCG = SFalse (%==) SCN SCH = SFalse (%==) SCN SCI = SFalse (%==) SCN SCJ = SFalse (%==) SCN SCK = SFalse (%==) SCN SCL = SFalse (%==) SCN SCM = SFalse (%==) SCN SCN = STrue (%==) SCN SCO = SFalse (%==) SCN SCP = SFalse (%==) SCN SCQ = SFalse (%==) SCN SCR = SFalse (%==) SCN SCS = SFalse (%==) SCN SCT = SFalse (%==) SCN SCU = SFalse (%==) SCN SCV = SFalse (%==) SCN SCW = SFalse (%==) SCN SCX = SFalse (%==) SCN SCY = SFalse (%==) SCN SCZ = SFalse (%==) SCO SCA = SFalse (%==) SCO SCB = SFalse (%==) SCO SCC = SFalse (%==) SCO SCD = SFalse (%==) SCO SCE = SFalse (%==) SCO SCF = SFalse (%==) SCO SCG = SFalse (%==) SCO SCH = SFalse (%==) SCO SCI = SFalse (%==) SCO SCJ = SFalse (%==) SCO SCK = SFalse (%==) SCO SCL = SFalse (%==) SCO SCM = SFalse (%==) SCO SCN = SFalse (%==) SCO SCO = STrue (%==) SCO SCP = SFalse (%==) SCO SCQ = SFalse (%==) SCO SCR = SFalse (%==) SCO SCS = SFalse (%==) SCO SCT = SFalse (%==) SCO SCU = SFalse (%==) SCO SCV = SFalse (%==) SCO SCW = SFalse (%==) SCO SCX = SFalse (%==) SCO SCY = SFalse (%==) SCO SCZ = SFalse (%==) SCP SCA = SFalse (%==) SCP SCB = SFalse (%==) SCP SCC = SFalse (%==) SCP SCD = SFalse (%==) SCP SCE = SFalse (%==) SCP SCF = SFalse (%==) SCP SCG = SFalse (%==) SCP SCH = SFalse (%==) SCP SCI = SFalse (%==) SCP SCJ = SFalse (%==) SCP SCK = SFalse (%==) SCP SCL = SFalse (%==) SCP SCM = SFalse (%==) SCP SCN = SFalse (%==) SCP SCO = SFalse (%==) SCP SCP = STrue (%==) SCP SCQ = SFalse (%==) SCP SCR = SFalse (%==) SCP SCS = SFalse (%==) SCP SCT = SFalse (%==) SCP SCU = SFalse (%==) SCP SCV = SFalse (%==) SCP SCW = SFalse (%==) SCP SCX = SFalse (%==) SCP SCY = SFalse (%==) SCP SCZ = SFalse (%==) SCQ SCA = SFalse (%==) SCQ SCB = SFalse (%==) SCQ SCC = SFalse (%==) SCQ SCD = SFalse (%==) SCQ SCE = SFalse (%==) SCQ SCF = SFalse (%==) SCQ SCG = SFalse (%==) SCQ SCH = SFalse (%==) SCQ SCI = SFalse (%==) SCQ SCJ = SFalse (%==) SCQ SCK = SFalse (%==) SCQ SCL = SFalse (%==) SCQ SCM = SFalse (%==) SCQ SCN = SFalse (%==) SCQ SCO = SFalse (%==) SCQ SCP = SFalse (%==) SCQ SCQ = STrue (%==) SCQ SCR = SFalse (%==) SCQ SCS = SFalse (%==) SCQ SCT = SFalse (%==) SCQ SCU = SFalse (%==) SCQ SCV = SFalse (%==) SCQ SCW = SFalse (%==) SCQ SCX = SFalse (%==) SCQ SCY = SFalse (%==) SCQ SCZ = SFalse (%==) SCR SCA = SFalse (%==) SCR SCB = SFalse (%==) SCR SCC = SFalse (%==) SCR SCD = SFalse (%==) SCR SCE = SFalse (%==) SCR SCF = SFalse (%==) SCR SCG = SFalse (%==) SCR SCH = SFalse (%==) SCR SCI = SFalse (%==) SCR SCJ = SFalse (%==) SCR SCK = SFalse (%==) SCR SCL = SFalse (%==) SCR SCM = SFalse (%==) SCR SCN = SFalse (%==) SCR SCO = SFalse (%==) SCR SCP = SFalse (%==) SCR SCQ = SFalse (%==) SCR SCR = STrue (%==) SCR SCS = SFalse (%==) SCR SCT = SFalse (%==) SCR SCU = SFalse (%==) SCR SCV = SFalse (%==) SCR SCW = SFalse (%==) SCR SCX = SFalse (%==) SCR SCY = SFalse (%==) SCR SCZ = SFalse (%==) SCS SCA = SFalse (%==) SCS SCB = SFalse (%==) SCS SCC = SFalse (%==) SCS SCD = SFalse (%==) SCS SCE = SFalse (%==) SCS SCF = SFalse (%==) SCS SCG = SFalse (%==) SCS SCH = SFalse (%==) SCS SCI = SFalse (%==) SCS SCJ = SFalse (%==) SCS SCK = SFalse (%==) SCS SCL = SFalse (%==) SCS SCM = SFalse (%==) SCS SCN = SFalse (%==) SCS SCO = SFalse (%==) SCS SCP = SFalse (%==) SCS SCQ = SFalse (%==) SCS SCR = SFalse (%==) SCS SCS = STrue (%==) SCS SCT = SFalse (%==) SCS SCU = SFalse (%==) SCS SCV = SFalse (%==) SCS SCW = SFalse (%==) SCS SCX = SFalse (%==) SCS SCY = SFalse (%==) SCS SCZ = SFalse (%==) SCT SCA = SFalse (%==) SCT SCB = SFalse (%==) SCT SCC = SFalse (%==) SCT SCD = SFalse (%==) SCT SCE = SFalse (%==) SCT SCF = SFalse (%==) SCT SCG = SFalse (%==) SCT SCH = SFalse (%==) SCT SCI = SFalse (%==) SCT SCJ = SFalse (%==) SCT SCK = SFalse (%==) SCT SCL = SFalse (%==) SCT SCM = SFalse (%==) SCT SCN = SFalse (%==) SCT SCO = SFalse (%==) SCT SCP = SFalse (%==) SCT SCQ = SFalse (%==) SCT SCR = SFalse (%==) SCT SCS = SFalse (%==) SCT SCT = STrue (%==) SCT SCU = SFalse (%==) SCT SCV = SFalse (%==) SCT SCW = SFalse (%==) SCT SCX = SFalse (%==) SCT SCY = SFalse (%==) SCT SCZ = SFalse (%==) SCU SCA = SFalse (%==) SCU SCB = SFalse (%==) SCU SCC = SFalse (%==) SCU SCD = SFalse (%==) SCU SCE = SFalse (%==) SCU SCF = SFalse (%==) SCU SCG = SFalse (%==) SCU SCH = SFalse (%==) SCU SCI = SFalse (%==) SCU SCJ = SFalse (%==) SCU SCK = SFalse (%==) SCU SCL = SFalse (%==) SCU SCM = SFalse (%==) SCU SCN = SFalse (%==) SCU SCO = SFalse (%==) SCU SCP = SFalse (%==) SCU SCQ = SFalse (%==) SCU SCR = SFalse (%==) SCU SCS = SFalse (%==) SCU SCT = SFalse (%==) SCU SCU = STrue (%==) SCU SCV = SFalse (%==) SCU SCW = SFalse (%==) SCU SCX = SFalse (%==) SCU SCY = SFalse (%==) SCU SCZ = SFalse (%==) SCV SCA = SFalse (%==) SCV SCB = SFalse (%==) SCV SCC = SFalse (%==) SCV SCD = SFalse (%==) SCV SCE = SFalse (%==) SCV SCF = SFalse (%==) SCV SCG = SFalse (%==) SCV SCH = SFalse (%==) SCV SCI = SFalse (%==) SCV SCJ = SFalse (%==) SCV SCK = SFalse (%==) SCV SCL = SFalse (%==) SCV SCM = SFalse (%==) SCV SCN = SFalse (%==) SCV SCO = SFalse (%==) SCV SCP = SFalse (%==) SCV SCQ = SFalse (%==) SCV SCR = SFalse (%==) SCV SCS = SFalse (%==) SCV SCT = SFalse (%==) SCV SCU = SFalse (%==) SCV SCV = STrue (%==) SCV SCW = SFalse (%==) SCV SCX = SFalse (%==) SCV SCY = SFalse (%==) SCV SCZ = SFalse (%==) SCW SCA = SFalse (%==) SCW SCB = SFalse (%==) SCW SCC = SFalse (%==) SCW SCD = SFalse (%==) SCW SCE = SFalse (%==) SCW SCF = SFalse (%==) SCW SCG = SFalse (%==) SCW SCH = SFalse (%==) SCW SCI = SFalse (%==) SCW SCJ = SFalse (%==) SCW SCK = SFalse (%==) SCW SCL = SFalse (%==) SCW SCM = SFalse (%==) SCW SCN = SFalse (%==) SCW SCO = SFalse (%==) SCW SCP = SFalse (%==) SCW SCQ = SFalse (%==) SCW SCR = SFalse (%==) SCW SCS = SFalse (%==) SCW SCT = SFalse (%==) SCW SCU = SFalse (%==) SCW SCV = SFalse (%==) SCW SCW = STrue (%==) SCW SCX = SFalse (%==) SCW SCY = SFalse (%==) SCW SCZ = SFalse (%==) SCX SCA = SFalse (%==) SCX SCB = SFalse (%==) SCX SCC = SFalse (%==) SCX SCD = SFalse (%==) SCX SCE = SFalse (%==) SCX SCF = SFalse (%==) SCX SCG = SFalse (%==) SCX SCH = SFalse (%==) SCX SCI = SFalse (%==) SCX SCJ = SFalse (%==) SCX SCK = SFalse (%==) SCX SCL = SFalse (%==) SCX SCM = SFalse (%==) SCX SCN = SFalse (%==) SCX SCO = SFalse (%==) SCX SCP = SFalse (%==) SCX SCQ = SFalse (%==) SCX SCR = SFalse (%==) SCX SCS = SFalse (%==) SCX SCT = SFalse (%==) SCX SCU = SFalse (%==) SCX SCV = SFalse (%==) SCX SCW = SFalse (%==) SCX SCX = STrue (%==) SCX SCY = SFalse (%==) SCX SCZ = SFalse (%==) SCY SCA = SFalse (%==) SCY SCB = SFalse (%==) SCY SCC = SFalse (%==) SCY SCD = SFalse (%==) SCY SCE = SFalse (%==) SCY SCF = SFalse (%==) SCY SCG = SFalse (%==) SCY SCH = SFalse (%==) SCY SCI = SFalse (%==) SCY SCJ = SFalse (%==) SCY SCK = SFalse (%==) SCY SCL = SFalse (%==) SCY SCM = SFalse (%==) SCY SCN = SFalse (%==) SCY SCO = SFalse (%==) SCY SCP = SFalse (%==) SCY SCQ = SFalse (%==) SCY SCR = SFalse (%==) SCY SCS = SFalse (%==) SCY SCT = SFalse (%==) SCY SCU = SFalse (%==) SCY SCV = SFalse (%==) SCY SCW = SFalse (%==) SCY SCX = SFalse (%==) SCY SCY = STrue (%==) SCY SCZ = SFalse (%==) SCZ SCA = SFalse (%==) SCZ SCB = SFalse (%==) SCZ SCC = SFalse (%==) SCZ SCD = SFalse (%==) SCZ SCE = SFalse (%==) SCZ SCF = SFalse (%==) SCZ SCG = SFalse (%==) SCZ SCH = SFalse (%==) SCZ SCI = SFalse (%==) SCZ SCJ = SFalse (%==) SCZ SCK = SFalse (%==) SCZ SCL = SFalse (%==) SCZ SCM = SFalse (%==) SCZ SCN = SFalse (%==) SCZ SCO = SFalse (%==) SCZ SCP = SFalse (%==) SCZ SCQ = SFalse (%==) SCZ SCR = SFalse (%==) SCZ SCS = SFalse (%==) SCZ SCT = SFalse (%==) SCZ SCU = SFalse (%==) SCZ SCV = SFalse (%==) SCZ SCW = SFalse (%==) SCZ SCX = SFalse (%==) SCZ SCY = SFalse (%==) SCZ SCZ = STrue instance SDecide AChar where (%~) SCA SCA = Proved Refl (%~) SCA SCB = Disproved (\ x -> case x of) (%~) SCA SCC = Disproved (\ x -> case x of) (%~) SCA SCD = Disproved (\ x -> case x of) (%~) SCA SCE = Disproved (\ x -> case x of) (%~) SCA SCF = Disproved (\ x -> case x of) (%~) SCA SCG = Disproved (\ x -> case x of) (%~) SCA SCH = Disproved (\ x -> case x of) (%~) SCA SCI = Disproved (\ x -> case x of) (%~) SCA SCJ = Disproved (\ x -> case x of) (%~) SCA SCK = Disproved (\ x -> case x of) (%~) SCA SCL = Disproved (\ x -> case x of) (%~) SCA SCM = Disproved (\ x -> case x of) (%~) SCA SCN = Disproved (\ x -> case x of) (%~) SCA SCO = Disproved (\ x -> case x of) (%~) SCA SCP = Disproved (\ x -> case x of) (%~) SCA SCQ = Disproved (\ x -> case x of) (%~) SCA SCR = Disproved (\ x -> case x of) (%~) SCA SCS = Disproved (\ x -> case x of) (%~) SCA SCT = Disproved (\ x -> case x of) (%~) SCA SCU = Disproved (\ x -> case x of) (%~) SCA SCV = Disproved (\ x -> case x of) (%~) SCA SCW = Disproved (\ x -> case x of) (%~) SCA SCX = Disproved (\ x -> case x of) (%~) SCA SCY = Disproved (\ x -> case x of) (%~) SCA SCZ = Disproved (\ x -> case x of) (%~) SCB SCA = Disproved (\ x -> case x of) (%~) SCB SCB = Proved Refl (%~) SCB SCC = Disproved (\ x -> case x of) (%~) SCB SCD = Disproved (\ x -> case x of) (%~) SCB SCE = Disproved (\ x -> case x of) (%~) SCB SCF = Disproved (\ x -> case x of) (%~) SCB SCG = Disproved (\ x -> case x of) (%~) SCB SCH = Disproved (\ x -> case x of) (%~) SCB SCI = Disproved (\ x -> case x of) (%~) SCB SCJ = Disproved (\ x -> case x of) (%~) SCB SCK = Disproved (\ x -> case x of) (%~) SCB SCL = Disproved (\ x -> case x of) (%~) SCB SCM = Disproved (\ x -> case x of) (%~) SCB SCN = Disproved (\ x -> case x of) (%~) SCB SCO = Disproved (\ x -> case x of) (%~) SCB SCP = Disproved (\ x -> case x of) (%~) SCB SCQ = Disproved (\ x -> case x of) (%~) SCB SCR = Disproved (\ x -> case x of) (%~) SCB SCS = Disproved (\ x -> case x of) (%~) SCB SCT = Disproved (\ x -> case x of) (%~) SCB SCU = Disproved (\ x -> case x of) (%~) SCB SCV = Disproved (\ x -> case x of) (%~) SCB SCW = Disproved (\ x -> case x of) (%~) SCB SCX = Disproved (\ x -> case x of) (%~) SCB SCY = Disproved (\ x -> case x of) (%~) SCB SCZ = Disproved (\ x -> case x of) (%~) SCC SCA = Disproved (\ x -> case x of) (%~) SCC SCB = Disproved (\ x -> case x of) (%~) SCC SCC = Proved Refl (%~) SCC SCD = Disproved (\ x -> case x of) (%~) SCC SCE = Disproved (\ x -> case x of) (%~) SCC SCF = Disproved (\ x -> case x of) (%~) SCC SCG = Disproved (\ x -> case x of) (%~) SCC SCH = Disproved (\ x -> case x of) (%~) SCC SCI = Disproved (\ x -> case x of) (%~) SCC SCJ = Disproved (\ x -> case x of) (%~) SCC SCK = Disproved (\ x -> case x of) (%~) SCC SCL = Disproved (\ x -> case x of) (%~) SCC SCM = Disproved (\ x -> case x of) (%~) SCC SCN = Disproved (\ x -> case x of) (%~) SCC SCO = Disproved (\ x -> case x of) (%~) SCC SCP = Disproved (\ x -> case x of) (%~) SCC SCQ = Disproved (\ x -> case x of) (%~) SCC SCR = Disproved (\ x -> case x of) (%~) SCC SCS = Disproved (\ x -> case x of) (%~) SCC SCT = Disproved (\ x -> case x of) (%~) SCC SCU = Disproved (\ x -> case x of) (%~) SCC SCV = Disproved (\ x -> case x of) (%~) SCC SCW = Disproved (\ x -> case x of) (%~) SCC SCX = Disproved (\ x -> case x of) (%~) SCC SCY = Disproved (\ x -> case x of) (%~) SCC SCZ = Disproved (\ x -> case x of) (%~) SCD SCA = Disproved (\ x -> case x of) (%~) SCD SCB = Disproved (\ x -> case x of) (%~) SCD SCC = Disproved (\ x -> case x of) (%~) SCD SCD = Proved Refl (%~) SCD SCE = Disproved (\ x -> case x of) (%~) SCD SCF = Disproved (\ x -> case x of) (%~) SCD SCG = Disproved (\ x -> case x of) (%~) SCD SCH = Disproved (\ x -> case x of) (%~) SCD SCI = Disproved (\ x -> case x of) (%~) SCD SCJ = Disproved (\ x -> case x of) (%~) SCD SCK = Disproved (\ x -> case x of) (%~) SCD SCL = Disproved (\ x -> case x of) (%~) SCD SCM = Disproved (\ x -> case x of) (%~) SCD SCN = Disproved (\ x -> case x of) (%~) SCD SCO = Disproved (\ x -> case x of) (%~) SCD SCP = Disproved (\ x -> case x of) (%~) SCD SCQ = Disproved (\ x -> case x of) (%~) SCD SCR = Disproved (\ x -> case x of) (%~) SCD SCS = Disproved (\ x -> case x of) (%~) SCD SCT = Disproved (\ x -> case x of) (%~) SCD SCU = Disproved (\ x -> case x of) (%~) SCD SCV = Disproved (\ x -> case x of) (%~) SCD SCW = Disproved (\ x -> case x of) (%~) SCD SCX = Disproved (\ x -> case x of) (%~) SCD SCY = Disproved (\ x -> case x of) (%~) SCD SCZ = Disproved (\ x -> case x of) (%~) SCE SCA = Disproved (\ x -> case x of) (%~) SCE SCB = Disproved (\ x -> case x of) (%~) SCE SCC = Disproved (\ x -> case x of) (%~) SCE SCD = Disproved (\ x -> case x of) (%~) SCE SCE = Proved Refl (%~) SCE SCF = Disproved (\ x -> case x of) (%~) SCE SCG = Disproved (\ x -> case x of) (%~) SCE SCH = Disproved (\ x -> case x of) (%~) SCE SCI = Disproved (\ x -> case x of) (%~) SCE SCJ = Disproved (\ x -> case x of) (%~) SCE SCK = Disproved (\ x -> case x of) (%~) SCE SCL = Disproved (\ x -> case x of) (%~) SCE SCM = Disproved (\ x -> case x of) (%~) SCE SCN = Disproved (\ x -> case x of) (%~) SCE SCO = Disproved (\ x -> case x of) (%~) SCE SCP = Disproved (\ x -> case x of) (%~) SCE SCQ = Disproved (\ x -> case x of) (%~) SCE SCR = Disproved (\ x -> case x of) (%~) SCE SCS = Disproved (\ x -> case x of) (%~) SCE SCT = Disproved (\ x -> case x of) (%~) SCE SCU = Disproved (\ x -> case x of) (%~) SCE SCV = Disproved (\ x -> case x of) (%~) SCE SCW = Disproved (\ x -> case x of) (%~) SCE SCX = Disproved (\ x -> case x of) (%~) SCE SCY = Disproved (\ x -> case x of) (%~) SCE SCZ = Disproved (\ x -> case x of) (%~) SCF SCA = Disproved (\ x -> case x of) (%~) SCF SCB = Disproved (\ x -> case x of) (%~) SCF SCC = Disproved (\ x -> case x of) (%~) SCF SCD = Disproved (\ x -> case x of) (%~) SCF SCE = Disproved (\ x -> case x of) (%~) SCF SCF = Proved Refl (%~) SCF SCG = Disproved (\ x -> case x of) (%~) SCF SCH = Disproved (\ x -> case x of) (%~) SCF SCI = Disproved (\ x -> case x of) (%~) SCF SCJ = Disproved (\ x -> case x of) (%~) SCF SCK = Disproved (\ x -> case x of) (%~) SCF SCL = Disproved (\ x -> case x of) (%~) SCF SCM = Disproved (\ x -> case x of) (%~) SCF SCN = Disproved (\ x -> case x of) (%~) SCF SCO = Disproved (\ x -> case x of) (%~) SCF SCP = Disproved (\ x -> case x of) (%~) SCF SCQ = Disproved (\ x -> case x of) (%~) SCF SCR = Disproved (\ x -> case x of) (%~) SCF SCS = Disproved (\ x -> case x of) (%~) SCF SCT = Disproved (\ x -> case x of) (%~) SCF SCU = Disproved (\ x -> case x of) (%~) SCF SCV = Disproved (\ x -> case x of) (%~) SCF SCW = Disproved (\ x -> case x of) (%~) SCF SCX = Disproved (\ x -> case x of) (%~) SCF SCY = Disproved (\ x -> case x of) (%~) SCF SCZ = Disproved (\ x -> case x of) (%~) SCG SCA = Disproved (\ x -> case x of) (%~) SCG SCB = Disproved (\ x -> case x of) (%~) SCG SCC = Disproved (\ x -> case x of) (%~) SCG SCD = Disproved (\ x -> case x of) (%~) SCG SCE = Disproved (\ x -> case x of) (%~) SCG SCF = Disproved (\ x -> case x of) (%~) SCG SCG = Proved Refl (%~) SCG SCH = Disproved (\ x -> case x of) (%~) SCG SCI = Disproved (\ x -> case x of) (%~) SCG SCJ = Disproved (\ x -> case x of) (%~) SCG SCK = Disproved (\ x -> case x of) (%~) SCG SCL = Disproved (\ x -> case x of) (%~) SCG SCM = Disproved (\ x -> case x of) (%~) SCG SCN = Disproved (\ x -> case x of) (%~) SCG SCO = Disproved (\ x -> case x of) (%~) SCG SCP = Disproved (\ x -> case x of) (%~) SCG SCQ = Disproved (\ x -> case x of) (%~) SCG SCR = Disproved (\ x -> case x of) (%~) SCG SCS = Disproved (\ x -> case x of) (%~) SCG SCT = Disproved (\ x -> case x of) (%~) SCG SCU = Disproved (\ x -> case x of) (%~) SCG SCV = Disproved (\ x -> case x of) (%~) SCG SCW = Disproved (\ x -> case x of) (%~) SCG SCX = Disproved (\ x -> case x of) (%~) SCG SCY = Disproved (\ x -> case x of) (%~) SCG SCZ = Disproved (\ x -> case x of) (%~) SCH SCA = Disproved (\ x -> case x of) (%~) SCH SCB = Disproved (\ x -> case x of) (%~) SCH SCC = Disproved (\ x -> case x of) (%~) SCH SCD = Disproved (\ x -> case x of) (%~) SCH SCE = Disproved (\ x -> case x of) (%~) SCH SCF = Disproved (\ x -> case x of) (%~) SCH SCG = Disproved (\ x -> case x of) (%~) SCH SCH = Proved Refl (%~) SCH SCI = Disproved (\ x -> case x of) (%~) SCH SCJ = Disproved (\ x -> case x of) (%~) SCH SCK = Disproved (\ x -> case x of) (%~) SCH SCL = Disproved (\ x -> case x of) (%~) SCH SCM = Disproved (\ x -> case x of) (%~) SCH SCN = Disproved (\ x -> case x of) (%~) SCH SCO = Disproved (\ x -> case x of) (%~) SCH SCP = Disproved (\ x -> case x of) (%~) SCH SCQ = Disproved (\ x -> case x of) (%~) SCH SCR = Disproved (\ x -> case x of) (%~) SCH SCS = Disproved (\ x -> case x of) (%~) SCH SCT = Disproved (\ x -> case x of) (%~) SCH SCU = Disproved (\ x -> case x of) (%~) SCH SCV = Disproved (\ x -> case x of) (%~) SCH SCW = Disproved (\ x -> case x of) (%~) SCH SCX = Disproved (\ x -> case x of) (%~) SCH SCY = Disproved (\ x -> case x of) (%~) SCH SCZ = Disproved (\ x -> case x of) (%~) SCI SCA = Disproved (\ x -> case x of) (%~) SCI SCB = Disproved (\ x -> case x of) (%~) SCI SCC = Disproved (\ x -> case x of) (%~) SCI SCD = Disproved (\ x -> case x of) (%~) SCI SCE = Disproved (\ x -> case x of) (%~) SCI SCF = Disproved (\ x -> case x of) (%~) SCI SCG = Disproved (\ x -> case x of) (%~) SCI SCH = Disproved (\ x -> case x of) (%~) SCI SCI = Proved Refl (%~) SCI SCJ = Disproved (\ x -> case x of) (%~) SCI SCK = Disproved (\ x -> case x of) (%~) SCI SCL = Disproved (\ x -> case x of) (%~) SCI SCM = Disproved (\ x -> case x of) (%~) SCI SCN = Disproved (\ x -> case x of) (%~) SCI SCO = Disproved (\ x -> case x of) (%~) SCI SCP = Disproved (\ x -> case x of) (%~) SCI SCQ = Disproved (\ x -> case x of) (%~) SCI SCR = Disproved (\ x -> case x of) (%~) SCI SCS = Disproved (\ x -> case x of) (%~) SCI SCT = Disproved (\ x -> case x of) (%~) SCI SCU = Disproved (\ x -> case x of) (%~) SCI SCV = Disproved (\ x -> case x of) (%~) SCI SCW = Disproved (\ x -> case x of) (%~) SCI SCX = Disproved (\ x -> case x of) (%~) SCI SCY = Disproved (\ x -> case x of) (%~) SCI SCZ = Disproved (\ x -> case x of) (%~) SCJ SCA = Disproved (\ x -> case x of) (%~) SCJ SCB = Disproved (\ x -> case x of) (%~) SCJ SCC = Disproved (\ x -> case x of) (%~) SCJ SCD = Disproved (\ x -> case x of) (%~) SCJ SCE = Disproved (\ x -> case x of) (%~) SCJ SCF = Disproved (\ x -> case x of) (%~) SCJ SCG = Disproved (\ x -> case x of) (%~) SCJ SCH = Disproved (\ x -> case x of) (%~) SCJ SCI = Disproved (\ x -> case x of) (%~) SCJ SCJ = Proved Refl (%~) SCJ SCK = Disproved (\ x -> case x of) (%~) SCJ SCL = Disproved (\ x -> case x of) (%~) SCJ SCM = Disproved (\ x -> case x of) (%~) SCJ SCN = Disproved (\ x -> case x of) (%~) SCJ SCO = Disproved (\ x -> case x of) (%~) SCJ SCP = Disproved (\ x -> case x of) (%~) SCJ SCQ = Disproved (\ x -> case x of) (%~) SCJ SCR = Disproved (\ x -> case x of) (%~) SCJ SCS = Disproved (\ x -> case x of) (%~) SCJ SCT = Disproved (\ x -> case x of) (%~) SCJ SCU = Disproved (\ x -> case x of) (%~) SCJ SCV = Disproved (\ x -> case x of) (%~) SCJ SCW = Disproved (\ x -> case x of) (%~) SCJ SCX = Disproved (\ x -> case x of) (%~) SCJ SCY = Disproved (\ x -> case x of) (%~) SCJ SCZ = Disproved (\ x -> case x of) (%~) SCK SCA = Disproved (\ x -> case x of) (%~) SCK SCB = Disproved (\ x -> case x of) (%~) SCK SCC = Disproved (\ x -> case x of) (%~) SCK SCD = Disproved (\ x -> case x of) (%~) SCK SCE = Disproved (\ x -> case x of) (%~) SCK SCF = Disproved (\ x -> case x of) (%~) SCK SCG = Disproved (\ x -> case x of) (%~) SCK SCH = Disproved (\ x -> case x of) (%~) SCK SCI = Disproved (\ x -> case x of) (%~) SCK SCJ = Disproved (\ x -> case x of) (%~) SCK SCK = Proved Refl (%~) SCK SCL = Disproved (\ x -> case x of) (%~) SCK SCM = Disproved (\ x -> case x of) (%~) SCK SCN = Disproved (\ x -> case x of) (%~) SCK SCO = Disproved (\ x -> case x of) (%~) SCK SCP = Disproved (\ x -> case x of) (%~) SCK SCQ = Disproved (\ x -> case x of) (%~) SCK SCR = Disproved (\ x -> case x of) (%~) SCK SCS = Disproved (\ x -> case x of) (%~) SCK SCT = Disproved (\ x -> case x of) (%~) SCK SCU = Disproved (\ x -> case x of) (%~) SCK SCV = Disproved (\ x -> case x of) (%~) SCK SCW = Disproved (\ x -> case x of) (%~) SCK SCX = Disproved (\ x -> case x of) (%~) SCK SCY = Disproved (\ x -> case x of) (%~) SCK SCZ = Disproved (\ x -> case x of) (%~) SCL SCA = Disproved (\ x -> case x of) (%~) SCL SCB = Disproved (\ x -> case x of) (%~) SCL SCC = Disproved (\ x -> case x of) (%~) SCL SCD = Disproved (\ x -> case x of) (%~) SCL SCE = Disproved (\ x -> case x of) (%~) SCL SCF = Disproved (\ x -> case x of) (%~) SCL SCG = Disproved (\ x -> case x of) (%~) SCL SCH = Disproved (\ x -> case x of) (%~) SCL SCI = Disproved (\ x -> case x of) (%~) SCL SCJ = Disproved (\ x -> case x of) (%~) SCL SCK = Disproved (\ x -> case x of) (%~) SCL SCL = Proved Refl (%~) SCL SCM = Disproved (\ x -> case x of) (%~) SCL SCN = Disproved (\ x -> case x of) (%~) SCL SCO = Disproved (\ x -> case x of) (%~) SCL SCP = Disproved (\ x -> case x of) (%~) SCL SCQ = Disproved (\ x -> case x of) (%~) SCL SCR = Disproved (\ x -> case x of) (%~) SCL SCS = Disproved (\ x -> case x of) (%~) SCL SCT = Disproved (\ x -> case x of) (%~) SCL SCU = Disproved (\ x -> case x of) (%~) SCL SCV = Disproved (\ x -> case x of) (%~) SCL SCW = Disproved (\ x -> case x of) (%~) SCL SCX = Disproved (\ x -> case x of) (%~) SCL SCY = Disproved (\ x -> case x of) (%~) SCL SCZ = Disproved (\ x -> case x of) (%~) SCM SCA = Disproved (\ x -> case x of) (%~) SCM SCB = Disproved (\ x -> case x of) (%~) SCM SCC = Disproved (\ x -> case x of) (%~) SCM SCD = Disproved (\ x -> case x of) (%~) SCM SCE = Disproved (\ x -> case x of) (%~) SCM SCF = Disproved (\ x -> case x of) (%~) SCM SCG = Disproved (\ x -> case x of) (%~) SCM SCH = Disproved (\ x -> case x of) (%~) SCM SCI = Disproved (\ x -> case x of) (%~) SCM SCJ = Disproved (\ x -> case x of) (%~) SCM SCK = Disproved (\ x -> case x of) (%~) SCM SCL = Disproved (\ x -> case x of) (%~) SCM SCM = Proved Refl (%~) SCM SCN = Disproved (\ x -> case x of) (%~) SCM SCO = Disproved (\ x -> case x of) (%~) SCM SCP = Disproved (\ x -> case x of) (%~) SCM SCQ = Disproved (\ x -> case x of) (%~) SCM SCR = Disproved (\ x -> case x of) (%~) SCM SCS = Disproved (\ x -> case x of) (%~) SCM SCT = Disproved (\ x -> case x of) (%~) SCM SCU = Disproved (\ x -> case x of) (%~) SCM SCV = Disproved (\ x -> case x of) (%~) SCM SCW = Disproved (\ x -> case x of) (%~) SCM SCX = Disproved (\ x -> case x of) (%~) SCM SCY = Disproved (\ x -> case x of) (%~) SCM SCZ = Disproved (\ x -> case x of) (%~) SCN SCA = Disproved (\ x -> case x of) (%~) SCN SCB = Disproved (\ x -> case x of) (%~) SCN SCC = Disproved (\ x -> case x of) (%~) SCN SCD = Disproved (\ x -> case x of) (%~) SCN SCE = Disproved (\ x -> case x of) (%~) SCN SCF = Disproved (\ x -> case x of) (%~) SCN SCG = Disproved (\ x -> case x of) (%~) SCN SCH = Disproved (\ x -> case x of) (%~) SCN SCI = Disproved (\ x -> case x of) (%~) SCN SCJ = Disproved (\ x -> case x of) (%~) SCN SCK = Disproved (\ x -> case x of) (%~) SCN SCL = Disproved (\ x -> case x of) (%~) SCN SCM = Disproved (\ x -> case x of) (%~) SCN SCN = Proved Refl (%~) SCN SCO = Disproved (\ x -> case x of) (%~) SCN SCP = Disproved (\ x -> case x of) (%~) SCN SCQ = Disproved (\ x -> case x of) (%~) SCN SCR = Disproved (\ x -> case x of) (%~) SCN SCS = Disproved (\ x -> case x of) (%~) SCN SCT = Disproved (\ x -> case x of) (%~) SCN SCU = Disproved (\ x -> case x of) (%~) SCN SCV = Disproved (\ x -> case x of) (%~) SCN SCW = Disproved (\ x -> case x of) (%~) SCN SCX = Disproved (\ x -> case x of) (%~) SCN SCY = Disproved (\ x -> case x of) (%~) SCN SCZ = Disproved (\ x -> case x of) (%~) SCO SCA = Disproved (\ x -> case x of) (%~) SCO SCB = Disproved (\ x -> case x of) (%~) SCO SCC = Disproved (\ x -> case x of) (%~) SCO SCD = Disproved (\ x -> case x of) (%~) SCO SCE = Disproved (\ x -> case x of) (%~) SCO SCF = Disproved (\ x -> case x of) (%~) SCO SCG = Disproved (\ x -> case x of) (%~) SCO SCH = Disproved (\ x -> case x of) (%~) SCO SCI = Disproved (\ x -> case x of) (%~) SCO SCJ = Disproved (\ x -> case x of) (%~) SCO SCK = Disproved (\ x -> case x of) (%~) SCO SCL = Disproved (\ x -> case x of) (%~) SCO SCM = Disproved (\ x -> case x of) (%~) SCO SCN = Disproved (\ x -> case x of) (%~) SCO SCO = Proved Refl (%~) SCO SCP = Disproved (\ x -> case x of) (%~) SCO SCQ = Disproved (\ x -> case x of) (%~) SCO SCR = Disproved (\ x -> case x of) (%~) SCO SCS = Disproved (\ x -> case x of) (%~) SCO SCT = Disproved (\ x -> case x of) (%~) SCO SCU = Disproved (\ x -> case x of) (%~) SCO SCV = Disproved (\ x -> case x of) (%~) SCO SCW = Disproved (\ x -> case x of) (%~) SCO SCX = Disproved (\ x -> case x of) (%~) SCO SCY = Disproved (\ x -> case x of) (%~) SCO SCZ = Disproved (\ x -> case x of) (%~) SCP SCA = Disproved (\ x -> case x of) (%~) SCP SCB = Disproved (\ x -> case x of) (%~) SCP SCC = Disproved (\ x -> case x of) (%~) SCP SCD = Disproved (\ x -> case x of) (%~) SCP SCE = Disproved (\ x -> case x of) (%~) SCP SCF = Disproved (\ x -> case x of) (%~) SCP SCG = Disproved (\ x -> case x of) (%~) SCP SCH = Disproved (\ x -> case x of) (%~) SCP SCI = Disproved (\ x -> case x of) (%~) SCP SCJ = Disproved (\ x -> case x of) (%~) SCP SCK = Disproved (\ x -> case x of) (%~) SCP SCL = Disproved (\ x -> case x of) (%~) SCP SCM = Disproved (\ x -> case x of) (%~) SCP SCN = Disproved (\ x -> case x of) (%~) SCP SCO = Disproved (\ x -> case x of) (%~) SCP SCP = Proved Refl (%~) SCP SCQ = Disproved (\ x -> case x of) (%~) SCP SCR = Disproved (\ x -> case x of) (%~) SCP SCS = Disproved (\ x -> case x of) (%~) SCP SCT = Disproved (\ x -> case x of) (%~) SCP SCU = Disproved (\ x -> case x of) (%~) SCP SCV = Disproved (\ x -> case x of) (%~) SCP SCW = Disproved (\ x -> case x of) (%~) SCP SCX = Disproved (\ x -> case x of) (%~) SCP SCY = Disproved (\ x -> case x of) (%~) SCP SCZ = Disproved (\ x -> case x of) (%~) SCQ SCA = Disproved (\ x -> case x of) (%~) SCQ SCB = Disproved (\ x -> case x of) (%~) SCQ SCC = Disproved (\ x -> case x of) (%~) SCQ SCD = Disproved (\ x -> case x of) (%~) SCQ SCE = Disproved (\ x -> case x of) (%~) SCQ SCF = Disproved (\ x -> case x of) (%~) SCQ SCG = Disproved (\ x -> case x of) (%~) SCQ SCH = Disproved (\ x -> case x of) (%~) SCQ SCI = Disproved (\ x -> case x of) (%~) SCQ SCJ = Disproved (\ x -> case x of) (%~) SCQ SCK = Disproved (\ x -> case x of) (%~) SCQ SCL = Disproved (\ x -> case x of) (%~) SCQ SCM = Disproved (\ x -> case x of) (%~) SCQ SCN = Disproved (\ x -> case x of) (%~) SCQ SCO = Disproved (\ x -> case x of) (%~) SCQ SCP = Disproved (\ x -> case x of) (%~) SCQ SCQ = Proved Refl (%~) SCQ SCR = Disproved (\ x -> case x of) (%~) SCQ SCS = Disproved (\ x -> case x of) (%~) SCQ SCT = Disproved (\ x -> case x of) (%~) SCQ SCU = Disproved (\ x -> case x of) (%~) SCQ SCV = Disproved (\ x -> case x of) (%~) SCQ SCW = Disproved (\ x -> case x of) (%~) SCQ SCX = Disproved (\ x -> case x of) (%~) SCQ SCY = Disproved (\ x -> case x of) (%~) SCQ SCZ = Disproved (\ x -> case x of) (%~) SCR SCA = Disproved (\ x -> case x of) (%~) SCR SCB = Disproved (\ x -> case x of) (%~) SCR SCC = Disproved (\ x -> case x of) (%~) SCR SCD = Disproved (\ x -> case x of) (%~) SCR SCE = Disproved (\ x -> case x of) (%~) SCR SCF = Disproved (\ x -> case x of) (%~) SCR SCG = Disproved (\ x -> case x of) (%~) SCR SCH = Disproved (\ x -> case x of) (%~) SCR SCI = Disproved (\ x -> case x of) (%~) SCR SCJ = Disproved (\ x -> case x of) (%~) SCR SCK = Disproved (\ x -> case x of) (%~) SCR SCL = Disproved (\ x -> case x of) (%~) SCR SCM = Disproved (\ x -> case x of) (%~) SCR SCN = Disproved (\ x -> case x of) (%~) SCR SCO = Disproved (\ x -> case x of) (%~) SCR SCP = Disproved (\ x -> case x of) (%~) SCR SCQ = Disproved (\ x -> case x of) (%~) SCR SCR = Proved Refl (%~) SCR SCS = Disproved (\ x -> case x of) (%~) SCR SCT = Disproved (\ x -> case x of) (%~) SCR SCU = Disproved (\ x -> case x of) (%~) SCR SCV = Disproved (\ x -> case x of) (%~) SCR SCW = Disproved (\ x -> case x of) (%~) SCR SCX = Disproved (\ x -> case x of) (%~) SCR SCY = Disproved (\ x -> case x of) (%~) SCR SCZ = Disproved (\ x -> case x of) (%~) SCS SCA = Disproved (\ x -> case x of) (%~) SCS SCB = Disproved (\ x -> case x of) (%~) SCS SCC = Disproved (\ x -> case x of) (%~) SCS SCD = Disproved (\ x -> case x of) (%~) SCS SCE = Disproved (\ x -> case x of) (%~) SCS SCF = Disproved (\ x -> case x of) (%~) SCS SCG = Disproved (\ x -> case x of) (%~) SCS SCH = Disproved (\ x -> case x of) (%~) SCS SCI = Disproved (\ x -> case x of) (%~) SCS SCJ = Disproved (\ x -> case x of) (%~) SCS SCK = Disproved (\ x -> case x of) (%~) SCS SCL = Disproved (\ x -> case x of) (%~) SCS SCM = Disproved (\ x -> case x of) (%~) SCS SCN = Disproved (\ x -> case x of) (%~) SCS SCO = Disproved (\ x -> case x of) (%~) SCS SCP = Disproved (\ x -> case x of) (%~) SCS SCQ = Disproved (\ x -> case x of) (%~) SCS SCR = Disproved (\ x -> case x of) (%~) SCS SCS = Proved Refl (%~) SCS SCT = Disproved (\ x -> case x of) (%~) SCS SCU = Disproved (\ x -> case x of) (%~) SCS SCV = Disproved (\ x -> case x of) (%~) SCS SCW = Disproved (\ x -> case x of) (%~) SCS SCX = Disproved (\ x -> case x of) (%~) SCS SCY = Disproved (\ x -> case x of) (%~) SCS SCZ = Disproved (\ x -> case x of) (%~) SCT SCA = Disproved (\ x -> case x of) (%~) SCT SCB = Disproved (\ x -> case x of) (%~) SCT SCC = Disproved (\ x -> case x of) (%~) SCT SCD = Disproved (\ x -> case x of) (%~) SCT SCE = Disproved (\ x -> case x of) (%~) SCT SCF = Disproved (\ x -> case x of) (%~) SCT SCG = Disproved (\ x -> case x of) (%~) SCT SCH = Disproved (\ x -> case x of) (%~) SCT SCI = Disproved (\ x -> case x of) (%~) SCT SCJ = Disproved (\ x -> case x of) (%~) SCT SCK = Disproved (\ x -> case x of) (%~) SCT SCL = Disproved (\ x -> case x of) (%~) SCT SCM = Disproved (\ x -> case x of) (%~) SCT SCN = Disproved (\ x -> case x of) (%~) SCT SCO = Disproved (\ x -> case x of) (%~) SCT SCP = Disproved (\ x -> case x of) (%~) SCT SCQ = Disproved (\ x -> case x of) (%~) SCT SCR = Disproved (\ x -> case x of) (%~) SCT SCS = Disproved (\ x -> case x of) (%~) SCT SCT = Proved Refl (%~) SCT SCU = Disproved (\ x -> case x of) (%~) SCT SCV = Disproved (\ x -> case x of) (%~) SCT SCW = Disproved (\ x -> case x of) (%~) SCT SCX = Disproved (\ x -> case x of) (%~) SCT SCY = Disproved (\ x -> case x of) (%~) SCT SCZ = Disproved (\ x -> case x of) (%~) SCU SCA = Disproved (\ x -> case x of) (%~) SCU SCB = Disproved (\ x -> case x of) (%~) SCU SCC = Disproved (\ x -> case x of) (%~) SCU SCD = Disproved (\ x -> case x of) (%~) SCU SCE = Disproved (\ x -> case x of) (%~) SCU SCF = Disproved (\ x -> case x of) (%~) SCU SCG = Disproved (\ x -> case x of) (%~) SCU SCH = Disproved (\ x -> case x of) (%~) SCU SCI = Disproved (\ x -> case x of) (%~) SCU SCJ = Disproved (\ x -> case x of) (%~) SCU SCK = Disproved (\ x -> case x of) (%~) SCU SCL = Disproved (\ x -> case x of) (%~) SCU SCM = Disproved (\ x -> case x of) (%~) SCU SCN = Disproved (\ x -> case x of) (%~) SCU SCO = Disproved (\ x -> case x of) (%~) SCU SCP = Disproved (\ x -> case x of) (%~) SCU SCQ = Disproved (\ x -> case x of) (%~) SCU SCR = Disproved (\ x -> case x of) (%~) SCU SCS = Disproved (\ x -> case x of) (%~) SCU SCT = Disproved (\ x -> case x of) (%~) SCU SCU = Proved Refl (%~) SCU SCV = Disproved (\ x -> case x of) (%~) SCU SCW = Disproved (\ x -> case x of) (%~) SCU SCX = Disproved (\ x -> case x of) (%~) SCU SCY = Disproved (\ x -> case x of) (%~) SCU SCZ = Disproved (\ x -> case x of) (%~) SCV SCA = Disproved (\ x -> case x of) (%~) SCV SCB = Disproved (\ x -> case x of) (%~) SCV SCC = Disproved (\ x -> case x of) (%~) SCV SCD = Disproved (\ x -> case x of) (%~) SCV SCE = Disproved (\ x -> case x of) (%~) SCV SCF = Disproved (\ x -> case x of) (%~) SCV SCG = Disproved (\ x -> case x of) (%~) SCV SCH = Disproved (\ x -> case x of) (%~) SCV SCI = Disproved (\ x -> case x of) (%~) SCV SCJ = Disproved (\ x -> case x of) (%~) SCV SCK = Disproved (\ x -> case x of) (%~) SCV SCL = Disproved (\ x -> case x of) (%~) SCV SCM = Disproved (\ x -> case x of) (%~) SCV SCN = Disproved (\ x -> case x of) (%~) SCV SCO = Disproved (\ x -> case x of) (%~) SCV SCP = Disproved (\ x -> case x of) (%~) SCV SCQ = Disproved (\ x -> case x of) (%~) SCV SCR = Disproved (\ x -> case x of) (%~) SCV SCS = Disproved (\ x -> case x of) (%~) SCV SCT = Disproved (\ x -> case x of) (%~) SCV SCU = Disproved (\ x -> case x of) (%~) SCV SCV = Proved Refl (%~) SCV SCW = Disproved (\ x -> case x of) (%~) SCV SCX = Disproved (\ x -> case x of) (%~) SCV SCY = Disproved (\ x -> case x of) (%~) SCV SCZ = Disproved (\ x -> case x of) (%~) SCW SCA = Disproved (\ x -> case x of) (%~) SCW SCB = Disproved (\ x -> case x of) (%~) SCW SCC = Disproved (\ x -> case x of) (%~) SCW SCD = Disproved (\ x -> case x of) (%~) SCW SCE = Disproved (\ x -> case x of) (%~) SCW SCF = Disproved (\ x -> case x of) (%~) SCW SCG = Disproved (\ x -> case x of) (%~) SCW SCH = Disproved (\ x -> case x of) (%~) SCW SCI = Disproved (\ x -> case x of) (%~) SCW SCJ = Disproved (\ x -> case x of) (%~) SCW SCK = Disproved (\ x -> case x of) (%~) SCW SCL = Disproved (\ x -> case x of) (%~) SCW SCM = Disproved (\ x -> case x of) (%~) SCW SCN = Disproved (\ x -> case x of) (%~) SCW SCO = Disproved (\ x -> case x of) (%~) SCW SCP = Disproved (\ x -> case x of) (%~) SCW SCQ = Disproved (\ x -> case x of) (%~) SCW SCR = Disproved (\ x -> case x of) (%~) SCW SCS = Disproved (\ x -> case x of) (%~) SCW SCT = Disproved (\ x -> case x of) (%~) SCW SCU = Disproved (\ x -> case x of) (%~) SCW SCV = Disproved (\ x -> case x of) (%~) SCW SCW = Proved Refl (%~) SCW SCX = Disproved (\ x -> case x of) (%~) SCW SCY = Disproved (\ x -> case x of) (%~) SCW SCZ = Disproved (\ x -> case x of) (%~) SCX SCA = Disproved (\ x -> case x of) (%~) SCX SCB = Disproved (\ x -> case x of) (%~) SCX SCC = Disproved (\ x -> case x of) (%~) SCX SCD = Disproved (\ x -> case x of) (%~) SCX SCE = Disproved (\ x -> case x of) (%~) SCX SCF = Disproved (\ x -> case x of) (%~) SCX SCG = Disproved (\ x -> case x of) (%~) SCX SCH = Disproved (\ x -> case x of) (%~) SCX SCI = Disproved (\ x -> case x of) (%~) SCX SCJ = Disproved (\ x -> case x of) (%~) SCX SCK = Disproved (\ x -> case x of) (%~) SCX SCL = Disproved (\ x -> case x of) (%~) SCX SCM = Disproved (\ x -> case x of) (%~) SCX SCN = Disproved (\ x -> case x of) (%~) SCX SCO = Disproved (\ x -> case x of) (%~) SCX SCP = Disproved (\ x -> case x of) (%~) SCX SCQ = Disproved (\ x -> case x of) (%~) SCX SCR = Disproved (\ x -> case x of) (%~) SCX SCS = Disproved (\ x -> case x of) (%~) SCX SCT = Disproved (\ x -> case x of) (%~) SCX SCU = Disproved (\ x -> case x of) (%~) SCX SCV = Disproved (\ x -> case x of) (%~) SCX SCW = Disproved (\ x -> case x of) (%~) SCX SCX = Proved Refl (%~) SCX SCY = Disproved (\ x -> case x of) (%~) SCX SCZ = Disproved (\ x -> case x of) (%~) SCY SCA = Disproved (\ x -> case x of) (%~) SCY SCB = Disproved (\ x -> case x of) (%~) SCY SCC = Disproved (\ x -> case x of) (%~) SCY SCD = Disproved (\ x -> case x of) (%~) SCY SCE = Disproved (\ x -> case x of) (%~) SCY SCF = Disproved (\ x -> case x of) (%~) SCY SCG = Disproved (\ x -> case x of) (%~) SCY SCH = Disproved (\ x -> case x of) (%~) SCY SCI = Disproved (\ x -> case x of) (%~) SCY SCJ = Disproved (\ x -> case x of) (%~) SCY SCK = Disproved (\ x -> case x of) (%~) SCY SCL = Disproved (\ x -> case x of) (%~) SCY SCM = Disproved (\ x -> case x of) (%~) SCY SCN = Disproved (\ x -> case x of) (%~) SCY SCO = Disproved (\ x -> case x of) (%~) SCY SCP = Disproved (\ x -> case x of) (%~) SCY SCQ = Disproved (\ x -> case x of) (%~) SCY SCR = Disproved (\ x -> case x of) (%~) SCY SCS = Disproved (\ x -> case x of) (%~) SCY SCT = Disproved (\ x -> case x of) (%~) SCY SCU = Disproved (\ x -> case x of) (%~) SCY SCV = Disproved (\ x -> case x of) (%~) SCY SCW = Disproved (\ x -> case x of) (%~) SCY SCX = Disproved (\ x -> case x of) (%~) SCY SCY = Proved Refl (%~) SCY SCZ = Disproved (\ x -> case x of) (%~) SCZ SCA = Disproved (\ x -> case x of) (%~) SCZ SCB = Disproved (\ x -> case x of) (%~) SCZ SCC = Disproved (\ x -> case x of) (%~) SCZ SCD = Disproved (\ x -> case x of) (%~) SCZ SCE = Disproved (\ x -> case x of) (%~) SCZ SCF = Disproved (\ x -> case x of) (%~) SCZ SCG = Disproved (\ x -> case x of) (%~) SCZ SCH = Disproved (\ x -> case x of) (%~) SCZ SCI = Disproved (\ x -> case x of) (%~) SCZ SCJ = Disproved (\ x -> case x of) (%~) SCZ SCK = Disproved (\ x -> case x of) (%~) SCZ SCL = Disproved (\ x -> case x of) (%~) SCZ SCM = Disproved (\ x -> case x of) (%~) SCZ SCN = Disproved (\ x -> case x of) (%~) SCZ SCO = Disproved (\ x -> case x of) (%~) SCZ SCP = Disproved (\ x -> case x of) (%~) SCZ SCQ = Disproved (\ x -> case x of) (%~) SCZ SCR = Disproved (\ x -> case x of) (%~) SCZ SCS = Disproved (\ x -> case x of) (%~) SCZ SCT = Disproved (\ x -> case x of) (%~) SCZ SCU = Disproved (\ x -> case x of) (%~) SCZ SCV = Disproved (\ x -> case x of) (%~) SCZ SCW = Disproved (\ x -> case x of) (%~) SCZ SCX = Disproved (\ x -> case x of) (%~) SCZ SCY = Disproved (\ x -> case x of) (%~) SCZ SCZ = Proved Refl deriving instance (Data.Singletons.ShowSing.ShowSing U, Data.Singletons.ShowSing.ShowSing Nat) => Show (Sing (z :: U)) deriving instance Show (Sing (z :: AChar)) instance SingI BOOL where sing = SBOOL instance SingI STRING where sing = SSTRING instance SingI NAT where sing = SNAT instance (SingI n, SingI n) => SingI (VEC (n :: U) (n :: Nat)) where sing = (SVEC sing) sing instance SingI (VECSym0 :: (~>) U ((~>) Nat U)) where sing = (singFun2 @VECSym0) SVEC instance SingI (TyCon2 VEC :: (~>) U ((~>) Nat U)) where sing = (singFun2 @(TyCon2 VEC)) SVEC instance SingI d => SingI (VECSym1 (d :: U) :: (~>) Nat U) where sing = (singFun1 @(VECSym1 (d :: U))) (SVEC (sing @d)) instance SingI d => SingI (TyCon1 (VEC (d :: U)) :: (~>) Nat U) where sing = (singFun1 @(TyCon1 (VEC (d :: U)))) (SVEC (sing @d)) instance SingI CA where sing = SCA instance SingI CB where sing = SCB instance SingI CC where sing = SCC instance SingI CD where sing = SCD instance SingI CE where sing = SCE instance SingI CF where sing = SCF instance SingI CG where sing = SCG instance SingI CH where sing = SCH instance SingI CI where sing = SCI instance SingI CJ where sing = SCJ instance SingI CK where sing = SCK instance SingI CL where sing = SCL instance SingI CM where sing = SCM instance SingI CN where sing = SCN instance SingI CO where sing = SCO instance SingI CP where sing = SCP instance SingI CQ where sing = SCQ instance SingI CR where sing = SCR instance SingI CS where sing = SCS instance SingI CT where sing = SCT instance SingI CU where sing = SCU instance SingI CV where sing = SCV instance SingI CW where sing = SCW instance SingI CX where sing = SCX instance SingI CY where sing = SCY instance SingI CZ where sing = SCZ instance (SingI n, SingI n) => SingI (Attr (n :: [AChar]) (n :: U)) where sing = (SAttr sing) sing instance SingI (AttrSym0 :: (~>) [AChar] ((~>) U Attribute)) where sing = (singFun2 @AttrSym0) SAttr instance SingI (TyCon2 Attr :: (~>) [AChar] ((~>) U Attribute)) where sing = (singFun2 @(TyCon2 Attr)) SAttr instance SingI d => SingI (AttrSym1 (d :: [AChar]) :: (~>) U Attribute) where sing = (singFun1 @(AttrSym1 (d :: [AChar]))) (SAttr (sing @d)) instance SingI d => SingI (TyCon1 (Attr (d :: [AChar])) :: (~>) U Attribute) where sing = (singFun1 @(TyCon1 (Attr (d :: [AChar])))) (SAttr (sing @d)) instance SingI n => SingI (Sch (n :: [Attribute])) where sing = SSch sing instance SingI (SchSym0 :: (~>) [Attribute] Schema) where sing = (singFun1 @SchSym0) SSch instance SingI (TyCon1 Sch :: (~>) [Attribute] Schema) where sing = (singFun1 @(TyCon1 Sch)) SSch GradingClient/Database.hs:0:0:: Splicing declarations return [] ======> GradingClient/Database.hs:(0,0)-(0,0): Splicing expression cases ''Row [| r |] [| changeId (n ++ (getId r)) r |] ======> case r of EmptyRow _ -> (changeId (((++) n) (getId r))) r ConsRow _ _ -> (changeId (((++) n) (getId r))) r singletons-2.5.1/tests/compile-and-dump/GradingClient/Database.hs0000755000000000000000000005250007346545000023151 0ustar0000000000000000{- Database.hs (c) Richard Eisenberg 2012 rae@cs.brynmawr.edu This file contains the full code for the database interface example presented in /Dependently typed programming with singletons/ -} {-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies, GADTs, TypeOperators, RankNTypes, FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, ConstraintKinds, InstanceSigs #-} {-# OPTIONS_GHC -Wno-warnings-deprecations #-} -- The OverlappingInstances is needed only to allow the InC and SubsetC classes. -- This is simply a convenience so that GHC can infer the necessary proofs of -- schema inclusion. The library could easily be designed without this flag, -- but it would require a client to explicity build proof terms from -- InProof and Subset. module GradingClient.Database where import Prelude hiding ( tail, id ) import Data.Singletons.Prelude hiding ( Lookup, sLookup ) import Data.Singletons.Prelude.Show import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Control.Monad import Control.Monad.Except ( throwError ) import Data.List hiding ( tail ) import Data.Kind (Type) $(singletons [d| -- Basic Nat type data Nat = Zero | Succ Nat deriving (Eq, Ord) |]) -- Conversions to any from Integers fromNat :: Nat -> Integer fromNat Zero = 0 fromNat (Succ n) = (fromNat n) + 1 toNat :: Integer -> Nat toNat 0 = Zero toNat n | n > 0 = Succ (toNat (n - 1)) toNat _ = error "Converting negative to Nat" -- Display and read Nats using decimal digits instance Show Nat where show = show . fromNat instance Read Nat where readsPrec n s = map (\(a,rest) -> (toNat a,rest)) $ readsPrec n s $(singletons [d| -- Our "U"niverse of types. These types can be stored in our database. data U = BOOL | STRING | NAT | VEC U Nat deriving (Read, Eq, Show) -- A re-definition of Char as an algebraic data type. -- This is necessary to allow for promotion and type-level Strings. data AChar = CA | CB | CC | CD | CE | CF | CG | CH | CI | CJ | CK | CL | CM | CN | CO | CP | CQ | CR | CS | CT | CU | CV | CW | CX | CY | CZ deriving (Read, Show, Eq) -- A named attribute in our database data Attribute = Attr [AChar] U -- A schema is an ordered list of named attributes data Schema = Sch [Attribute] -- append two schemas append :: Schema -> Schema -> Schema append (Sch s1) (Sch s2) = Sch (s1 ++ s2) -- predicate to check that a schema is free of a certain attribute attrNotIn :: Attribute -> Schema -> Bool attrNotIn _ (Sch []) = True attrNotIn (Attr name u) (Sch ((Attr name' _) : t)) = (name /= name') && (attrNotIn (Attr name u) (Sch t)) -- predicate to check that two schemas are disjoint disjoint :: Schema -> Schema -> Bool disjoint (Sch []) _ = True disjoint (Sch (h : t)) s = (attrNotIn h s) && (disjoint (Sch t) s) -- predicate to check if a name occurs in a schema occurs :: [AChar] -> Schema -> Bool occurs _ (Sch []) = False occurs name (Sch ((Attr name' _) : attrs)) = name == name' || occurs name (Sch attrs) -- looks up an element type from a schema lookup :: [AChar] -> Schema -> U lookup _ (Sch []) = undefined lookup name (Sch ((Attr name' u) : attrs)) = if name == name' then u else lookup name (Sch attrs) |]) -- The El type family gives us the type associated with a constructor -- of U: type family El (u :: U) :: Type type instance El BOOL = Bool type instance El STRING = String type instance El NAT = Nat type instance El (VEC u n) = Vec (El u) n -- Length-indexed vectors data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) -- Read instances are keyed by the index of the vector to aid in parsing instance Read (Vec a Zero) where readsPrec _ s = [(VNil, s)] instance (Read a, Read (Vec a n)) => Read (Vec a (Succ n)) where readsPrec n s = do (a, rest) <- readsPrec n s (tail, restrest) <- readsPrec n rest return (VCons a tail, restrest) -- Because the Read instances are keyed by the length of the vector, -- it is not obvious to the compiler that all Vecs have a Read instance. -- We must make a short inductive proof of this fact. -- First, we define a datatype to store the resulting instance, keyed -- by the parameters to Vec: data VecReadInstance a n where VecReadInstance :: Read (Vec a n) => VecReadInstance a n -- Then, we make a function that produces an instance of Read for a -- Vec, given the datatype it is over and its length, both encoded -- using singleton types: vecReadInstance :: Read (El u) => SU u -> SNat n -> VecReadInstance (El u) n vecReadInstance _ SZero = VecReadInstance vecReadInstance u (SSucc n) = case vecReadInstance u n of VecReadInstance -> VecReadInstance -- The Show instance can be straightforwardly defined: instance Show a => Show (Vec a n) where show VNil = "" show (VCons h t) = (show h) ++ " " ++ (show t) -- We need to be able to Read and Show elements of our database, so -- we must know that any type of the form (El u) for some (u :: U) -- has a Read and Show instance. Because we can't declare this instance -- directly (as, in general, declaring an instance of a type family -- would be unsound), we provide inductive proofs that these instances -- exist: data ElUReadInstance u where ElUReadInstance :: Read (El u) => ElUReadInstance u elUReadInstance :: Sing u -> ElUReadInstance u elUReadInstance SBOOL = ElUReadInstance elUReadInstance SSTRING = ElUReadInstance elUReadInstance SNAT = ElUReadInstance elUReadInstance (SVEC u n) = case elUReadInstance u of ElUReadInstance -> case vecReadInstance u n of VecReadInstance -> ElUReadInstance data ElUShowInstance u where ElUShowInstance :: Show (El u) => ElUShowInstance u elUShowInstance :: Sing u -> ElUShowInstance u elUShowInstance SBOOL = ElUShowInstance elUShowInstance SSTRING = ElUShowInstance elUShowInstance SNAT = ElUShowInstance elUShowInstance (SVEC u _) = case elUShowInstance u of ElUShowInstance -> ElUShowInstance showAttrProof :: Sing (Attr nm u) -> ElUShowInstance u showAttrProof (SAttr _ u) = elUShowInstance u -- A Row is one row of our database table, keyed by its schema. data Row :: Schema -> Type where EmptyRow :: [Int] -> Row (Sch '[]) -- the Ints are the unique id of the row ConsRow :: El u -> Row (Sch s) -> Row (Sch ((Attr name u) ': s)) -- We build Show instances for a Row element by element: instance Show (Row (Sch '[])) where show (EmptyRow n) = "(id=" ++ (show n) ++ ")" instance (Show (El u), Show (Row (Sch attrs))) => Show (Row (Sch ((Attr name u) ': attrs))) where show (ConsRow h t) = case t of EmptyRow n -> (show h) ++ " (id=" ++ (show n) ++ ")" _ -> (show h) ++ ", " ++ (show t) -- A Handle in our system is an abstract handle to a loaded table. -- The constructor is not exported. In our simplistic case, we -- just store the list of rows. A more sophisticated implementation -- could store some identifier to the connection to an external database. data Handle :: Schema -> Type where Handle :: [Row s] -> Handle s -- The following functions parse our very simple flat file database format. -- The file, with a name ending in ".dat", consists of a sequence of lines, -- where each line contains one entry in the table. There is no row separator; -- if a row contains n pieces of data, that row is represented in n lines in -- the file. -- A schema is stored in a file of the same name, except ending in ".schema". -- Each line in the file is a constructor of U indicating the type of the -- corresponding row element. -- Use Either for error handling in parsing functions type ErrorM = Either String -- This function is relatively uninteresting except for its use of -- pattern matching to introduce the instances of Read and Show for -- elements readRow :: Int -> SSchema s -> [String] -> ErrorM (Row s, [String]) readRow id (SSch SNil) strs = return (EmptyRow [id], strs) readRow _ (SSch (SCons _ _)) [] = throwError "Ran out of data while processing row" readRow id (SSch (SCons (SAttr _ u) at)) (sh:st) = do (rowTail, strTail) <- readRow id (SSch at) st case elUReadInstance u of ElUReadInstance -> let results = readsPrec 0 sh in if null results then throwError $ "No parse of " ++ sh ++ " as a " ++ (show (fromSing u)) else let item = fst $ head results in case elUShowInstance u of ElUShowInstance -> return (ConsRow item rowTail, strTail) readRows :: SSchema s -> [String] -> [Row s] -> ErrorM [Row s] readRows _ [] soFar = return soFar readRows sch lst soFar = do (row, rest) <- readRow (length soFar) sch lst readRows sch rest (row : soFar) -- Given the name of a database and its schema, return a handle to the -- database. connect :: String -> SSchema s -> IO (Handle s) connect name schema = do schString <- readFile (name ++ ".schema") let schEntries = lines schString usFound = map read schEntries -- load schema just using "read" (Sch attrs) = fromSing schema usExpected = map (\(Attr _ u) -> u) attrs unless (usFound == usExpected) -- compare found schema with expected (fail "Expected schema does not match found schema") dataString <- readFile (name ++ ".dat") let dataEntries = lines dataString result = readRows schema dataEntries [] -- read actual data case result of Left errorMsg -> fail errorMsg Right rows -> return $ Handle rows -- In order to define strongly-typed projection from a row, we need to have a notion -- that one schema is a subset of another. We permit the schemas to have their columns -- in different orders. We define this subset relation via two inductively defined -- propositions. In Haskell, these inductively defined propositions take the form of -- GADTs. In their original form, they would look like this: {- data InProof :: Attribute -> Schema -> Type where InElt :: InProof attr (Sch (attr ': schTail)) InTail :: InProof attr (Sch attrs) -> InProof attr (Sch (a ': attrs)) data SubsetProof :: Schema -> Schema -> Type where SubsetEmpty :: SubsetProof (Sch '[]) s' SubsetCons :: InProof attr s' -> SubsetProof (Sch attrs) s' -> SubsetProof (Sch (attr ': attrs)) s' -} -- However, it would be convenient to users of the database library not to require -- building these proofs manually. So, we define type classes so that the compiler -- builds the proofs automatically. To make everything work well together, we also -- make the parameters to the proof GADT constructors implicit -- i.e. in the form -- of type class constraints. data InProof :: Attribute -> Schema -> Type where InElt :: InProof attr (Sch (attr ': schTail)) InTail :: InC name u (Sch attrs) => InProof (Attr name u) (Sch (a ': attrs)) class InC (name :: [AChar]) (u :: U) (sch :: Schema) where inProof :: InProof (Attr name u) sch instance InC name u (Sch ((Attr name u) ': schTail)) where inProof = InElt instance InC name u (Sch attrs) => InC name u (Sch (a ': attrs)) where inProof = InTail data SubsetProof :: Schema -> Schema -> Type where SubsetEmpty :: SubsetProof (Sch '[]) s' SubsetCons :: (InC name u s', SubsetC (Sch attrs) s') => SubsetProof (Sch ((Attr name u) ': attrs)) s' class SubsetC (s :: Schema) (s' :: Schema) where subset :: SubsetProof s s' instance SubsetC (Sch '[]) s' where subset = SubsetEmpty instance (InC name u s', SubsetC (Sch attrs) s') => SubsetC (Sch ((Attr name u) ': attrs)) s' where subset = SubsetCons -- To access the data in a structured (and well-typed!) way, we use -- an RA (short for Relational Algebra). An RA is indexed by the schema -- of the data it produces. data RA :: Schema -> Type where -- The RA includes all data represented by the handle. Read :: Handle s -> RA s -- The RA is a union of the rows represented by the two RAs provided. -- Note that the schemas of the two RAs must be the same for this -- constructor use to type-check. Union :: RA s -> RA s -> RA s -- The RA is the list of rows in the first RA, omitting those in the -- second. Once again, the schemas must match. Diff :: RA s -> RA s -> RA s -- The RA is a Cartesian product of the two RAs provided. Note that -- the schemas of the two provided RAs must be disjoint. Product :: (Disjoint s s' ~ True, SingI s, SingI s') => RA s -> RA s' -> RA (Append s s') -- The RA is a projection conforming to the schema provided. The -- type-checker ensures that this schema is a subset of the data -- included in the provided RA. Project :: (SubsetC s' s, SingI s) => SSchema s' -> RA s -> RA s' -- The RA contains only those rows of the provided RA for which -- the provided expression evaluates to True. Note that the -- schema of the provided RA and the resultant RA are the same -- because the columns of data are the same. Also note that -- the expression must return a Bool for this to type-check. Select :: Expr s BOOL -> RA s -> RA s -- Other constructors would be added in a more robust database -- implementation. -- An Expr is used with the Select constructor to choose some -- subset of rows from a table. Expressions are indexed by the -- schema over which they operate and the return value they -- produce. data Expr :: Schema -> U -> Type where -- Equality among two elements Equal :: Eq (El u) => Expr s u -> Expr s u -> Expr s BOOL -- A less-than comparison among two Nats LessThan :: Expr s NAT -> Expr s NAT -> Expr s BOOL -- A literal number LiteralNat :: Integer -> Expr s NAT -- Projection in an expression -- evaluates to the value -- of the named attribute. Element :: (Occurs nm s ~ True) => SSchema s -> Sing nm -> Expr s (Lookup nm s) -- A more robust implementation would include more constructors -- Retrieves the id from a row. Ids are used when computing unions and -- differences. getId :: Row s -> [Int] getId (EmptyRow n) = n getId (ConsRow _ t) = getId t -- Changes the id of a row to a new value changeId :: [Int] -> Row s -> Row s changeId n (EmptyRow _) = EmptyRow n changeId n (ConsRow h t) = ConsRow h (changeId n t) -- Equality for rows based on ids. eqRow :: Row s -> Row s -> Bool eqRow r1 r2 = getId r1 == getId r2 -- Equality for attributes based on names eqAttr :: Attribute -> Attribute -> Bool eqAttr (Attr nm _) (Attr nm' _) = nm == nm' -- Appends two rows. There are three suspicious case statements -- they are -- suspicious in that the different branches are all exactly identical. Here -- is why they are needed: -- The two case statements on r are necessary to deconstruct the index in the -- type of r; GHC does not use the fact that s' must be (Sch a') for some a'. -- By doing a case analysis on r, GHC uses the types given in the different -- constructors for Row, both of which give the form of s' as (Sch a'). This -- deconstruction is necessary for the type family Append to compute, because -- Append is defined only when its second argument is of the form (Sch a'). -- The case statement on rowAppend t r is necessary to avoid potential -- overlapping instances for the SingRep class; the instances are needed for -- the call to ConsRow. The potential for overlapping instances comes from -- ambiguity in the component types of (Append s s'). By doing case analysis -- on rowAppend t r, these variables become fixed, and the potential for -- overlapping instances disappears. -- We use the "cases" Singletons library operation to produce the case -- analysis in the first clause. This "cases" operation produces a case -- statement where each branch is identical and each constructor parameter -- is ignored. The "cases" operation does not work for the second clause -- because the code in the clause depends on definitions generated earlier. -- Template Haskell restricts certain dependencies between auto-generated -- code blocks to prevent the possibility of circular dependencies. -- In this case, if the $(singletons ...) blocks above were in a different -- module, the "cases" operation would be applicable here. $( return [] ) rowAppend :: Row s -> Row s' -> Row (Append s s') rowAppend (EmptyRow n) r = $(cases ''Row [| r |] [| changeId (n ++ (getId r)) r |]) rowAppend (ConsRow h t) r = case r of EmptyRow _ -> case rowAppend t r of EmptyRow _ -> ConsRow h (rowAppend t r) ConsRow _ _ -> ConsRow h (rowAppend t r) ConsRow _ _ -> case rowAppend t r of EmptyRow _ -> ConsRow h (rowAppend t r) ConsRow _ _ -> ConsRow h (rowAppend t r) -- Choose the elements of one list based on truth values in another choose :: [Bool] -> [a] -> [a] choose [] _ = [] choose (False : btail) (_ : t) = choose btail t choose (True : btail) (h : t) = h : (choose btail t) choose _ [] = [] -- The query function is the eliminator for an RA. It returns a list of -- rows containing the data produced by the RA. query :: forall s. SingI s => RA s -> IO [Row s] query (Read (Handle rows)) = return rows query (Union ra rb) = do rowsa <- query ra rowsb <- query rb return $ unionBy eqRow rowsa rowsb query (Diff ra rb) = do rowsa <- query ra rowsb <- query rb return $ deleteFirstsBy eqRow rowsa rowsb query (Product ra rb) = do rowsa <- query ra rowsb <- query rb return $ do -- entering the [] Monad rowa <- rowsa rowb <- rowsb return $ rowAppend rowa rowb query (Project sch ra) = do rows <- query ra return $ map (projectRow sch) rows where -- The projectRow function uses the relationship encoded in the Subset -- relation to project the requested columns of data in a type-safe manner. -- It recurs on the structure of the provided schema, creating the output -- row to be in the same order as the input schema. This is necessary for -- the output to type-check, as it is indexed by the input schema. -- We use explicit quantification to get access to scoped type variables. projectRow :: forall (sch :: Schema) (s' :: Schema). SubsetC sch s' => SSchema sch -> Row s' -> Row sch -- Base case: empty schema projectRow (SSch SNil) r = EmptyRow (getId r) -- In the recursive case, we need to pattern-match on the proof that -- the provided schema is a subset of the provided RA. We extract this -- proof (of type SubsetProof s s') from the SubsetC instance using the -- subset method. projectRow (SSch (SCons attr tail)) r = case subset :: SubsetProof sch s' of -- Because we know that the schema is non-empty, the only possibility -- here is SubsetCons: SubsetCons -> let rtail = projectRow (SSch tail) r in case attr of SAttr _ u -> case elUShowInstance u of ElUShowInstance -> ConsRow (extractElt attr r) rtail -- GHC correctly determines that this case is impossible if it is -- not commented. -- SubsetEmpty -> undefined <== IMPOSSIBLE -- However, the current version of GHC (7.5) does not suppress warnings -- for incomplete pattern matches when the remaining cases are impossible. -- So, we include this case (impossible to reach for any terminated value) -- to suppress the warning. -- Retrieves the element, looked up by the name of the provided attribute, -- from a row. The explicit quantification is necessary to create the scoped -- type variables to use in the return type of <> extractElt :: forall nm u sch. InC nm u sch => Sing (Attr nm u) -> Row sch -> El u extractElt attr r = case inProof :: InProof (Attr nm u) sch of InElt -> case r of ConsRow h _ -> h -- EmptyRow _ -> undefined <== IMPOSSIBLE InTail -> case r of ConsRow _ t -> extractElt attr t -- EmptyRow _ -> undefined <== IMPOSSBLE query (Select expr r) = do rows <- query r let vals = map (eval expr) rows return $ choose vals rows where -- Evaluates an expression eval :: forall s' u. SingI s' => Expr s' u -> Row s' -> El u eval (Element _ (name :: Sing name)) row = case row of -- EmptyRow _ -> undefined <== IMPOSSIBLE ConsRow h t -> case row of (ConsRow _ _ :: Row (Sch ((Attr name' u') ': attrs))) -> case sing :: Sing s' of -- SSch SNil -> undefined <== IMPOSSIBLE SSch (SCons (SAttr name' _) stail) -> case name %== name' of STrue -> h SFalse -> withSingI stail (eval (Element (SSch stail) name) t) eval (Equal (e1 :: Expr s' u') e2) row = let v1 = eval e1 row v2 = eval e2 row in v1 == v2 -- Note that the types really help us here: the LessThan constructor is -- defined only over Expr s NAT, so we know that evaluating e1 and e2 will -- yield Nats, which are a member of the Ord type class. eval (LessThan e1 e2) row = let v1 = eval e1 row v2 = eval e2 row in v1 < v2 eval (LiteralNat x) _ = toNat x data G a where GCons :: G ('Sch (a ': b)) data H a where HCons :: H ('Sch (a ': b)) HNil :: H ('Sch '[]) data J a where JCons :: J (a ': b) JNil :: J '[] eval :: G s -> Sing s -> () eval GCons s = case s of -- SSch SNil -> undefined -- <== IMPOSSIBLE SSch (SCons _ _) -> undefined singletons-2.5.1/tests/compile-and-dump/GradingClient/Main.ghc86.template0000755000000000000000000001542207346545000024452 0ustar0000000000000000GradingClient/Main.hs:(0,0)-(0,0): Splicing declarations singletons [d| lastName, firstName, yearName, gradeName, majorName :: [AChar] lastName = [CL, CA, CS, CT] firstName = [CF, CI, CR, CS, CT] yearName = [CY, CE, CA, CR] gradeName = [CG, CR, CA, CD, CE] majorName = [CM, CA, CJ, CO, CR] gradingSchema :: Schema gradingSchema = Sch [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, Attr gradeName NAT, Attr majorName BOOL] names :: Schema names = Sch [Attr firstName STRING, Attr lastName STRING] |] ======> lastName :: [AChar] firstName :: [AChar] yearName :: [AChar] gradeName :: [AChar] majorName :: [AChar] lastName = [CL, CA, CS, CT] firstName = [CF, CI, CR, CS, CT] yearName = [CY, CE, CA, CR] gradeName = [CG, CR, CA, CD, CE] majorName = [CM, CA, CJ, CO, CR] gradingSchema :: Schema gradingSchema = Sch [(Attr lastName) STRING, (Attr firstName) STRING, (Attr yearName) NAT, (Attr gradeName) NAT, (Attr majorName) BOOL] names :: Schema names = Sch [(Attr firstName) STRING, (Attr lastName) STRING] type MajorNameSym0 = MajorName type GradeNameSym0 = GradeName type YearNameSym0 = YearName type FirstNameSym0 = FirstName type LastNameSym0 = LastName type GradingSchemaSym0 = GradingSchema type NamesSym0 = Names type family MajorName :: [AChar] where MajorName = Apply (Apply (:@#@$) CMSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CJSym0) (Apply (Apply (:@#@$) COSym0) (Apply (Apply (:@#@$) CRSym0) '[])))) type family GradeName :: [AChar] where GradeName = Apply (Apply (:@#@$) CGSym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CDSym0) (Apply (Apply (:@#@$) CESym0) '[])))) type family YearName :: [AChar] where YearName = Apply (Apply (:@#@$) CYSym0) (Apply (Apply (:@#@$) CESym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CRSym0) '[]))) type family FirstName :: [AChar] where FirstName = Apply (Apply (:@#@$) CFSym0) (Apply (Apply (:@#@$) CISym0) (Apply (Apply (:@#@$) CRSym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[])))) type family LastName :: [AChar] where LastName = Apply (Apply (:@#@$) CLSym0) (Apply (Apply (:@#@$) CASym0) (Apply (Apply (:@#@$) CSSym0) (Apply (Apply (:@#@$) CTSym0) '[]))) type family GradingSchema :: Schema where GradingSchema = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 YearNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 GradeNameSym0) NATSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 MajorNameSym0) BOOLSym0)) '[]))))) type family Names :: Schema where Names = Apply SchSym0 (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 FirstNameSym0) STRINGSym0)) (Apply (Apply (:@#@$) (Apply (Apply AttrSym0 LastNameSym0) STRINGSym0)) '[])) sMajorName :: Sing (MajorNameSym0 :: [AChar]) sGradeName :: Sing (GradeNameSym0 :: [AChar]) sYearName :: Sing (YearNameSym0 :: [AChar]) sFirstName :: Sing (FirstNameSym0 :: [AChar]) sLastName :: Sing (LastNameSym0 :: [AChar]) sGradingSchema :: Sing (GradingSchemaSym0 :: Schema) sNames :: Sing (NamesSym0 :: Schema) sMajorName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCM)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCJ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCO)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil)))) sGradeName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCG)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCD)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE)) SNil)))) sYearName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCY)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCE)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) SNil))) sFirstName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCF)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCI)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCR)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil)))) sLastName = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCL)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCA)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCS)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SCT)) SNil))) sGradingSchema = (applySing ((singFun1 @SchSym0) SSch)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) SSTRING))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) SSTRING))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sYearName)) SNAT))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sGradeName)) SNAT))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sMajorName)) SBOOL))) SNil))))) sNames = (applySing ((singFun1 @SchSym0) SSch)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sFirstName)) SSTRING))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @AttrSym0) SAttr)) sLastName)) SSTRING))) SNil)) singletons-2.5.1/tests/compile-and-dump/GradingClient/Main.hs0000755000000000000000000000270507346545000022333 0ustar0000000000000000{- GradingClient.hs (c) Richard Eisenberg 2012 rae@cs.brynmawr.edu This file accesses the database described in Database.hs and performs some basic queries on it. -} {-# LANGUAGE TemplateHaskell, DataKinds #-} module Main where import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.List import GradingClient.Database $(singletons [d| lastName, firstName, yearName, gradeName, majorName :: [AChar] lastName = [CL, CA, CS, CT] firstName = [CF, CI, CR, CS, CT] yearName = [CY, CE, CA, CR] gradeName = [CG, CR, CA, CD, CE] majorName = [CM, CA, CJ, CO, CR] gradingSchema :: Schema gradingSchema = Sch [Attr lastName STRING, Attr firstName STRING, Attr yearName NAT, Attr gradeName NAT, Attr majorName BOOL] names :: Schema names = Sch [Attr firstName STRING, Attr lastName STRING] |]) main :: IO () main = do h <- connect "grades" sGradingSchema let ra = Read h allStudents <- query $ Project sNames ra putStrLn $ "Names of all students: " ++ (show allStudents) ++ "\n" majors <- query $ Select (Element sGradingSchema sMajorName) ra putStrLn $ "Students in major: " ++ (show majors) ++ "\n" b_students <- query $ Project sNames $ Select (LessThan (Element sGradingSchema sGradeName) (LiteralNat 90)) ra putStrLn $ "Names of students with grade < 90: " ++ (show b_students) ++ "\n" singletons-2.5.1/tests/compile-and-dump/InsertionSort/0000755000000000000000000000000007346545000021214 5ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template0000755000000000000000000003204207346545000027163 0ustar0000000000000000InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Nat = Zero | Succ Nat |] ======> data Nat = Zero | Succ Nat type ZeroSym0 = Zero type SuccSym1 (t0123456789876543210 :: Nat) = Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat where SuccSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 data instance Sing :: Nat -> Type where SZero :: Sing Zero SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) type SNat = (Sing :: Nat -> Type) instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero fromSing (SSucc b) = Succ (fromSing b) toSing Zero = SomeSing SZero toSing (Succ (b :: Demote Nat)) = case toSing b :: SomeSing Nat of { SomeSing c -> SomeSing (SSucc c) } instance SingI Zero where sing = SZero instance SingI n => SingI (Succ (n :: Nat)) where sing = SSucc sing instance SingI (SuccSym0 :: (~>) Nat Nat) where sing = (singFun1 @SuccSym0) SSucc instance SingI (TyCon1 Succ :: (~>) Nat Nat) where sing = (singFun1 @(TyCon1 Succ)) SSucc InsertionSort/InsertionSortImp.hs:(0,0)-(0,0): Splicing declarations singletons [d| leq :: Nat -> Nat -> Bool leq Zero _ = True leq (Succ _) Zero = False leq (Succ a) (Succ b) = leq a b insert :: Nat -> [Nat] -> [Nat] insert n [] = [n] insert n (h : t) = if leq n h then (n : h : t) else h : (insert n t) insertionSort :: [Nat] -> [Nat] insertionSort [] = [] insertionSort (h : t) = insert h (insertionSort t) |] ======> leq :: Nat -> Nat -> Bool leq Zero _ = True leq (Succ _) Zero = False leq (Succ a) (Succ b) = (leq a) b insert :: Nat -> [Nat] -> [Nat] insert n [] = [n] insert n (h : t) = if (leq n) h then (n : (h : t)) else (h : (insert n) t) insertionSort :: [Nat] -> [Nat] insertionSort [] = [] insertionSort (h : t) = (insert h) (insertionSort t) type Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 n0123456789876543210 h0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference :: forall n0123456789876543210 h0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n0123456789876543210 h0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 t0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 h0123456789876543210 n0123456789876543210) t0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 h0123456789876543210 n0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall n0123456789876543210 h0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 h0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210) h0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym2 n0123456789876543210 h0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall n0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 n0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 n0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 n h t where Let0123456789876543210Scrutinee_0123456789876543210 n h t = Apply (Apply LeqSym0 n) h type family Case_0123456789876543210 n h t t where Case_0123456789876543210 n h t 'True = Apply (Apply (:@#@$) n) (Apply (Apply (:@#@$) h) t) Case_0123456789876543210 n h t 'False = Apply (Apply (:@#@$) h) (Apply (Apply InsertSym0 n) t) type LeqSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Leq a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (LeqSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) LeqSym1KindInference) ()) data LeqSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Bool where LeqSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (LeqSym1 a0123456789876543210) arg) (LeqSym2 a0123456789876543210 arg) => LeqSym1 a0123456789876543210 a0123456789876543210 type instance Apply (LeqSym1 a0123456789876543210) a0123456789876543210 = Leq a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings LeqSym0 where suppressUnusedWarnings = snd (((,) LeqSym0KindInference) ()) data LeqSym0 :: (~>) Nat ((~>) Nat Bool) where LeqSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) => LeqSym0 a0123456789876543210 type instance Apply LeqSym0 a0123456789876543210 = LeqSym1 a0123456789876543210 type InsertSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [Nat]) = Insert a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (InsertSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) InsertSym1KindInference) ()) data InsertSym1 (a0123456789876543210 :: Nat) :: (~>) [Nat] [Nat] where InsertSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (InsertSym1 a0123456789876543210) arg) (InsertSym2 a0123456789876543210 arg) => InsertSym1 a0123456789876543210 a0123456789876543210 type instance Apply (InsertSym1 a0123456789876543210) a0123456789876543210 = Insert a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings InsertSym0 where suppressUnusedWarnings = snd (((,) InsertSym0KindInference) ()) data InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat]) where InsertSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) => InsertSym0 a0123456789876543210 type instance Apply InsertSym0 a0123456789876543210 = InsertSym1 a0123456789876543210 type InsertionSortSym1 (a0123456789876543210 :: [Nat]) = InsertionSort a0123456789876543210 instance SuppressUnusedWarnings InsertionSortSym0 where suppressUnusedWarnings = snd (((,) InsertionSortSym0KindInference) ()) data InsertionSortSym0 :: (~>) [Nat] [Nat] where InsertionSortSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) => InsertionSortSym0 a0123456789876543210 type instance Apply InsertionSortSym0 a0123456789876543210 = InsertionSort a0123456789876543210 type family Leq (a :: Nat) (a :: Nat) :: Bool where Leq 'Zero _ = TrueSym0 Leq ( 'Succ _) 'Zero = FalseSym0 Leq ( 'Succ a) ( 'Succ b) = Apply (Apply LeqSym0 a) b type family Insert (a :: Nat) (a :: [Nat]) :: [Nat] where Insert n '[] = Apply (Apply (:@#@$) n) '[] Insert n ( '(:) h t) = Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) type family InsertionSort (a :: [Nat]) :: [Nat] where InsertionSort '[] = '[] InsertionSort ( '(:) h t) = Apply (Apply InsertSym0 h) (Apply InsertionSortSym0 t) sLeq :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply LeqSym0 t) t :: Bool) sInsert :: forall (t :: Nat) (t :: [Nat]). Sing t -> Sing t -> Sing (Apply (Apply InsertSym0 t) t :: [Nat]) sInsertionSort :: forall (t :: [Nat]). Sing t -> Sing (Apply InsertionSortSym0 t :: [Nat]) sLeq SZero _ = STrue sLeq (SSucc _) SZero = SFalse sLeq (SSucc (sA :: Sing a)) (SSucc (sB :: Sing b)) = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sA)) sB sInsert (sN :: Sing n) SNil = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) SNil sInsert (sN :: Sing n) (SCons (sH :: Sing h) (sT :: Sing t)) = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) sScrutinee_0123456789876543210 = (applySing ((applySing ((singFun2 @LeqSym0) sLeq)) sN)) sH in (case sScrutinee_0123456789876543210 of STrue -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sN)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) sT) SFalse -> (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sH)) ((applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sN)) sT)) :: Sing (Case_0123456789876543210 n h t (Let0123456789876543210Scrutinee_0123456789876543210Sym3 n h t) :: [Nat]) sInsertionSort SNil = SNil sInsertionSort (SCons (sH :: Sing h) (sT :: Sing t)) = (applySing ((applySing ((singFun2 @InsertSym0) sInsert)) sH)) ((applySing ((singFun1 @InsertionSortSym0) sInsertionSort)) sT) instance SingI (LeqSym0 :: (~>) Nat ((~>) Nat Bool)) where sing = (singFun2 @LeqSym0) sLeq instance SingI d => SingI (LeqSym1 (d :: Nat) :: (~>) Nat Bool) where sing = (singFun1 @(LeqSym1 (d :: Nat))) (sLeq (sing @d)) instance SingI (InsertSym0 :: (~>) Nat ((~>) [Nat] [Nat])) where sing = (singFun2 @InsertSym0) sInsert instance SingI d => SingI (InsertSym1 (d :: Nat) :: (~>) [Nat] [Nat]) where sing = (singFun1 @(InsertSym1 (d :: Nat))) (sInsert (sing @d)) instance SingI (InsertionSortSym0 :: (~>) [Nat] [Nat]) where sing = (singFun1 @InsertionSortSym0) sInsertionSort singletons-2.5.1/tests/compile-and-dump/InsertionSort/InsertionSortImp.hs0000755000000000000000000002065307346545000025051 0ustar0000000000000000{- InsertionSortImp.hs (c) Richard Eisenberg 2012 rae@cs.brynmawr.edu This file contains an implementation of insertion sort over natural numbers, along with a Haskell proof that the sort algorithm is correct. The code below uses a combination of GADTs and class instances to record the progress and result of the proof. Ideally, the GADTs would be defined so that the constructors take no explicit parameters --- the information would all be encoded in the constraints to the constructors. However, due to the nature of the permutation relation, a class instance definition corresponding to the constructor PermIns would require existentially-quantified type variables (the l2 variable in the declaration of PermIns). Type variables in an instance constraint but not mentioned in the instance head are inherently ambiguous. The compiler would never be able to infer the value of the variables. Thus, it is not possible to make a class PermutationC analogous to PermutationProof in the way that AscendingC is analogous to AscendingProof. (Note that it may be possible to fundamentally rewrite the inductive definition of the permutation relation to avoid existentially-quantified variables. We have not attempted that here.) If there were a way to offer an explicit dictionary when satisfying a constraint, this problem could be avoided, as the variable in question could be made unambiguous. -} {-# LANGUAGE IncoherentInstances, ConstraintKinds, TypeFamilies, TemplateHaskell, RankNTypes, ScopedTypeVariables, GADTs, TypeOperators, DataKinds, PolyKinds, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-} module InsertionSort.InsertionSortImp where import Data.Kind (Type) import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH data Dict c where Dict :: c => Dict c -- Natural numbers, defined with singleton counterparts $(singletons [d| data Nat = Zero | Succ Nat |]) -- convenience functions for testing purposes toNat :: Int -> Nat toNat 0 = Zero toNat n | n > 0 = Succ (toNat (n - 1)) toNat _ = error "Converting negative to Nat" fromNat :: Nat -> Int fromNat Zero = 0 fromNat (Succ n) = 1 + (fromNat n) -- A less-than-or-equal relation among naturals class (a :: Nat) :<=: (b :: Nat) instance Zero :<=: a instance (a :<=: b) => (Succ a) :<=: (Succ b) -- A proof term asserting that a list of naturals is in ascending order data AscendingProof :: [Nat] -> Type where AscEmpty :: AscendingProof '[] AscOne :: AscendingProof '[n] AscCons :: (a :<=: b, AscendingC (b ': rest)) => AscendingProof (a ': b ': rest) -- The class constraint (implicit parameter definition) corresponding to -- AscendingProof class AscendingC (lst :: [Nat]) where ascendingProof :: AscendingProof lst -- The instances correspond to the constructors of AscendingProof instance AscendingC '[] where ascendingProof = AscEmpty instance AscendingC '[n] where ascendingProof = AscOne instance (a :<=: b, AscendingC (b ': rest)) => AscendingC (a ': b ': rest) where ascendingProof = AscCons -- A proof term asserting that l2 is the list produced when x is inserted -- (anywhere) into list l1 data InsertionProof (x :: k) (l1 :: [k]) (l2 :: [k]) where InsHere :: InsertionProof x l (x ': l) InsLater :: InsertionC x l1 l2 => InsertionProof x (y ': l1) (y ': l2) -- The class constraint corresponding to InsertionProof class InsertionC (x :: k) (l1 :: [k]) (l2 :: [k]) where insertionProof :: InsertionProof x l1 l2 instance InsertionC x l (x ': l) where insertionProof = InsHere instance InsertionC x l1 l2 => InsertionC x (y ': l1) (y ': l2) where insertionProof = InsLater -- A proof term asserting that l1 and l2 are permutations of each other data PermutationProof (l1 :: [k]) (l2 :: [k]) where PermId :: PermutationProof l l PermIns :: InsertionC x l2 l2' => PermutationProof l1 l2 -> PermutationProof (x ': l1) l2' -- Here is the definition of insertion sort about which we will be reasoning: $(singletons [d| leq :: Nat -> Nat -> Bool leq Zero _ = True leq (Succ _) Zero = False leq (Succ a) (Succ b) = leq a b insert :: Nat -> [Nat] -> [Nat] insert n [] = [n] insert n (h:t) = if leq n h then (n:h:t) else h:(insert n t) insertionSort :: [Nat] -> [Nat] insertionSort [] = [] insertionSort (h:t) = insert h (insertionSort t) |]) -- A lemma that states if sLeq a b is STrue, then (a :<=: b) -- This is necessary to convert from the boolean definition of <= to the -- corresponding constraint sLeq_true__le :: (Leq a b ~ True) => SNat a -> SNat b -> Dict (a :<=: b) sLeq_true__le a b = case (a, b) of (SZero, SZero) -> Dict (SZero, SSucc _) -> Dict -- (SSucc _, SZero) -> undefined <== IMPOSSIBLE (SSucc a', SSucc b') -> case sLeq_true__le a' b' of Dict -> Dict -- A lemma that states if sLeq a b is SFalse, then (b :<=: a) sLeq_false__nle :: (Leq a b ~ False) => SNat a -> SNat b -> Dict (b :<=: a) sLeq_false__nle a b = case (a, b) of -- (SZero, SZero) -> undefined <== IMPOSSIBLE -- (SZero, SSucc _) -> undefined <== IMPOSSIBLE (SSucc _, SZero) -> Dict (SSucc a', SSucc b') -> case sLeq_false__nle a' b' of Dict -> Dict -- A lemma that states that inserting into an ascending list produces an -- ascending list insert_ascending :: forall n lst. AscendingC lst => SNat n -> SList lst -> Dict (AscendingC (Insert n lst)) insert_ascending n lst = case ascendingProof :: AscendingProof lst of AscEmpty -> Dict -- If lst is empty, then we're done AscOne -> case lst of -- If lst has one element... -- SNil -> undefined <== IMPOSSIBLE SCons h _ -> case sLeq n h of -- then check if n is <= h STrue -> case sLeq_true__le n h of Dict -> Dict -- if so, we're done SFalse -> case sLeq_false__nle n h of Dict -> Dict -- if not, we're done AscCons -> case lst of -- Otherwise, if lst is more than one element... -- SNil -> undefined <== IMPOSSIBLE SCons h t -> case sLeq n h of -- then check if n is <= h STrue -> case sLeq_true__le n h of Dict -> Dict -- if so, we're done SFalse -> case sLeq_false__nle n h of -- if not, things are harder... Dict -> case t of -- destruct t: lst is (h : h2 : t2) -- SNil -> undefined <== IMPOSSIBLE SCons h2 _ -> case sLeq n h2 of -- is n <= h2? STrue -> -- if so, we're done case sLeq_true__le n h2 of Dict -> Dict SFalse -> -- otherwise, show that (Insert n t) is sorted case insert_ascending n t of Dict -> Dict -- and we're done -- A lemma that states that inserting n into lst produces a new list with n -- inserted into lst. insert_insertion :: SNat n -> SList lst -> Dict (InsertionC n lst (Insert n lst)) insert_insertion n lst = case lst of SNil -> Dict -- if lst is empty, we're done SCons h t -> case sLeq n h of -- otherwise, is n <= h? STrue -> Dict -- if so, we're done SFalse -> case insert_insertion n t of Dict -> Dict -- otherwise, recur -- A lemma that states that the result of an insertion sort is in ascending order insertionSort_ascending :: SList lst -> Dict (AscendingC (InsertionSort lst)) insertionSort_ascending lst = case lst of SNil -> Dict -- if the list is empty, we're done -- otherwise, we recur to find that insertionSort on t produces an ascending list, -- and then we use the fact that inserting into an ascending list produces an -- ascending list SCons h t -> case insertionSort_ascending t of Dict -> case insert_ascending h (sInsertionSort t) of Dict -> Dict -- A lemma that states that the result of an insertion sort is a permutation -- of its input insertionSort_permutes :: SList lst -> PermutationProof lst (InsertionSort lst) insertionSort_permutes lst = case lst of SNil -> PermId -- if the list is empty, we're done -- otherwise, we wish to use PermIns. We must know that t is a permutation of -- the insertion sort of t and that inserting h into the insertion sort of t -- works correctly: SCons h t -> case insert_insertion h (sInsertionSort t) of Dict -> PermIns (insertionSort_permutes t) -- A theorem that states that the insertion sort of a list is both ascending -- and a permutation of the original insertionSort_correct :: SList lst -> (Dict (AscendingC (InsertionSort lst)), PermutationProof lst (InsertionSort lst)) insertionSort_correct lst = (insertionSort_ascending lst, insertionSort_permutes lst) singletons-2.5.1/tests/compile-and-dump/Promote/0000755000000000000000000000000007346545000020017 5ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Promote/Constructors.ghc86.template0000755000000000000000000001432607346545000025213 0ustar0000000000000000Promote/Constructors.hs:(0,0)-(0,0): Splicing declarations promote [d| data Foo = Foo | Foo :+ Foo data Bar = Bar Bar Bar Bar Bar Foo |] ======> data Foo = Foo | Foo :+ Foo data Bar = Bar Bar Bar Bar Bar Foo type FooSym0 = Foo type (:+@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = (:+) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:+@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) data (:+@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo where (::+@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:+@#@$$) t0123456789876543210) arg) ((:+@#@$$$) t0123456789876543210 arg) => (:+@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:+@#@$$) t0123456789876543210) t0123456789876543210 = (:+) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (:+@#@$) where suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) data (:+@#@$) :: (~>) Foo ((~>) Foo Foo) where (::+@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => (:+@#@$) t0123456789876543210 type instance Apply (:+@#@$) t0123456789876543210 = (:+@#@$$) t0123456789876543210 type BarSym5 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Foo) = Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym4KindInference) ()) data BarSym4 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Foo Bar where BarSym4KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym5 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym3KindInference) ()) data BarSym3 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Foo Bar) where BarSym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym2KindInference) ()) data BarSym2 (t0123456789876543210 :: Bar) (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Foo Bar)) where BarSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BarSym2 t0123456789876543210 t0123456789876543210) arg) (BarSym3 t0123456789876543210 t0123456789876543210 arg) => BarSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BarSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) data BarSym1 (t0123456789876543210 :: Bar) :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar))) where BarSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => BarSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = BarSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bar ((~>) Bar ((~>) Bar ((~>) Bar ((~>) Foo Bar)))) where BarSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 t0123456789876543210 type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Promote/Constructors.hs0000755000000000000000000000046307346545000023071 0ustar0000000000000000module Promote.Constructors where import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH -- Tests defunctionalization symbol generation for : -- * infix constructors -- * constructors with arity > 2 $(promote [d| data Foo = Foo | Foo :+ Foo data Bar = Bar Bar Bar Bar Bar Foo |]) singletons-2.5.1/tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template0000755000000000000000000000740607346545000025550 0ustar0000000000000000Promote/GenDefunSymbols.hs:0:0:: Splicing declarations genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)] ======> type LiftMaybeSym2 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (x0123456789876543210 :: Maybe a0123456789876543210) = LiftMaybe f0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings (LiftMaybeSym1 f0123456789876543210) where suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) data LiftMaybeSym1 (f0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) where LiftMaybeSym1KindInference :: forall f0123456789876543210 x0123456789876543210 arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 f0123456789876543210) arg) (LiftMaybeSym2 f0123456789876543210 arg) => LiftMaybeSym1 f0123456789876543210 x0123456789876543210 type instance Apply (LiftMaybeSym1 f0123456789876543210) x0123456789876543210 = LiftMaybe f0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) data LiftMaybeSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)) where LiftMaybeSym0KindInference :: forall f0123456789876543210 arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => LiftMaybeSym0 f0123456789876543210 type instance Apply LiftMaybeSym0 f0123456789876543210 = LiftMaybeSym1 f0123456789876543210 type ZeroSym0 = 'Zero type SuccSym1 (t0123456789876543210 :: NatT) = 'Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) NatT NatT where SuccSym0KindInference :: forall t0123456789876543210 arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = 'Succ t0123456789876543210 type (:+@#@$$$) (a0123456789876543210 :: Nat) (b0123456789876543210 :: Nat) = (:+) a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings ((:+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+@#@$$###)) ()) data (:+@#@$$) (a0123456789876543210 :: Nat) b0123456789876543210 where (::+@#@$$###) :: forall a0123456789876543210 b0123456789876543210 arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) a0123456789876543210) arg) ((:+@#@$$$) a0123456789876543210 arg) => (:+@#@$$) a0123456789876543210 b0123456789876543210 type instance Apply ((:+@#@$$) a0123456789876543210) b0123456789876543210 = (:+) a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings (:+@#@$) where suppressUnusedWarnings = snd (((,) (::+@#@$###)) ()) data (:+@#@$) a0123456789876543210 where (::+@#@$###) :: forall a0123456789876543210 arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) => (:+@#@$) a0123456789876543210 type instance Apply (:+@#@$) a0123456789876543210 = (:+@#@$$) a0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Promote/GenDefunSymbols.hs0000755000000000000000000000074207346545000023425 0ustar0000000000000000module Promote.GenDefunSymbols where import Data.Singletons (Apply, type (~>)) import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH (genDefunSymbols) import GHC.TypeLits hiding (type (*)) import Data.Kind (Type) type family LiftMaybe (f :: a ~> b) (x :: Maybe a) :: Maybe b where LiftMaybe f Nothing = Nothing LiftMaybe f (Just a) = Just (Apply f a) data NatT = Zero | Succ NatT type a :+ b = a + b $(genDefunSymbols [ ''LiftMaybe, ''NatT, ''(:+) ]) singletons-2.5.1/tests/compile-and-dump/Promote/Newtypes.ghc86.template0000755000000000000000000000434107346545000024315 0ustar0000000000000000Promote/Newtypes.hs:(0,0)-(0,0): Splicing declarations promote [d| newtype Foo = Foo Nat deriving Eq newtype Bar = Bar {unBar :: Nat} |] ======> newtype Foo = Foo Nat deriving Eq newtype Bar = Bar {unBar :: Nat} type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where Equals_0123456789876543210 (Foo a) (Foo b) = (==) a b Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 instance PEq Foo where type (==) a b = Equals_0123456789876543210 a b type UnBarSym1 (a0123456789876543210 :: Bar) = UnBar a0123456789876543210 instance SuppressUnusedWarnings UnBarSym0 where suppressUnusedWarnings = snd (((,) UnBarSym0KindInference) ()) data UnBarSym0 :: (~>) Bar Nat where UnBarSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) => UnBarSym0 a0123456789876543210 type instance Apply UnBarSym0 a0123456789876543210 = UnBar a0123456789876543210 type family UnBar (a :: Bar) :: Nat where UnBar (Bar field) = field type FooSym1 (t0123456789876543210 :: Nat) = Foo t0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Nat Foo where FooSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 t0123456789876543210 type instance Apply FooSym0 t0123456789876543210 = Foo t0123456789876543210 type BarSym1 (t0123456789876543210 :: Nat) = Bar t0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Nat Bar where BarSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 t0123456789876543210 type instance Apply BarSym0 t0123456789876543210 = Bar t0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Promote/Newtypes.hs0000755000000000000000000000033407346545000022174 0ustar0000000000000000module Promote.Newtypes where import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Singletons.Nat $(promote [d| newtype Foo = Foo Nat deriving (Eq) newtype Bar = Bar { unBar :: Nat } |]) singletons-2.5.1/tests/compile-and-dump/Promote/Pragmas.ghc86.template0000755000000000000000000000043307346545000024067 0ustar0000000000000000Promote/Pragmas.hs:(0,0)-(0,0): Splicing declarations promote [d| {-# INLINE foo #-} foo :: Bool foo = True |] ======> {-# INLINE foo #-} foo :: Bool foo = True type FooSym0 = Foo type family Foo :: Bool where Foo = TrueSym0 singletons-2.5.1/tests/compile-and-dump/Promote/Pragmas.hs0000755000000000000000000000023307346545000021746 0ustar0000000000000000module Promote.Pragmas where import Data.Singletons.TH import Data.Singletons.Prelude $(promote [d| {-# INLINE foo #-} foo :: Bool foo = True |]) singletons-2.5.1/tests/compile-and-dump/Promote/Prelude.ghc86.template0000755000000000000000000000157707346545000024107 0ustar0000000000000000Promote/Prelude.hs:(0,0)-(0,0): Splicing declarations promoteOnly [d| odd :: Nat -> Bool odd 0 = False odd n = not . odd $ n - 1 |] ======> type OddSym1 (a0123456789876543210 :: Nat) = Odd a0123456789876543210 instance SuppressUnusedWarnings OddSym0 where suppressUnusedWarnings = snd (((,) OddSym0KindInference) ()) data OddSym0 :: (~>) Nat Bool where OddSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply OddSym0 arg) (OddSym1 arg) => OddSym0 a0123456789876543210 type instance Apply OddSym0 a0123456789876543210 = Odd a0123456789876543210 type family Odd (a :: Nat) :: Bool where Odd 0 = FalseSym0 Odd n = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) OddSym0)) (Apply (Apply (-@#@$) n) (FromInteger 1)) singletons-2.5.1/tests/compile-and-dump/Promote/Prelude.hs0000755000000000000000000000542607346545000021765 0ustar0000000000000000module Promote.Prelude where import Data.Singletons.TH import Data.Singletons.Prelude import Data.Singletons.Prelude.List import GHC.TypeLits lengthTest1a :: Proxy (Length '[True, True, True, True]) lengthTest1a = Proxy lengthTest1b :: Proxy 4 lengthTest1b = lengthTest1a lengthTest2a :: Proxy (Length '[]) lengthTest2a = Proxy lengthTest2b :: Proxy 0 lengthTest2b = lengthTest2a sumTest1a :: Proxy (Sum '[1, 2, 3, 4]) sumTest1a = Proxy sumTest1b :: Proxy 10 sumTest1b = sumTest1a sumTest2a :: Proxy (Sum '[]) sumTest2a = Proxy sumTest2b :: Proxy 0 sumTest2b = sumTest2a productTest1a :: Proxy (Product '[1, 2, 3, 4]) productTest1a = Proxy productTest1b :: Proxy 24 productTest1b = productTest1a productTest2a :: Proxy (Product '[]) productTest2a = Proxy productTest2b :: Proxy 1 productTest2b = productTest2a takeTest1a :: Proxy (Take 2 '[1, 2, 3, 4]) takeTest1a = Proxy takeTest1b :: Proxy '[1, 2] takeTest1b = takeTest1a takeTest2a :: Proxy (Take 2 '[]) takeTest2a = Proxy takeTest2b :: Proxy '[] takeTest2b = takeTest2a dropTest1a :: Proxy (Drop 2 '[1, 2, 3, 4]) dropTest1a = Proxy dropTest1b :: Proxy '[3, 4] dropTest1b = dropTest1a dropTest2a :: Proxy (Drop 2 '[]) dropTest2a = Proxy dropTest2b :: Proxy '[] dropTest2b = dropTest2a splitAtTest1a :: Proxy (SplitAt 2 '[1, 2, 3, 4]) splitAtTest1a = Proxy splitAtTest1b :: Proxy ( '( '[1,2], '[3, 4] ) ) splitAtTest1b = splitAtTest1a splitAtTest2a :: Proxy (SplitAt 2 '[]) splitAtTest2a = splitAtTest2b splitAtTest2b :: Proxy ( '( '[], '[] ) ) splitAtTest2b = Proxy indexingTest1a :: Proxy ('[4, 3, 2, 1] !! 1) indexingTest1a = Proxy indexingTest1b :: Proxy 3 indexingTest1b = indexingTest1a indexingTest2a :: Proxy ('[] !! 0) indexingTest2a = Proxy indexingTest2b :: Proxy (Error "Data.Singletons.List.!!: index too large") indexingTest2b = indexingTest2a replicateTest1a :: Proxy (Replicate 2 True) replicateTest1a = Proxy replicateTest1b :: Proxy '[True, True] replicateTest1b = replicateTest1a replicateTest2a :: Proxy (Replicate 0 True) replicateTest2a = replicateTest2b replicateTest2b :: Proxy '[] replicateTest2b = Proxy $(promoteOnly [d| odd :: Nat -> Bool odd 0 = False odd n = not . odd $ n - 1 |]) findIndexTest1a :: Proxy (FindIndex OddSym0 '[2,4,6,7]) findIndexTest1a = Proxy findIndexTest1b :: Proxy (Just 3) findIndexTest1b = findIndexTest1a findIndicesTest1a :: Proxy (FindIndices OddSym0 '[1,3,5,2,4,6,7]) findIndicesTest1a = Proxy findIndicesTest1b :: Proxy '[0,1,2,6] findIndicesTest1b = findIndicesTest1a transposeTest1a :: Proxy (Transpose '[[1,2,3]]) transposeTest1a = Proxy transposeTest1b :: Proxy ('[ '[1], '[2], '[3]]) transposeTest1b = transposeTest1a transposeTest2a :: Proxy (Transpose '[ '[1], '[2], '[3]]) transposeTest2a = Proxy transposeTest2b :: Proxy ('[ '[1,2,3]]) transposeTest2b = transposeTest2a singletons-2.5.1/tests/compile-and-dump/Promote/T180.ghc86.template0000755000000000000000000000466107346545000023140 0ustar0000000000000000Promote/T180.hs:(0,0)-(0,0): Splicing declarations promote [d| z (X1 x) = x z (X2 x) = x data X = X1 {y :: Symbol} | X2 {y :: Symbol} |] ======> data X = X1 {y :: Symbol} | X2 {y :: Symbol} z (X1 x) = x z (X2 x) = x type ZSym1 a0123456789876543210 = Z a0123456789876543210 instance SuppressUnusedWarnings ZSym0 where suppressUnusedWarnings = snd (((,) ZSym0KindInference) ()) data ZSym0 a0123456789876543210 where ZSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) => ZSym0 a0123456789876543210 type instance Apply ZSym0 a0123456789876543210 = Z a0123456789876543210 type family Z a where Z (X1 x) = x Z (X2 x) = x type YSym1 (a0123456789876543210 :: X) = Y a0123456789876543210 instance SuppressUnusedWarnings YSym0 where suppressUnusedWarnings = snd (((,) YSym0KindInference) ()) data YSym0 :: (~>) X Symbol where YSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply YSym0 arg) (YSym1 arg) => YSym0 a0123456789876543210 type instance Apply YSym0 a0123456789876543210 = Y a0123456789876543210 type family Y (a :: X) :: Symbol where Y (X1 field) = field Y (X2 field) = field type X1Sym1 (t0123456789876543210 :: Symbol) = X1 t0123456789876543210 instance SuppressUnusedWarnings X1Sym0 where suppressUnusedWarnings = snd (((,) X1Sym0KindInference) ()) data X1Sym0 :: (~>) Symbol X where X1Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) => X1Sym0 t0123456789876543210 type instance Apply X1Sym0 t0123456789876543210 = X1 t0123456789876543210 type X2Sym1 (t0123456789876543210 :: Symbol) = X2 t0123456789876543210 instance SuppressUnusedWarnings X2Sym0 where suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ()) data X2Sym0 :: (~>) Symbol X where X2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => X2Sym0 t0123456789876543210 type instance Apply X2Sym0 t0123456789876543210 = X2 t0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Promote/T180.hs0000755000000000000000000000025307346545000021012 0ustar0000000000000000module T180 where import Data.Singletons.TH import Data.Singletons.Prelude promote [d| data X = X1 {y :: Symbol} | X2 {y :: Symbol} z (X1 x) = x z (X2 x) = x |] singletons-2.5.1/tests/compile-and-dump/Promote/T361.ghc86.template0000755000000000000000000000157607346545000023143 0ustar0000000000000000Promote/T361.hs:0:0:: Splicing declarations genDefunSymbols [''Proxy] ======> type ProxySym0 = 'Proxy Promote/T361.hs:(0,0)-(0,0): Splicing declarations promote [d| f :: Proxy 1 -> Proxy 2 f Proxy = Proxy |] ======> f :: Proxy 1 -> Proxy 2 f Proxy = Proxy type FSym1 (a0123456789876543210 :: Proxy 1) = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 :: (~>) (Proxy 1) (Proxy 2) where FSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 type family F (a :: Proxy 1) :: Proxy 2 where F 'Proxy = ProxySym0 singletons-2.5.1/tests/compile-and-dump/Promote/T361.hs0000755000000000000000000000023607346545000021014 0ustar0000000000000000module T361 where import Data.Proxy import Data.Singletons.TH $(genDefunSymbols [''Proxy]) $(promote [d| f :: Proxy 1 -> Proxy 2 f Proxy = Proxy |]) singletons-2.5.1/tests/compile-and-dump/Singletons/0000755000000000000000000000000007346545000020517 5ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/AsPattern.ghc86.template0000755000000000000000000006577207346545000025117 0ustar0000000000000000Singletons/AsPattern.hs:(0,0)-(0,0): Splicing declarations singletons [d| maybePlus :: Maybe Nat -> Maybe Nat maybePlus (Just n) = Just (plus (Succ Zero) n) maybePlus p@Nothing = p bar :: Maybe Nat -> Maybe Nat bar x@(Just _) = x bar Nothing = Nothing baz_ :: Maybe Baz -> Maybe Baz baz_ p@Nothing = p baz_ p@(Just (Baz _ _ _)) = p tup :: (Nat, Nat) -> (Nat, Nat) tup p@(_, _) = p foo :: [Nat] -> [Nat] foo p@[] = p foo p@[_] = p foo p@(_ : _ : _) = p data Baz = Baz Nat Nat Nat |] ======> maybePlus :: Maybe Nat -> Maybe Nat maybePlus (Just n) = Just ((plus (Succ Zero)) n) maybePlus p@Nothing = p bar :: Maybe Nat -> Maybe Nat bar x@(Just _) = x bar Nothing = Nothing data Baz = Baz Nat Nat Nat baz_ :: Maybe Baz -> Maybe Baz baz_ p@Nothing = p baz_ p@(Just (Baz _ _ _)) = p tup :: (Nat, Nat) -> (Nat, Nat) tup p@(_, _) = p foo :: [Nat] -> [Nat] foo p@[] = p foo p@[_] = p foo p@(_ : (_ : _)) = p type BazSym3 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) = Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BazSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BazSym2KindInference) ()) data BazSym2 (t0123456789876543210 :: Nat) (t0123456789876543210 :: Nat) :: (~>) Nat Baz where BazSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BazSym2 t0123456789876543210 t0123456789876543210) arg) (BazSym3 t0123456789876543210 t0123456789876543210 arg) => BazSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BazSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = Baz t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BazSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) data BazSym1 (t0123456789876543210 :: Nat) :: (~>) Nat ((~>) Nat Baz) where BazSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BazSym1 t0123456789876543210) arg) (BazSym2 t0123456789876543210 arg) => BazSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BazSym1 t0123456789876543210) t0123456789876543210 = BazSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings BazSym0 where suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) data BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz)) where BazSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => BazSym0 t0123456789876543210 type instance Apply BazSym0 t0123456789876543210 = BazSym1 t0123456789876543210 type Let0123456789876543210PSym0 = Let0123456789876543210P type family Let0123456789876543210P where Let0123456789876543210P = '[] type Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[] type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym2KindInference) ()) data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) (Apply (Apply (:@#@$) wild_0123456789876543210) wild_0123456789876543210) type Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 = Apply (Apply Tuple2Sym0 wild_0123456789876543210) wild_0123456789876543210 type Let0123456789876543210PSym0 = Let0123456789876543210P type family Let0123456789876543210P where Let0123456789876543210P = NothingSym0 type Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym2KindInference) ()) data Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym2KindInference :: forall wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym3 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210P wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym1KindInference) ()) data Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym1KindInference :: forall wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) arg) (Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 arg) => Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210) wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym2 wild_01234567898765432100123456789876543210 wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210PSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210PSym0KindInference) ()) data Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210PSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) => Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210PSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210PSym1 wild_01234567898765432100123456789876543210 type family Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 where Let0123456789876543210P wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 = Apply JustSym0 (Apply (Apply (Apply BazSym0 wild_0123456789876543210) wild_0123456789876543210) wild_0123456789876543210) type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 type family Let0123456789876543210X wild_0123456789876543210 where Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210 type Let0123456789876543210PSym0 = Let0123456789876543210P type family Let0123456789876543210P where Let0123456789876543210P = NothingSym0 type FooSym1 (a0123456789876543210 :: [Nat]) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) [Nat] [Nat] where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type TupSym1 (a0123456789876543210 :: (Nat, Nat)) = Tup a0123456789876543210 instance SuppressUnusedWarnings TupSym0 where suppressUnusedWarnings = snd (((,) TupSym0KindInference) ()) data TupSym0 :: (~>) (Nat, Nat) (Nat, Nat) where TupSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) => TupSym0 a0123456789876543210 type instance Apply TupSym0 a0123456789876543210 = Tup a0123456789876543210 type Baz_Sym1 (a0123456789876543210 :: Maybe Baz) = Baz_ a0123456789876543210 instance SuppressUnusedWarnings Baz_Sym0 where suppressUnusedWarnings = snd (((,) Baz_Sym0KindInference) ()) data Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz) where Baz_Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) => Baz_Sym0 a0123456789876543210 type instance Apply Baz_Sym0 a0123456789876543210 = Baz_ a0123456789876543210 type BarSym1 (a0123456789876543210 :: Maybe Nat) = Bar a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) (Maybe Nat) (Maybe Nat) where BarSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 type MaybePlusSym1 (a0123456789876543210 :: Maybe Nat) = MaybePlus a0123456789876543210 instance SuppressUnusedWarnings MaybePlusSym0 where suppressUnusedWarnings = snd (((,) MaybePlusSym0KindInference) ()) data MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat) where MaybePlusSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) => MaybePlusSym0 a0123456789876543210 type instance Apply MaybePlusSym0 a0123456789876543210 = MaybePlus a0123456789876543210 type family Foo (a :: [Nat]) :: [Nat] where Foo '[] = Let0123456789876543210PSym0 Foo '[wild_0123456789876543210] = Let0123456789876543210PSym1 wild_0123456789876543210 Foo ( '(:) wild_0123456789876543210 ( '(:) wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 type family Tup (a :: (Nat, Nat)) :: (Nat, Nat) where Tup '(wild_0123456789876543210, wild_0123456789876543210) = Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210 type family Baz_ (a :: Maybe Baz) :: Maybe Baz where Baz_ 'Nothing = Let0123456789876543210PSym0 Baz_ ( 'Just (Baz wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210)) = Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210 type family Bar (a :: Maybe Nat) :: Maybe Nat where Bar ( 'Just wild_0123456789876543210) = Let0123456789876543210XSym1 wild_0123456789876543210 Bar 'Nothing = NothingSym0 type family MaybePlus (a :: Maybe Nat) :: Maybe Nat where MaybePlus ( 'Just n) = Apply JustSym0 (Apply (Apply PlusSym0 (Apply SuccSym0 ZeroSym0)) n) MaybePlus 'Nothing = Let0123456789876543210PSym0 sFoo :: forall (t :: [Nat]). Sing t -> Sing (Apply FooSym0 t :: [Nat]) sTup :: forall (t :: (Nat, Nat)). Sing t -> Sing (Apply TupSym0 t :: (Nat, Nat)) sBaz_ :: forall (t :: Maybe Baz). Sing t -> Sing (Apply Baz_Sym0 t :: Maybe Baz) sBar :: forall (t :: Maybe Nat). Sing t -> Sing (Apply BarSym0 t :: Maybe Nat) sMaybePlus :: forall (t :: Maybe Nat). Sing t -> Sing (Apply MaybePlusSym0 t :: Maybe Nat) sFoo SNil = let sP :: Sing Let0123456789876543210PSym0 sP = SNil in sP sFoo (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) SNil) = let sP :: Sing (Let0123456789876543210PSym1 wild_0123456789876543210) sP = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sWild_0123456789876543210)) SNil in sP sFoo (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) (SCons (sWild_0123456789876543210 :: Sing wild_0123456789876543210) (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) = let sP :: Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) sP = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sWild_0123456789876543210)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) sWild_0123456789876543210)) sWild_0123456789876543210) in sP sTup (STuple2 (sWild_0123456789876543210 :: Sing wild_0123456789876543210) (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) = let sP :: Sing (Let0123456789876543210PSym2 wild_0123456789876543210 wild_0123456789876543210) sP = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sWild_0123456789876543210)) sWild_0123456789876543210 in sP sBaz_ SNothing = let sP :: Sing Let0123456789876543210PSym0 sP = SNothing in sP sBaz_ (SJust (SBaz (sWild_0123456789876543210 :: Sing wild_0123456789876543210) (sWild_0123456789876543210 :: Sing wild_0123456789876543210) (sWild_0123456789876543210 :: Sing wild_0123456789876543210))) = let sP :: Sing (Let0123456789876543210PSym3 wild_0123456789876543210 wild_0123456789876543210 wild_0123456789876543210) sP = (applySing ((singFun1 @JustSym0) SJust)) ((applySing ((applySing ((applySing ((singFun3 @BazSym0) SBaz)) sWild_0123456789876543210)) sWild_0123456789876543210)) sWild_0123456789876543210) in sP sBar (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) = let sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) sX = (applySing ((singFun1 @JustSym0) SJust)) sWild_0123456789876543210 in sX sBar SNothing = SNothing sMaybePlus (SJust (sN :: Sing n)) = (applySing ((singFun1 @JustSym0) SJust)) ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) sN) sMaybePlus SNothing = let sP :: Sing Let0123456789876543210PSym0 sP = SNothing in sP instance SingI (FooSym0 :: (~>) [Nat] [Nat]) where sing = (singFun1 @FooSym0) sFoo instance SingI (TupSym0 :: (~>) (Nat, Nat) (Nat, Nat)) where sing = (singFun1 @TupSym0) sTup instance SingI (Baz_Sym0 :: (~>) (Maybe Baz) (Maybe Baz)) where sing = (singFun1 @Baz_Sym0) sBaz_ instance SingI (BarSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where sing = (singFun1 @BarSym0) sBar instance SingI (MaybePlusSym0 :: (~>) (Maybe Nat) (Maybe Nat)) where sing = (singFun1 @MaybePlusSym0) sMaybePlus data instance Sing :: Baz -> GHC.Types.Type where SBaz :: forall (n :: Nat) (n :: Nat) (n :: Nat). (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> (Sing (n :: Nat)) -> Sing (Baz n n n) type SBaz = (Sing :: Baz -> GHC.Types.Type) instance SingKind Baz where type Demote Baz = Baz fromSing (SBaz b b b) = ((Baz (fromSing b)) (fromSing b)) (fromSing b) toSing (Baz (b :: Demote Nat) (b :: Demote Nat) (b :: Demote Nat)) = case (((,,) (toSing b :: SomeSing Nat)) (toSing b :: SomeSing Nat)) (toSing b :: SomeSing Nat) of { (,,) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing (((SBaz c) c) c) } instance (SingI n, SingI n, SingI n) => SingI (Baz (n :: Nat) (n :: Nat) (n :: Nat)) where sing = ((SBaz sing) sing) sing instance SingI (BazSym0 :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where sing = (singFun3 @BazSym0) SBaz instance SingI (TyCon3 Baz :: (~>) Nat ((~>) Nat ((~>) Nat Baz))) where sing = (singFun3 @(TyCon3 Baz)) SBaz instance SingI d => SingI (BazSym1 (d :: Nat) :: (~>) Nat ((~>) Nat Baz)) where sing = (singFun2 @(BazSym1 (d :: Nat))) (SBaz (sing @d)) instance SingI d => SingI (TyCon2 (Baz (d :: Nat)) :: (~>) Nat ((~>) Nat Baz)) where sing = (singFun2 @(TyCon2 (Baz (d :: Nat)))) (SBaz (sing @d)) instance (SingI d, SingI d) => SingI (BazSym2 (d :: Nat) (d :: Nat) :: (~>) Nat Baz) where sing = (singFun1 @(BazSym2 (d :: Nat) (d :: Nat))) ((SBaz (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon1 (Baz (d :: Nat) (d :: Nat)) :: (~>) Nat Baz) where sing = (singFun1 @(TyCon1 (Baz (d :: Nat) (d :: Nat)))) ((SBaz (sing @d)) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/AsPattern.hs0000755000000000000000000000130207346545000022753 0ustar0000000000000000module Singletons.AsPattern where import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.Maybe import Data.Singletons.Prelude.List import Singletons.Nat import Data.Singletons.SuppressUnusedWarnings $(singletons [d| maybePlus :: Maybe Nat -> Maybe Nat maybePlus (Just n) = Just (plus (Succ Zero) n) maybePlus p@Nothing = p bar :: Maybe Nat -> Maybe Nat bar x@(Just _) = x bar Nothing = Nothing data Baz = Baz Nat Nat Nat baz_ :: Maybe Baz -> Maybe Baz baz_ p@Nothing = p baz_ p@(Just (Baz _ _ _)) = p tup :: (Nat, Nat) -> (Nat, Nat) tup p@(_, _) = p foo :: [Nat] -> [Nat] foo p@[] = p foo p@[_] = p foo p@(_:_:_) = p |]) singletons-2.5.1/tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.template0000755000000000000000000000022007346545000026646 0ustar0000000000000000 Singletons/BadBoundedDeriving.hs:0:0: error: Can't derive Bounded instance for Foo_0 a_1. | 5 | $(singletons [d| | ^^^^^^^^^^^^^^... singletons-2.5.1/tests/compile-and-dump/Singletons/BadBoundedDeriving.hs0000755000000000000000000000021407346545000024532 0ustar0000000000000000module Singletons.BadBoundedDeriving where import Data.Singletons.TH $(singletons [d| data Foo a = Foo | Bar a deriving (Bounded) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.template0000755000000000000000000000021207346545000026173 0ustar0000000000000000 Singletons/BadEnumDeriving.hs:0:0: error: Can't derive Enum instance for Foo_0 a_1. | 5 | $(singletons [d| | ^^^^^^^^^^^^^^... singletons-2.5.1/tests/compile-and-dump/Singletons/BadEnumDeriving.hs0000755000000000000000000000021507346545000024057 0ustar0000000000000000module Singletons.BadEnumDeriving where import Data.Singletons.TH $(singletons [d| data Foo a = Foo a deriving Enum |]) singletons-2.5.1/tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template0000755000000000000000000002410407346545000026246 0ustar0000000000000000Singletons/BoundedDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Foo1 = Foo1 deriving Bounded data Foo2 = A | B | C | D | E deriving Bounded data Foo3 a = Foo3 a deriving Bounded data Foo4 (a :: Type) (b :: Type) = Foo41 | Foo42 deriving Bounded data Pair = Pair Bool Bool deriving Bounded |] ======> data Foo1 = Foo1 deriving Bounded data Foo2 = A | B | C | D | E deriving Bounded data Foo3 a = Foo3 a deriving Bounded data Foo4 (a :: Type) (b :: Type) = Foo41 | Foo42 deriving Bounded data Pair = Pair Bool Bool deriving Bounded type Foo1Sym0 = Foo1 type ASym0 = A type BSym0 = B type CSym0 = C type DSym0 = D type ESym0 = E type Foo3Sym1 (t0123456789876543210 :: a0123456789876543210) = Foo3 t0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 (Foo3 a0123456789876543210) where Foo3Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 t0123456789876543210 type instance Apply Foo3Sym0 t0123456789876543210 = Foo3 t0123456789876543210 type Foo41Sym0 = Foo41 type Foo42Sym0 = Foo42 type PairSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Pair where PairSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings PairSym0 where suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) data PairSym0 :: (~>) Bool ((~>) Bool Pair) where PairSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => PairSym0 t0123456789876543210 type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 type family MinBound_0123456789876543210 :: Foo1 where MinBound_0123456789876543210 = Foo1Sym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: Foo1 where MaxBound_0123456789876543210 = Foo1Sym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded Foo1 where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family MinBound_0123456789876543210 :: Foo2 where MinBound_0123456789876543210 = ASym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: Foo2 where MaxBound_0123456789876543210 = ESym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded Foo2 where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family MinBound_0123456789876543210 :: Foo3 a where MinBound_0123456789876543210 = Apply Foo3Sym0 MinBoundSym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: Foo3 a where MaxBound_0123456789876543210 = Apply Foo3Sym0 MaxBoundSym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded (Foo3 a) where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family MinBound_0123456789876543210 :: Foo4 a b where MinBound_0123456789876543210 = Foo41Sym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: Foo4 a b where MaxBound_0123456789876543210 = Foo42Sym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded (Foo4 a b) where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family MinBound_0123456789876543210 :: Pair where MinBound_0123456789876543210 = Apply (Apply PairSym0 MinBoundSym0) MinBoundSym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: Pair where MaxBound_0123456789876543210 = Apply (Apply PairSym0 MaxBoundSym0) MaxBoundSym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded Pair where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 data instance Sing :: Foo1 -> Type where SFoo1 :: Sing Foo1 type SFoo1 = (Sing :: Foo1 -> Type) instance SingKind Foo1 where type Demote Foo1 = Foo1 fromSing SFoo1 = Foo1 toSing Foo1 = SomeSing SFoo1 data instance Sing :: Foo2 -> Type where SA :: Sing A SB :: Sing B SC :: Sing C SD :: Sing D SE :: Sing E type SFoo2 = (Sing :: Foo2 -> Type) instance SingKind Foo2 where type Demote Foo2 = Foo2 fromSing SA = A fromSing SB = B fromSing SC = C fromSing SD = D fromSing SE = E toSing A = SomeSing SA toSing B = SomeSing SB toSing C = SomeSing SC toSing D = SomeSing SD toSing E = SomeSing SE data instance Sing :: Foo3 a -> Type where SFoo3 :: forall a (n :: a). (Sing (n :: a)) -> Sing (Foo3 n) type SFoo3 = (Sing :: Foo3 a -> Type) instance SingKind a => SingKind (Foo3 a) where type Demote (Foo3 a) = Foo3 (Demote a) fromSing (SFoo3 b) = Foo3 (fromSing b) toSing (Foo3 (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SFoo3 c) } data instance Sing :: Foo4 a b -> Type where SFoo41 :: Sing Foo41 SFoo42 :: Sing Foo42 type SFoo4 = (Sing :: Foo4 a b -> Type) instance (SingKind a, SingKind b) => SingKind (Foo4 a b) where type Demote (Foo4 a b) = Foo4 (Demote a) (Demote b) fromSing SFoo41 = Foo41 fromSing SFoo42 = Foo42 toSing Foo41 = SomeSing SFoo41 toSing Foo42 = SomeSing SFoo42 data instance Sing :: Pair -> Type where SPair :: forall (n :: Bool) (n :: Bool). (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Pair n n) type SPair = (Sing :: Pair -> Type) instance SingKind Pair where type Demote Pair = Pair fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) toSing (Pair (b :: Demote Bool) (b :: Demote Bool)) = case ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } instance SBounded Foo1 where sMinBound :: Sing (MinBoundSym0 :: Foo1) sMaxBound :: Sing (MaxBoundSym0 :: Foo1) sMinBound = SFoo1 sMaxBound = SFoo1 instance SBounded Foo2 where sMinBound :: Sing (MinBoundSym0 :: Foo2) sMaxBound :: Sing (MaxBoundSym0 :: Foo2) sMinBound = SA sMaxBound = SE instance SBounded a => SBounded (Foo3 a) where sMinBound :: Sing (MinBoundSym0 :: Foo3 a) sMaxBound :: Sing (MaxBoundSym0 :: Foo3 a) sMinBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMinBound sMaxBound = (applySing ((singFun1 @Foo3Sym0) SFoo3)) sMaxBound instance SBounded (Foo4 a b) where sMinBound :: Sing (MinBoundSym0 :: Foo4 a b) sMaxBound :: Sing (MaxBoundSym0 :: Foo4 a b) sMinBound = SFoo41 sMaxBound = SFoo42 instance SBounded Bool => SBounded Pair where sMinBound :: Sing (MinBoundSym0 :: Pair) sMaxBound :: Sing (MaxBoundSym0 :: Pair) sMinBound = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMinBound)) sMinBound sMaxBound = (applySing ((applySing ((singFun2 @PairSym0) SPair)) sMaxBound)) sMaxBound instance SingI Foo1 where sing = SFoo1 instance SingI A where sing = SA instance SingI B where sing = SB instance SingI C where sing = SC instance SingI D where sing = SD instance SingI E where sing = SE instance SingI n => SingI (Foo3 (n :: a)) where sing = SFoo3 sing instance SingI (Foo3Sym0 :: (~>) a (Foo3 a)) where sing = (singFun1 @Foo3Sym0) SFoo3 instance SingI (TyCon1 Foo3 :: (~>) a (Foo3 a)) where sing = (singFun1 @(TyCon1 Foo3)) SFoo3 instance SingI Foo41 where sing = SFoo41 instance SingI Foo42 where sing = SFoo42 instance (SingI n, SingI n) => SingI (Pair (n :: Bool) (n :: Bool)) where sing = (SPair sing) sing instance SingI (PairSym0 :: (~>) Bool ((~>) Bool Pair)) where sing = (singFun2 @PairSym0) SPair instance SingI (TyCon2 Pair :: (~>) Bool ((~>) Bool Pair)) where sing = (singFun2 @(TyCon2 Pair)) SPair instance SingI d => SingI (PairSym1 (d :: Bool) :: (~>) Bool Pair) where sing = (singFun1 @(PairSym1 (d :: Bool))) (SPair (sing @d)) instance SingI d => SingI (TyCon1 (Pair (d :: Bool)) :: (~>) Bool Pair) where sing = (singFun1 @(TyCon1 (Pair (d :: Bool)))) (SPair (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/BoundedDeriving.hs0000755000000000000000000000165507346545000024135 0ustar0000000000000000module Singletons.BoundedDeriving where import Data.Singletons.Prelude import Data.Singletons.TH import Data.Kind (Type) $(singletons [d| data Foo1 = Foo1 deriving (Bounded) data Foo2 = A | B | C | D | E deriving (Bounded) data Foo3 a = Foo3 a deriving (Bounded) data Foo4 (a :: Type) (b :: Type) = Foo41 | Foo42 deriving Bounded data Pair = Pair Bool Bool deriving Bounded |]) foo1a :: Proxy (MinBound :: Foo1) foo1a = Proxy foo1b :: Proxy 'Foo1 foo1b = foo1a foo1c :: Proxy (MaxBound :: Foo1) foo1c = Proxy foo1d :: Proxy 'Foo1 foo1d = foo1c foo2a :: Proxy (MinBound :: Foo2) foo2a = Proxy foo2b :: Proxy 'A foo2b = foo2a foo2c :: Proxy (MaxBound :: Foo2) foo2c = Proxy foo2d :: Proxy 'E foo2d = foo2c foo3a :: Proxy (MinBound :: Foo3 Bool) foo3a = Proxy foo3b :: Proxy ('Foo3 False) foo3b = foo3a foo3c :: Proxy (MaxBound :: Foo3 Bool) foo3c = Proxy foo3d :: Proxy ('Foo3 True) foo3d = foo3c singletons-2.5.1/tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template0000755000000000000000000000503007346545000024677 0ustar0000000000000000Singletons/BoxUnBox.hs:(0,0)-(0,0): Splicing declarations singletons [d| unBox :: Box a -> a unBox (FBox a) = a data Box a = FBox a |] ======> data Box a = FBox a unBox :: Box a -> a unBox (FBox a) = a type FBoxSym1 (t0123456789876543210 :: a0123456789876543210) = FBox t0123456789876543210 instance SuppressUnusedWarnings FBoxSym0 where suppressUnusedWarnings = snd (((,) FBoxSym0KindInference) ()) data FBoxSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 (Box a0123456789876543210) where FBoxSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) => FBoxSym0 t0123456789876543210 type instance Apply FBoxSym0 t0123456789876543210 = FBox t0123456789876543210 type UnBoxSym1 (a0123456789876543210 :: Box a0123456789876543210) = UnBox a0123456789876543210 instance SuppressUnusedWarnings UnBoxSym0 where suppressUnusedWarnings = snd (((,) UnBoxSym0KindInference) ()) data UnBoxSym0 :: forall a0123456789876543210. (~>) (Box a0123456789876543210) a0123456789876543210 where UnBoxSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) => UnBoxSym0 a0123456789876543210 type instance Apply UnBoxSym0 a0123456789876543210 = UnBox a0123456789876543210 type family UnBox (a :: Box a) :: a where UnBox (FBox a) = a sUnBox :: forall a (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a) sUnBox (SFBox (sA :: Sing a)) = sA instance SingI (UnBoxSym0 :: (~>) (Box a) a) where sing = (singFun1 @UnBoxSym0) sUnBox data instance Sing :: Box a -> GHC.Types.Type where SFBox :: forall a (n :: a). (Sing (n :: a)) -> Sing (FBox n) type SBox = (Sing :: Box a -> GHC.Types.Type) instance SingKind a => SingKind (Box a) where type Demote (Box a) = Box (Demote a) fromSing (SFBox b) = FBox (fromSing b) toSing (FBox (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SFBox c) } instance SingI n => SingI (FBox (n :: a)) where sing = SFBox sing instance SingI (FBoxSym0 :: (~>) a (Box a)) where sing = (singFun1 @FBoxSym0) SFBox instance SingI (TyCon1 FBox :: (~>) a (Box a)) where sing = (singFun1 @(TyCon1 FBox)) SFBox singletons-2.5.1/tests/compile-and-dump/Singletons/BoxUnBox.hs0000755000000000000000000000030207346545000022555 0ustar0000000000000000module Singletons.BoxUnBox where import Data.Singletons.TH import Data.Singletons.SuppressUnusedWarnings $(singletons [d| data Box a = FBox a unBox :: Box a -> a unBox (FBox a) = a |]) singletons-2.5.1/tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template0000755000000000000000000005116407346545000026322 0ustar0000000000000000Singletons/CaseExpressions.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo1 :: a -> Maybe a -> a foo1 d x = case x of Just y -> y Nothing -> d foo2 :: a -> Maybe a -> a foo2 d _ = case (Just d) of { Just y -> y } foo3 :: a -> b -> a foo3 a b = case (a, b) of { (p, _) -> p } foo4 :: forall a. a -> a foo4 x = case x of { y -> let z :: a z = y in z } foo5 :: a -> a foo5 x = case x of { y -> (\ _ -> x) y } |] ======> foo1 :: a -> Maybe a -> a foo1 d x = case x of Just y -> y Nothing -> d foo2 :: a -> Maybe a -> a foo2 d _ = case Just d of { Just y -> y } foo3 :: a -> b -> a foo3 a b = case (a, b) of { (p, _) -> p } foo4 :: forall a. a -> a foo4 x = case x of { y -> let z :: a z = y in z } foo5 :: a -> a foo5 x = case x of { y -> (\ _ -> x) y } type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x t where Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 where Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 type family Let0123456789876543210Z x y :: a where Let0123456789876543210Z x y = y type family Case_0123456789876543210 x t where Case_0123456789876543210 x y = Let0123456789876543210ZSym2 x y type Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a0123456789876543210 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 a0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210Sym1 a0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 a b where Let0123456789876543210Scrutinee_0123456789876543210 a b = Apply (Apply Tuple2Sym0 a) b type family Case_0123456789876543210 a b t where Case_0123456789876543210 a b '(p, _) = p type Let0123456789876543210Scrutinee_0123456789876543210Sym1 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall d0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 d0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 d0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 d where Let0123456789876543210Scrutinee_0123456789876543210 d = Apply JustSym0 d type family Case_0123456789876543210 d t where Case_0123456789876543210 d ( 'Just y) = y type family Case_0123456789876543210 d x t where Case_0123456789876543210 d x ( 'Just y) = y Case_0123456789876543210 d x 'Nothing = d type Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo5Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 type Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo3Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => Foo3Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => Foo2Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo1Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => Foo1Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 type family Foo5 (a :: a) :: a where Foo5 x = Case_0123456789876543210 x x type family Foo4 (a :: a) :: a where Foo4 x = Case_0123456789876543210 x x type family Foo3 (a :: a) (a :: b) :: a where Foo3 a b = Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) type family Foo2 (a :: a) (a :: Maybe a) :: a where Foo2 d _ = Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) type family Foo1 (a :: a) (a :: Maybe a) :: a where Foo1 d x = Case_0123456789876543210 d x x sFoo5 :: forall a (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a) sFoo4 :: forall a (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a) sFoo3 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) sFoo2 :: forall a (t :: a) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) sFoo1 :: forall a (t :: a) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) sFoo5 (sX :: Sing x) = (case sX of { (sY :: Sing y) -> (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) sY }) :: Sing (Case_0123456789876543210 x x :: a) sFoo4 (sX :: Sing x) = (case sX of { (sY :: Sing y) -> let sZ :: Sing (Let0123456789876543210ZSym2 x y :: a) sZ = sY in sZ }) :: Sing (Case_0123456789876543210 x x :: a) sFoo3 (sA :: Sing a) (sB :: Sing b) = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) sScrutinee_0123456789876543210 = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB in (case sScrutinee_0123456789876543210 of { STuple2 (sP :: Sing p) _ -> sP }) :: Sing (Case_0123456789876543210 a b (Let0123456789876543210Scrutinee_0123456789876543210Sym2 a b) :: a) sFoo2 (sD :: Sing d) _ = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) sScrutinee_0123456789876543210 = (applySing ((singFun1 @JustSym0) SJust)) sD in (case sScrutinee_0123456789876543210 of { SJust (sY :: Sing y) -> sY }) :: Sing (Case_0123456789876543210 d (Let0123456789876543210Scrutinee_0123456789876543210Sym1 d) :: a) sFoo1 (sD :: Sing d) (sX :: Sing x) = (case sX of SJust (sY :: Sing y) -> sY SNothing -> sD) :: Sing (Case_0123456789876543210 d x x :: a) instance SingI (Foo5Sym0 :: (~>) a a) where sing = (singFun1 @Foo5Sym0) sFoo5 instance SingI (Foo4Sym0 :: (~>) a a) where sing = (singFun1 @Foo4Sym0) sFoo4 instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo3Sym0) sFoo3 instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d)) instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where sing = (singFun2 @Foo2Sym0) sFoo2 instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where sing = (singFun2 @Foo1Sym0) sFoo1 instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/CaseExpressions.hs0000755000000000000000000000227007346545000024175 0ustar0000000000000000{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.CaseExpressions where import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.Maybe import Data.Singletons.SuppressUnusedWarnings $(singletons [d| foo1 :: a -> Maybe a -> a foo1 d x = case x of Just y -> y Nothing -> d foo2 :: a -> Maybe a -> a foo2 d _ = case (Just d) of Just y -> y -- Nothing -> d -- the above line causes an "inaccessible code" error. w00t. foo3 :: a -> b -> a foo3 a b = case (a, b) of (p, _) -> p foo4 :: forall a. a -> a foo4 x = case x of y -> let z :: a z = y in z foo5 :: a -> a foo5 x = case x of y -> (\_ -> x) y |]) foo1a :: Proxy (Foo1 Int (Just Char)) foo1a = Proxy foo1b :: Proxy Char foo1b = foo1a foo2a :: Proxy (Foo2 Char Nothing) foo2a = Proxy foo2b :: Proxy Char foo2b = foo2a foo3a :: Proxy (Foo3 Int Char) foo3a = Proxy foo3b :: Proxy Int foo3b = foo3a foo4a :: Proxy (Foo4 Int) foo4a = Proxy foo4b :: Proxy Int foo4b = foo4a foo5a :: Proxy (Foo5 Int) foo5a = Proxy foo5b :: Proxy Int foo5b = foo5a singletons-2.5.1/tests/compile-and-dump/Singletons/Classes.ghc86.template0000755000000000000000000010456507346545000024605 0ustar0000000000000000Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations singletons [d| infix 4 <=> const :: a -> b -> a const x _ = x fooCompare :: Foo -> Foo -> Ordering fooCompare A A = EQ fooCompare A B = LT fooCompare B B = GT fooCompare B A = EQ class MyOrd a where mycompare :: a -> a -> Ordering (<=>) :: a -> a -> Ordering (<=>) = mycompare infix 4 <=> data Foo = A | B data Foo2 = F | G instance MyOrd () where mycompare _ = const EQ instance MyOrd Nat where Zero `mycompare` Zero = EQ Zero `mycompare` (Succ _) = LT (Succ _) `mycompare` Zero = GT (Succ n) `mycompare` (Succ m) = m `mycompare` n instance MyOrd Foo where mycompare = fooCompare instance Eq Foo2 where F == F = True G == G = True F == G = False G == F = False |] ======> const :: a -> b -> a const x _ = x class MyOrd a where mycompare :: a -> a -> Ordering (<=>) :: a -> a -> Ordering (<=>) = mycompare infix 4 <=> instance MyOrd Nat where mycompare Zero Zero = EQ mycompare Zero (Succ _) = LT mycompare (Succ _) Zero = GT mycompare (Succ n) (Succ m) = (m `mycompare` n) instance MyOrd () where mycompare _ = const EQ data Foo = A | B fooCompare :: Foo -> Foo -> Ordering fooCompare A A = EQ fooCompare A B = LT fooCompare B B = GT fooCompare B A = EQ instance MyOrd Foo where mycompare = fooCompare data Foo2 = F | G instance Eq Foo2 where (==) F F = True (==) G G = True (==) F G = False (==) G F = False type ASym0 = A type BSym0 = B type FSym0 = F type GSym0 = G type FooCompareSym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = FooCompare a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FooCompareSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FooCompareSym1KindInference) ()) data FooCompareSym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering where FooCompareSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FooCompareSym1 a0123456789876543210) arg) (FooCompareSym2 a0123456789876543210 arg) => FooCompareSym1 a0123456789876543210 a0123456789876543210 type instance Apply (FooCompareSym1 a0123456789876543210) a0123456789876543210 = FooCompare a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FooCompareSym0 where suppressUnusedWarnings = snd (((,) FooCompareSym0KindInference) ()) data FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering) where FooCompareSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) => FooCompareSym0 a0123456789876543210 type instance Apply FooCompareSym0 a0123456789876543210 = FooCompareSym1 a0123456789876543210 type ConstSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Const a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ConstSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ConstSym1KindInference) ()) data ConstSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where ConstSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ConstSym1 a0123456789876543210) arg) (ConstSym2 a0123456789876543210 arg) => ConstSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ConstSym1 a0123456789876543210) a0123456789876543210 = Const a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ConstSym0 where suppressUnusedWarnings = snd (((,) ConstSym0KindInference) ()) data ConstSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where ConstSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) => ConstSym0 a0123456789876543210 type instance Apply ConstSym0 a0123456789876543210 = ConstSym1 a0123456789876543210 type family FooCompare (a :: Foo) (a :: Foo) :: Ordering where FooCompare A A = EQSym0 FooCompare A B = LTSym0 FooCompare B B = GTSym0 FooCompare B A = EQSym0 type family Const (a :: a) (a :: b) :: a where Const x _ = x type MycompareSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = Mycompare arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (MycompareSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) MycompareSym1KindInference) ()) data MycompareSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering where MycompareSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (MycompareSym1 arg0123456789876543210) arg) (MycompareSym2 arg0123456789876543210 arg) => MycompareSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (MycompareSym1 arg0123456789876543210) arg0123456789876543210 = Mycompare arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings MycompareSym0 where suppressUnusedWarnings = snd (((,) MycompareSym0KindInference) ()) data MycompareSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) where MycompareSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) => MycompareSym0 arg0123456789876543210 type instance Apply MycompareSym0 arg0123456789876543210 = MycompareSym1 arg0123456789876543210 type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = (<=>) arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering where (:<=>@#@$$###) :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210 infix 4 <=>@#@$$ instance SuppressUnusedWarnings (<=>@#@$) where suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) data (<=>@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) where (:<=>@#@$###) :: forall arg0123456789876543210 arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => (<=>@#@$) arg0123456789876543210 type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 infix 4 <=>@#@$ type family TFHelper_0123456789876543210 (a :: a) (a :: a) :: Ordering where TFHelper_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply MycompareSym0 a_0123456789876543210) a_0123456789876543210 type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 class PMyOrd (a :: GHC.Types.Type) where type Mycompare (arg :: a) (arg :: a) :: Ordering type (<=>) (arg :: a) (arg :: a) :: Ordering type (<=>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a type family Mycompare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Mycompare_0123456789876543210 'Zero 'Zero = EQSym0 Mycompare_0123456789876543210 'Zero ( 'Succ _) = LTSym0 Mycompare_0123456789876543210 ( 'Succ _) 'Zero = GTSym0 Mycompare_0123456789876543210 ( 'Succ n) ( 'Succ m) = Apply (Apply MycompareSym0 m) n type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd Nat where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family Mycompare_0123456789876543210 (a :: ()) (a :: ()) :: Ordering where Mycompare_0123456789876543210 _ a_0123456789876543210 = Apply (Apply ConstSym0 EQSym0) a_0123456789876543210 type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: ()) (a0123456789876543210 :: ()) = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: ()) :: (~>) () Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) () ((~>) () Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd () where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family Mycompare_0123456789876543210 (a :: Foo) (a :: Foo) :: Ordering where Mycompare_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooCompareSym0 a_0123456789876543210) a_0123456789876543210 type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo) (a0123456789876543210 :: Foo) = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo) :: (~>) Foo Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) Foo ((~>) Foo Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd Foo where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family TFHelper_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Bool where TFHelper_0123456789876543210 F F = TrueSym0 TFHelper_0123456789876543210 G G = TrueSym0 TFHelper_0123456789876543210 F G = FalseSym0 TFHelper_0123456789876543210 G F = FalseSym0 type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Bool where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Bool) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 instance PEq Foo2 where type (==) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a infix 4 %<=> sFooCompare :: forall (t :: Foo) (t :: Foo). Sing t -> Sing t -> Sing (Apply (Apply FooCompareSym0 t) t :: Ordering) sConst :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) sFooCompare SA SA = SEQ sFooCompare SA SB = SLT sFooCompare SB SB = SGT sFooCompare SB SA = SEQ sConst (sX :: Sing x) _ = sX instance SingI (FooCompareSym0 :: (~>) Foo ((~>) Foo Ordering)) where sing = (singFun2 @FooCompareSym0) sFooCompare instance SingI d => SingI (FooCompareSym1 (d :: Foo) :: (~>) Foo Ordering) where sing = (singFun1 @(FooCompareSym1 (d :: Foo))) (sFooCompare (sing @d)) instance SingI (ConstSym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @ConstSym0) sConst instance SingI d => SingI (ConstSym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(ConstSym1 (d :: a))) (sConst (sing @d)) data instance Sing :: Foo -> GHC.Types.Type where SA :: Sing A SB :: Sing B type SFoo = (Sing :: Foo -> GHC.Types.Type) instance SingKind Foo where type Demote Foo = Foo fromSing SA = A fromSing SB = B toSing A = SomeSing SA toSing B = SomeSing SB data instance Sing :: Foo2 -> GHC.Types.Type where SF :: Sing F SG :: Sing G type SFoo2 = (Sing :: Foo2 -> GHC.Types.Type) instance SingKind Foo2 where type Demote Foo2 = Foo2 fromSing SF = F fromSing SG = G toSing F = SomeSing SF toSing G = SomeSing SG class SMyOrd a where sMycompare :: forall (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) (%<=>) :: forall (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) default (%<=>) :: forall (t :: a) (t :: a). (Apply (Apply (<=>@#@$) t) t :: Ordering) ~ Apply (Apply TFHelper_0123456789876543210Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) (%<=>) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @MycompareSym0) sMycompare)) sA_0123456789876543210)) sA_0123456789876543210 instance SMyOrd Nat where sMycompare :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) sMycompare SZero SZero = SEQ sMycompare SZero (SSucc _) = SLT sMycompare (SSucc _) SZero = SGT sMycompare (SSucc (sN :: Sing n)) (SSucc (sM :: Sing m)) = (applySing ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) sN instance SMyOrd () where sMycompare :: forall (t :: ()) (t :: ()). Sing t -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) sMycompare _ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ConstSym0) sConst)) SEQ)) sA_0123456789876543210 instance SMyOrd Foo where sMycompare :: forall (t :: Foo) (t :: Foo). Sing t -> Sing t -> Sing (Apply (Apply MycompareSym0 t) t :: Ordering) sMycompare (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @FooCompareSym0) sFooCompare)) sA_0123456789876543210)) sA_0123456789876543210 instance SEq Foo2 where (%==) :: forall (a :: Foo2) (b :: Foo2). Sing a -> Sing b -> Sing ((==) a b) (%==) SF SF = STrue (%==) SG SG = STrue (%==) SF SG = SFalse (%==) SG SF = SFalse instance SingI A where sing = SA instance SingI B where sing = SB instance SingI F where sing = SF instance SingI G where sing = SG instance SMyOrd a => SingI (MycompareSym0 :: (~>) a ((~>) a Ordering)) where sing = (singFun2 @MycompareSym0) sMycompare instance (SMyOrd a, SingI d) => SingI (MycompareSym1 (d :: a) :: (~>) a Ordering) where sing = (singFun1 @(MycompareSym1 (d :: a))) (sMycompare (sing @d)) instance SMyOrd a => SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where sing = (singFun2 @(<=>@#@$)) (%<=>) instance (SMyOrd a, SingI d) => SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d)) Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations promote [d| instance Ord Foo2 where F `compare` F = EQ F `compare` _ = LT _ `compare` _ = GT instance MyOrd Foo2 where F `mycompare` F = EQ F `mycompare` _ = LT _ `mycompare` _ = GT |] ======> instance MyOrd Foo2 where mycompare F F = EQ mycompare F _ = LT mycompare _ _ = GT instance Ord Foo2 where compare F F = EQ compare F _ = LT compare _ _ = GT type family Mycompare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where Mycompare_0123456789876543210 'F 'F = EQSym0 Mycompare_0123456789876543210 'F _ = LTSym0 Mycompare_0123456789876543210 _ _ = GTSym0 type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd Foo2 where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a type family Compare_0123456789876543210 (a :: Foo2) (a :: Foo2) :: Ordering where Compare_0123456789876543210 'F 'F = EQSym0 Compare_0123456789876543210 'F _ = LTSym0 Compare_0123456789876543210 _ _ = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo2) (a0123456789876543210 :: Foo2) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo2) :: (~>) Foo2 Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Foo2 ((~>) Foo2 Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Foo2 where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a Singletons/Classes.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Nat' = Zero' | Succ' Nat' instance MyOrd Nat' where Zero' `mycompare` Zero' = EQ Zero' `mycompare` (Succ' _) = LT (Succ' _) `mycompare` Zero' = GT (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |] ======> data Nat' = Zero' | Succ' Nat' instance MyOrd Nat' where mycompare Zero' Zero' = EQ mycompare Zero' (Succ' _) = LT mycompare (Succ' _) Zero' = GT mycompare (Succ' n) (Succ' m) = (m `mycompare` n) type Zero'Sym0 = Zero' type Succ'Sym1 (t0123456789876543210 :: Nat') = Succ' t0123456789876543210 instance SuppressUnusedWarnings Succ'Sym0 where suppressUnusedWarnings = snd (((,) Succ'Sym0KindInference) ()) data Succ'Sym0 :: (~>) Nat' Nat' where Succ'Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) => Succ'Sym0 t0123456789876543210 type instance Apply Succ'Sym0 t0123456789876543210 = Succ' t0123456789876543210 type family Mycompare_0123456789876543210 (a :: Nat') (a :: Nat') :: Ordering where Mycompare_0123456789876543210 Zero' Zero' = EQSym0 Mycompare_0123456789876543210 Zero' (Succ' _) = LTSym0 Mycompare_0123456789876543210 (Succ' _) Zero' = GTSym0 Mycompare_0123456789876543210 (Succ' n) (Succ' m) = Apply (Apply MycompareSym0 m) n type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: Nat') (a0123456789876543210 :: Nat') = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: Nat') :: (~>) Nat' Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) Nat' ((~>) Nat' Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd Nat' where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a data instance Sing :: Nat' -> GHC.Types.Type where SZero' :: Sing Zero' SSucc' :: forall (n :: Nat'). (Sing (n :: Nat')) -> Sing (Succ' n) type SNat' = (Sing :: Nat' -> GHC.Types.Type) instance SingKind Nat' where type Demote Nat' = Nat' fromSing SZero' = Zero' fromSing (SSucc' b) = Succ' (fromSing b) toSing Zero' = SomeSing SZero' toSing (Succ' (b :: Demote Nat')) = case toSing b :: SomeSing Nat' of { SomeSing c -> SomeSing (SSucc' c) } instance SMyOrd Nat' where sMycompare :: forall (t :: Nat') (t :: Nat'). Sing t -> Sing t -> Sing (Apply (Apply (MycompareSym0 :: TyFun Nat' ((~>) Nat' Ordering) -> GHC.Types.Type) t) t) sMycompare SZero' SZero' = SEQ sMycompare SZero' (SSucc' _) = SLT sMycompare (SSucc' _) SZero' = SGT sMycompare (SSucc' (sN :: Sing n)) (SSucc' (sM :: Sing m)) = (applySing ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) sN instance SingI Zero' where sing = SZero' instance SingI n => SingI (Succ' (n :: Nat')) where sing = SSucc' sing instance SingI (Succ'Sym0 :: (~>) Nat' Nat') where sing = (singFun1 @Succ'Sym0) SSucc' instance SingI (TyCon1 Succ' :: (~>) Nat' Nat') where sing = (singFun1 @(TyCon1 Succ')) SSucc' singletons-2.5.1/tests/compile-and-dump/Singletons/Classes.hs0000755000000000000000000000371707346545000022463 0ustar0000000000000000module Singletons.Classes where import Prelude hiding (const) import Singletons.Nat import Data.Singletons import Data.Singletons.TH import Language.Haskell.TH.Desugar import Data.Singletons.Prelude.Ord import Data.Singletons.Prelude.Eq $(singletons [d| const :: a -> b -> a const x _ = x class MyOrd a where mycompare :: a -> a -> Ordering (<=>) :: a -> a -> Ordering (<=>) = mycompare infix 4 <=> instance MyOrd Nat where Zero `mycompare` Zero = EQ Zero `mycompare` (Succ _) = LT (Succ _) `mycompare` Zero = GT (Succ n) `mycompare` (Succ m) = m `mycompare` n -- test eta-expansion instance MyOrd () where mycompare _ = const EQ data Foo = A | B fooCompare :: Foo -> Foo -> Ordering fooCompare A A = EQ fooCompare A B = LT fooCompare B B = GT fooCompare B A = EQ instance MyOrd Foo where -- test that values in instance definitions are eta-expanded mycompare = fooCompare data Foo2 = F | G instance Eq Foo2 where F == F = True G == G = True F == G = False G == F = False |]) $(promote [d| -- instance with overlaping equations. Tests #56 instance MyOrd Foo2 where F `mycompare` F = EQ F `mycompare` _ = LT _ `mycompare` _ = GT instance Ord Foo2 where F `compare` F = EQ F `compare` _ = LT _ `compare` _ = GT |]) -- check promotion across different splices (#55) $(singletons [d| data Nat' = Zero' | Succ' Nat' instance MyOrd Nat' where Zero' `mycompare` Zero' = EQ Zero' `mycompare` (Succ' _) = LT (Succ' _) `mycompare` Zero' = GT (Succ' n) `mycompare` (Succ' m) = m `mycompare` n |]) foo1a :: Proxy (Zero `Mycompare` (Succ Zero)) foo1a = Proxy foo1b :: Proxy LT foo1b = foo1a foo2a :: Proxy (A `Mycompare` A) foo2a = Proxy foo2b :: Proxy EQ foo2b = foo2a foo3a :: Proxy ('() `Mycompare` '()) foo3a = Proxy foo3b :: Proxy EQ foo3b = foo3a foo4a :: Proxy (Succ' Zero' <=> Zero') foo4a = Proxy foo4b :: Proxy GT foo4b = foo4a singletons-2.5.1/tests/compile-and-dump/Singletons/Classes2.ghc86.template0000755000000000000000000001225407346545000024660 0ustar0000000000000000Singletons/Classes2.hs:(0,0)-(0,0): Splicing declarations singletons [d| data NatFoo = ZeroFoo | SuccFoo NatFoo instance MyOrd NatFoo where ZeroFoo `mycompare` ZeroFoo = EQ ZeroFoo `mycompare` (SuccFoo _) = LT (SuccFoo _) `mycompare` ZeroFoo = GT (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |] ======> data NatFoo = ZeroFoo | SuccFoo NatFoo instance MyOrd NatFoo where mycompare ZeroFoo ZeroFoo = EQ mycompare ZeroFoo (SuccFoo _) = LT mycompare (SuccFoo _) ZeroFoo = GT mycompare (SuccFoo n) (SuccFoo m) = (m `mycompare` n) type ZeroFooSym0 = ZeroFoo type SuccFooSym1 (t0123456789876543210 :: NatFoo) = SuccFoo t0123456789876543210 instance SuppressUnusedWarnings SuccFooSym0 where suppressUnusedWarnings = snd (((,) SuccFooSym0KindInference) ()) data SuccFooSym0 :: (~>) NatFoo NatFoo where SuccFooSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) => SuccFooSym0 t0123456789876543210 type instance Apply SuccFooSym0 t0123456789876543210 = SuccFoo t0123456789876543210 type family Mycompare_0123456789876543210 (a :: NatFoo) (a :: NatFoo) :: Ordering where Mycompare_0123456789876543210 ZeroFoo ZeroFoo = EQSym0 Mycompare_0123456789876543210 ZeroFoo (SuccFoo _) = LTSym0 Mycompare_0123456789876543210 (SuccFoo _) ZeroFoo = GTSym0 Mycompare_0123456789876543210 (SuccFoo n) (SuccFoo m) = Apply (Apply MycompareSym0 m) n type Mycompare_0123456789876543210Sym2 (a0123456789876543210 :: NatFoo) (a0123456789876543210 :: NatFoo) = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Mycompare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym1KindInference) ()) data Mycompare_0123456789876543210Sym1 (a0123456789876543210 :: NatFoo) :: (~>) NatFoo Ordering where Mycompare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) arg) (Mycompare_0123456789876543210Sym2 a0123456789876543210 arg) => Mycompare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Mycompare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Mycompare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Mycompare_0123456789876543210Sym0KindInference) ()) data Mycompare_0123456789876543210Sym0 :: (~>) NatFoo ((~>) NatFoo Ordering) where Mycompare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) => Mycompare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Mycompare_0123456789876543210Sym0 a0123456789876543210 = Mycompare_0123456789876543210Sym1 a0123456789876543210 instance PMyOrd NatFoo where type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a data instance Sing :: NatFoo -> GHC.Types.Type where SZeroFoo :: Sing ZeroFoo SSuccFoo :: forall (n :: NatFoo). (Sing (n :: NatFoo)) -> Sing (SuccFoo n) type SNatFoo = (Sing :: NatFoo -> GHC.Types.Type) instance SingKind NatFoo where type Demote NatFoo = NatFoo fromSing SZeroFoo = ZeroFoo fromSing (SSuccFoo b) = SuccFoo (fromSing b) toSing ZeroFoo = SomeSing SZeroFoo toSing (SuccFoo (b :: Demote NatFoo)) = case toSing b :: SomeSing NatFoo of { SomeSing c -> SomeSing (SSuccFoo c) } instance SMyOrd NatFoo where sMycompare :: forall (t1 :: NatFoo) (t2 :: NatFoo). Sing t1 -> Sing t2 -> Sing (Apply (Apply (MycompareSym0 :: TyFun NatFoo ((~>) NatFoo Ordering) -> GHC.Types.Type) t1) t2) sMycompare SZeroFoo SZeroFoo = SEQ sMycompare SZeroFoo (SSuccFoo _) = SLT sMycompare (SSuccFoo _) SZeroFoo = SGT sMycompare (SSuccFoo (sN :: Sing n)) (SSuccFoo (sM :: Sing m)) = (applySing ((applySing ((singFun2 @MycompareSym0) sMycompare)) sM)) sN instance SingI ZeroFoo where sing = SZeroFoo instance SingI n => SingI (SuccFoo (n :: NatFoo)) where sing = SSuccFoo sing instance SingI (SuccFooSym0 :: (~>) NatFoo NatFoo) where sing = (singFun1 @SuccFooSym0) SSuccFoo instance SingI (TyCon1 SuccFoo :: (~>) NatFoo NatFoo) where sing = (singFun1 @(TyCon1 SuccFoo)) SSuccFoo singletons-2.5.1/tests/compile-and-dump/Singletons/Classes2.hs0000755000000000000000000000122207346545000022532 0ustar0000000000000000module Singletons.Classes2 where import Prelude hiding (const) import Singletons.Nat import Singletons.Classes import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.Ord (EQSym0, LTSym0, GTSym0, Sing(..)) import Language.Haskell.TH.Desugar $(singletons [d| -- tests promotion of class instances when the class was declared -- in a different source file than the instance. data NatFoo = ZeroFoo | SuccFoo NatFoo instance MyOrd NatFoo where ZeroFoo `mycompare` ZeroFoo = EQ ZeroFoo `mycompare` (SuccFoo _) = LT (SuccFoo _) `mycompare` ZeroFoo = GT (SuccFoo n) `mycompare` (SuccFoo m) = m `mycompare` n |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Contains.ghc86.template0000755000000000000000000000560107346545000024755 0ustar0000000000000000Singletons/Contains.hs:(0,0)-(0,0): Splicing declarations singletons [d| contains :: Eq a => a -> [a] -> Bool contains _ [] = False contains elt (h : t) = (elt == h) || (contains elt t) |] ======> contains :: Eq a => a -> [a] -> Bool contains _ [] = False contains elt (h : t) = ((elt == h) || (contains elt) t) type ContainsSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = Contains a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ContainsSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ContainsSym1KindInference) ()) data ContainsSym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [a0123456789876543210] Bool where ContainsSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ContainsSym1 a0123456789876543210) arg) (ContainsSym2 a0123456789876543210 arg) => ContainsSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ContainsSym1 a0123456789876543210) a0123456789876543210 = Contains a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ContainsSym0 where suppressUnusedWarnings = snd (((,) ContainsSym0KindInference) ()) data ContainsSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) [a0123456789876543210] Bool) where ContainsSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) => ContainsSym0 a0123456789876543210 type instance Apply ContainsSym0 a0123456789876543210 = ContainsSym1 a0123456789876543210 type family Contains (a :: a) (a :: [a]) :: Bool where Contains _ '[] = FalseSym0 Contains elt ( '(:) h t) = Apply (Apply (||@#@$) (Apply (Apply (==@#@$) elt) h)) (Apply (Apply ContainsSym0 elt) t) sContains :: forall a (t :: a) (t :: [a]). SEq a => Sing t -> Sing t -> Sing (Apply (Apply ContainsSym0 t) t :: Bool) sContains _ SNil = SFalse sContains (sElt :: Sing elt) (SCons (sH :: Sing h) (sT :: Sing t)) = (applySing ((applySing ((singFun2 @(||@#@$)) (%||))) ((applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sElt)) sH))) ((applySing ((applySing ((singFun2 @ContainsSym0) sContains)) sElt)) sT) instance SEq a => SingI (ContainsSym0 :: (~>) a ((~>) [a] Bool)) where sing = (singFun2 @ContainsSym0) sContains instance (SEq a, SingI d) => SingI (ContainsSym1 (d :: a) :: (~>) [a] Bool) where sing = (singFun1 @(ContainsSym1 (d :: a))) (sContains (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Contains.hs0000755000000000000000000000047307346545000022640 0ustar0000000000000000module Singletons.Contains where import Data.Singletons.TH import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings -- polymorphic function with context $(singletons [d| contains :: Eq a => a -> [a] -> Bool contains _ [] = False contains elt (h:t) = (elt == h) || (contains elt t) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/DataValues.ghc86.template0000755000000000000000000002777407346545000025247 0ustar0000000000000000Singletons/DataValues.hs:(0,0)-(0,0): Splicing declarations singletons [d| pr = Pair (Succ Zero) ([Zero]) complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] data Pair a b = Pair a b deriving Show |] ======> data Pair a b = Pair a b deriving Show pr = (Pair (Succ Zero)) [Zero] complex = (Pair ((Pair (Just Zero)) Zero)) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) where PairSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings PairSym0 where suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) data PairSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) where PairSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => PairSym0 t0123456789876543210 type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 type AListSym0 = AList type TupleSym0 = Tuple type ComplexSym0 = Complex type PrSym0 = Pr type family AList where AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) type family Tuple where Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 type family Complex where Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 type family Pr where Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210 b0123456789876543210. (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (Pair a b) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a sAList :: Sing AListSym0 sTuple :: Sing TupleSym0 sComplex :: Sing ComplexSym0 sPr :: Sing PrSym0 sAList = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) SNil)) sTuple = (applySing ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) ((applySing ((singFun1 @JustSym0) SJust)) SZero))) STrue sComplex = (applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((singFun1 @JustSym0) SJust)) SZero))) SZero))) SFalse sPr = (applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) data instance Sing :: Pair a b -> GHC.Types.Type where SPair :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) type SPair = (Sing :: Pair a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Pair a b) where type Demote (Pair a b) = Pair (Demote a) (Demote b) fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) toSing (Pair (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } instance (SShow a, SShow b) => SShow (Pair a b) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Pair ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 deriving instance (Data.Singletons.ShowSing.ShowSing a, Data.Singletons.ShowSing.ShowSing b) => Show (Sing (z :: Pair a b)) instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where sing = (SPair sing) sing instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @PairSym0) SPair instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @(TyCon2 Pair)) SPair instance SingI d => SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d)) instance SingI d => SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/DataValues.hs0000755000000000000000000000065407346545000023114 0ustar0000000000000000module Singletons.DataValues where import Data.Singletons.TH import Data.Singletons.Prelude import Data.Singletons.Prelude.Show import Singletons.Nat import Data.Singletons.SuppressUnusedWarnings $(singletons [d| data Pair a b = Pair a b deriving Show pr = Pair (Succ Zero) ([Zero]) complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Empty.ghc86.template0000755000000000000000000000053407346545000024275 0ustar0000000000000000Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Empty |] ======> data Empty data instance Sing :: Empty -> GHC.Types.Type type SEmpty = (Sing :: Empty -> GHC.Types.Type) instance SingKind Empty where type Demote Empty = Empty fromSing x = case x of toSing x = SomeSing (case x of) singletons-2.5.1/tests/compile-and-dump/Singletons/Empty.hs0000755000000000000000000000013507346545000022153 0ustar0000000000000000module Singletons.Empty where import Data.Singletons.TH $(singletons [d| data Empty |]) singletons-2.5.1/tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template0000755000000000000000000001210407346545000026622 0ustar0000000000000000Singletons/EmptyShowDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Foo deriving instance Show Foo |] ======> data Foo deriving instance Show Foo type family Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 t where type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ v_0123456789876543210 a_0123456789876543210 = Apply (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Foo where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data instance Sing :: Foo -> GHC.Types.Type type SFoo = (Sing :: Foo -> GHC.Types.Type) instance SingKind Foo where type Demote Foo = Foo fromSing x = case x of toSing x = SomeSing (case x of) instance SShow Foo where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Foo) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ (sV_0123456789876543210 :: Sing v_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((case sV_0123456789876543210 of) :: Sing (Case_0123456789876543210 v_0123456789876543210 a_0123456789876543210 v_0123456789876543210))) sA_0123456789876543210 deriving instance Show (Sing (z :: Foo)) singletons-2.5.1/tests/compile-and-dump/Singletons/EmptyShowDeriving.hs0000755000000000000000000000023707346545000024507 0ustar0000000000000000module Singletons.EmptyShowDeriving where import Data.Singletons.TH $(singletons [d| data Foo deriving instance Show Foo |]) singletons-2.5.1/tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template0000755000000000000000000002531307346545000025575 0ustar0000000000000000Singletons/EnumDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Foo = Bar | Baz | Bum deriving Enum data Quux = Q1 | Q2 |] ======> data Foo = Bar | Baz | Bum deriving Enum data Quux = Q1 | Q2 type BarSym0 = Bar type BazSym0 = Baz type BumSym0 = Bum type Q1Sym0 = Q1 type Q2Sym0 = Q2 type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = BumSym0 Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = BazSym0 Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)) type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = BarSym0 Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Foo where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Foo where ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: Foo) :: GHC.Types.Nat where FromEnum_0123456789876543210 Bar = Data.Singletons.Prelude.Num.FromInteger 0 FromEnum_0123456789876543210 Baz = Data.Singletons.Prelude.Num.FromInteger 1 FromEnum_0123456789876543210 Bum = Data.Singletons.Prelude.Num.FromInteger 2 type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Foo) = FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) data FromEnum_0123456789876543210Sym0 :: (~>) Foo GHC.Types.Nat where FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 instance PEnum Foo where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a data instance Sing :: Foo -> GHC.Types.Type where SBar :: Sing Bar SBaz :: Sing Baz SBum :: Sing Bum type SFoo = (Sing :: Foo -> GHC.Types.Type) instance SingKind Foo where type Demote Foo = Foo fromSing SBar = Bar fromSing SBaz = Baz fromSing SBum = Bum toSing Bar = SomeSing SBar toSing Baz = SomeSing SBaz toSing Bum = SomeSing SBum data instance Sing :: Quux -> GHC.Types.Type where SQ1 :: Sing Q1 SQ2 :: Sing Q2 type SQuux = (Sing :: Quux -> GHC.Types.Type) instance SingKind Quux where type Demote Quux = Quux fromSing SQ1 = Q1 fromSing SQ2 = Q2 toSing Q1 = SomeSing SQ1 toSing Q2 = SomeSing SQ2 instance SEnum Foo where sToEnum :: forall (t :: GHC.Types.Nat). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Foo -> GHC.Types.Type) t) sFromEnum :: forall (t :: Foo). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Foo GHC.Types.Nat -> GHC.Types.Type) t) sToEnum (sN :: Sing n) = (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) of STrue -> SBar SFalse -> (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) of STrue -> SBaz SFalse -> (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2)) of STrue -> SBum SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 2)))) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) sFromEnum SBar = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) sFromEnum SBaz = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) sFromEnum SBum = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 2) instance SingI Bar where sing = SBar instance SingI Baz where sing = SBaz instance SingI Bum where sing = SBum instance SingI Q1 where sing = SQ1 instance SingI Q2 where sing = SQ2 Singletons/EnumDeriving.hs:0:0:: Splicing declarations singEnumInstance ''Quux ======> type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = Q2Sym0 Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = Q1Sym0 Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: Quux where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat Quux where ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: Quux) :: GHC.Types.Nat where FromEnum_0123456789876543210 'Q1 = Data.Singletons.Prelude.Num.FromInteger 0 FromEnum_0123456789876543210 'Q2 = Data.Singletons.Prelude.Num.FromInteger 1 type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: Quux) = FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) data FromEnum_0123456789876543210Sym0 :: (~>) Quux GHC.Types.Nat where FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 instance PEnum Quux where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a instance SEnum Quux where sToEnum :: forall (t :: GHC.Types.Nat). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat Quux -> GHC.Types.Type) t) sFromEnum :: forall (t :: Quux). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun Quux GHC.Types.Nat -> GHC.Types.Type) t) sToEnum (sN :: Sing n) = (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) of STrue -> SQ1 SFalse -> (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1)) of STrue -> SQ2 SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 1)))) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) sFromEnum SQ1 = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) sFromEnum SQ2 = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 1) singletons-2.5.1/tests/compile-and-dump/Singletons/EnumDeriving.hs0000755000000000000000000000027107346545000023452 0ustar0000000000000000module Singletons.EnumDeriving where import Data.Singletons.TH $(singletons [d| data Foo = Bar | Baz | Bum deriving Enum data Quux = Q1 | Q2 |]) $(singEnumInstance ''Quux) singletons-2.5.1/tests/compile-and-dump/Singletons/EqInstances.ghc86.template0000755000000000000000000000175307346545000025420 0ustar0000000000000000Singletons/EqInstances.hs:0:0:: Splicing declarations singEqInstances [''Foo, ''Empty] ======> instance SEq Foo => SEq Foo where (%==) SFLeaf SFLeaf = STrue (%==) SFLeaf ((:%+:) _ _) = SFalse (%==) ((:%+:) _ _) SFLeaf = SFalse (%==) ((:%+:) a a) ((:%+:) b b) = ((%&&) (((%==) a) b)) (((%==) a) b) type family Equals_0123456789876543210 (a :: Foo) (b :: Foo) :: Bool where Equals_0123456789876543210 'FLeaf 'FLeaf = TrueSym0 Equals_0123456789876543210 ( '(:+:) a a) ( '(:+:) b b) = (&&) ((==) a b) ((==) a b) Equals_0123456789876543210 (_ :: Foo) (_ :: Foo) = FalseSym0 instance PEq Foo where type (==) a b = Equals_0123456789876543210 a b instance SEq Empty where (%==) _ _ = STrue type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 instance PEq Empty where type (==) a b = Equals_0123456789876543210 a b singletons-2.5.1/tests/compile-and-dump/Singletons/EqInstances.hs0000755000000000000000000000027407346545000023276 0ustar0000000000000000module Singletons.EqInstances where import Data.Singletons.TH import Data.Singletons.Prelude.Bool import Singletons.Empty import Singletons.Operators $(singEqInstances [''Foo, ''Empty]) singletons-2.5.1/tests/compile-and-dump/Singletons/Error.ghc86.template0000755000000000000000000000256307346545000024274 0ustar0000000000000000Singletons/Error.hs:(0,0)-(0,0): Splicing declarations singletons [d| head :: [a] -> a head (a : _) = a head [] = error "Data.Singletons.List.head: empty list" |] ======> head :: [a] -> a head (a : _) = a head [] = error "Data.Singletons.List.head: empty list" type HeadSym1 (a0123456789876543210 :: [a0123456789876543210]) = Head a0123456789876543210 instance SuppressUnusedWarnings HeadSym0 where suppressUnusedWarnings = snd (((,) HeadSym0KindInference) ()) data HeadSym0 :: forall a0123456789876543210. (~>) [a0123456789876543210] a0123456789876543210 where HeadSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) => HeadSym0 a0123456789876543210 type instance Apply HeadSym0 a0123456789876543210 = Head a0123456789876543210 type family Head (a :: [a]) :: a where Head ( '(:) a _) = a Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list" sHead :: forall a (t :: [a]). Sing t -> Sing (Apply HeadSym0 t :: a) sHead (SCons (sA :: Sing a) _) = sA sHead SNil = sError (sing :: Sing "Data.Singletons.List.head: empty list") instance SingI (HeadSym0 :: (~>) [a] a) where sing = (singFun1 @HeadSym0) sHead singletons-2.5.1/tests/compile-and-dump/Singletons/Error.hs0000755000000000000000000000042407346545000022147 0ustar0000000000000000module Singletons.Error where import Data.Singletons import Data.Singletons.Prelude hiding (Head, HeadSym0, HeadSym1, sHead) import Data.Singletons.TH $(singletons [d| head :: [a] -> a head (a : _) = a head [] = error "Data.Singletons.List.head: empty list" |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Fixity.ghc86.template0000755000000000000000000001063007346545000024451 0ustar0000000000000000Singletons/Fixity.hs:(0,0)-(0,0): Splicing declarations singletons [d| infix 4 ==== infix 4 <=> (====) :: a -> a -> a a ==== _ = a class MyOrd a where (<=>) :: a -> a -> Ordering infix 4 <=> |] ======> class MyOrd a where (<=>) :: a -> a -> Ordering infix 4 <=> (====) :: a -> a -> a (====) a _ = a infix 4 ==== type (====@#@$$$) (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = (====) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((====@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:====@#@$$###)) ()) data (====@#@$$) (a0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 where (:====@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((====@#@$$) a0123456789876543210) arg) ((====@#@$$$) a0123456789876543210 arg) => (====@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((====@#@$$) a0123456789876543210) a0123456789876543210 = (====) a0123456789876543210 a0123456789876543210 infix 4 ====@#@$$ instance SuppressUnusedWarnings (====@#@$) where suppressUnusedWarnings = snd (((,) (:====@#@$###)) ()) data (====@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) where (:====@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) => (====@#@$) a0123456789876543210 type instance Apply (====@#@$) a0123456789876543210 = (====@#@$$) a0123456789876543210 infix 4 ====@#@$ type family (====) (a :: a) (a :: a) :: a where (====) a _ = a type (<=>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = (<=>) arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ((<=>@#@$$) arg0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<=>@#@$$###)) ()) data (<=>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 Ordering where (:<=>@#@$$###) :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply ((<=>@#@$$) arg0123456789876543210) arg) ((<=>@#@$$$) arg0123456789876543210 arg) => (<=>@#@$$) arg0123456789876543210 arg0123456789876543210 type instance Apply ((<=>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<=>) arg0123456789876543210 arg0123456789876543210 infix 4 <=>@#@$$ instance SuppressUnusedWarnings (<=>@#@$) where suppressUnusedWarnings = snd (((,) (:<=>@#@$###)) ()) data (<=>@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 Ordering) where (:<=>@#@$###) :: forall arg0123456789876543210 arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) => (<=>@#@$) arg0123456789876543210 type instance Apply (<=>@#@$) arg0123456789876543210 = (<=>@#@$$) arg0123456789876543210 infix 4 <=>@#@$ class PMyOrd (a :: GHC.Types.Type) where type (<=>) (arg :: a) (arg :: a) :: Ordering infix 4 %==== infix 4 %<=> (%====) :: forall a (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a) (%====) (sA :: Sing a) _ = sA instance SingI ((====@#@$) :: (~>) a ((~>) a a)) where sing = (singFun2 @(====@#@$)) (%====) instance SingI d => SingI ((====@#@$$) (d :: a) :: (~>) a a) where sing = (singFun1 @((====@#@$$) (d :: a))) ((%====) (sing @d)) class SMyOrd a where (%<=>) :: forall (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering) instance SMyOrd a => SingI ((<=>@#@$) :: (~>) a ((~>) a Ordering)) where sing = (singFun2 @(<=>@#@$)) (%<=>) instance (SMyOrd a, SingI d) => SingI ((<=>@#@$$) (d :: a) :: (~>) a Ordering) where sing = (singFun1 @((<=>@#@$$) (d :: a))) ((%<=>) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Fixity.hs0000755000000000000000000000044707346545000022337 0ustar0000000000000000module Singletons.Fixity where import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude import Language.Haskell.TH.Desugar $(singletons [d| class MyOrd a where (<=>) :: a -> a -> Ordering infix 4 <=> (====) :: a -> a -> a a ==== _ = a infix 4 ==== |]) singletons-2.5.1/tests/compile-and-dump/Singletons/FunDeps.ghc86.template0000755000000000000000000001165207346545000024546 0ustar0000000000000000Singletons/FunDeps.hs:(0,0)-(0,0): Splicing declarations singletons [d| t1 = meth True class FD a b | a -> b where meth :: a -> a l2r :: a -> b instance FD Bool Nat where meth = not l2r False = 0 l2r True = 1 |] ======> class FD a b | a -> b where meth :: a -> a l2r :: a -> b instance FD Bool Nat where meth = not l2r False = 0 l2r True = 1 t1 = meth True type T1Sym0 = T1 type family T1 where T1 = Apply MethSym0 TrueSym0 type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = Meth arg0123456789876543210 instance SuppressUnusedWarnings MethSym0 where suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) data MethSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where MethSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => MethSym0 arg0123456789876543210 type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210 type L2rSym1 (arg0123456789876543210 :: a0123456789876543210) = L2r arg0123456789876543210 instance SuppressUnusedWarnings L2rSym0 where suppressUnusedWarnings = snd (((,) L2rSym0KindInference) ()) data L2rSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 b0123456789876543210 where L2rSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) => L2rSym0 arg0123456789876543210 type instance Apply L2rSym0 arg0123456789876543210 = L2r arg0123456789876543210 class PFD (a :: GHC.Types.Type) (b :: GHC.Types.Type) | a -> b where type Meth (arg :: a) :: a type L2r (arg :: a) :: b type family Meth_0123456789876543210 (a :: Bool) :: Bool where Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = Meth_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) data Meth_0123456789876543210Sym0 :: (~>) Bool Bool where Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => Meth_0123456789876543210Sym0 a0123456789876543210 type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 type family L2r_0123456789876543210 (a :: Bool) :: Nat where L2r_0123456789876543210 'False = FromInteger 0 L2r_0123456789876543210 'True = FromInteger 1 type L2r_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = L2r_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) L2r_0123456789876543210Sym0KindInference) ()) data L2r_0123456789876543210Sym0 :: (~>) Bool Nat where L2r_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) => L2r_0123456789876543210Sym0 a0123456789876543210 type instance Apply L2r_0123456789876543210Sym0 a0123456789876543210 = L2r_0123456789876543210 a0123456789876543210 instance PFD Bool Nat where type Meth a = Apply Meth_0123456789876543210Sym0 a type L2r a = Apply L2r_0123456789876543210Sym0 a sT1 :: Sing T1Sym0 sT1 = (applySing ((singFun1 @MethSym0) sMeth)) STrue class SFD a b | a -> b where sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) sL2r :: forall (t :: a). Sing t -> Sing (Apply L2rSym0 t :: b) instance SFD Bool Nat where sMeth :: forall (t :: Bool). Sing t -> Sing (Apply MethSym0 t :: Bool) sL2r :: forall (t :: Bool). Sing t -> Sing (Apply L2rSym0 t :: Nat) sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 sL2r SFalse = sFromInteger (sing :: Sing 0) sL2r STrue = sFromInteger (sing :: Sing 1) instance SFD a b => SingI (MethSym0 :: (~>) a a) where sing = (singFun1 @MethSym0) sMeth instance SFD a b => SingI (L2rSym0 :: (~>) a b) where sing = (singFun1 @L2rSym0) sL2r singletons-2.5.1/tests/compile-and-dump/Singletons/FunDeps.hs0000755000000000000000000000064507346545000022427 0ustar0000000000000000{-# LANGUAGE FunctionalDependencies #-} module Singletons.FunDeps where import Data.Singletons.TH import Data.Singletons.Prelude import Data.Singletons.TypeLits $( singletons [d| class FD a b | a -> b where meth :: a -> a l2r :: a -> b instance FD Bool Nat where meth = not l2r False = 0 l2r True = 1 t1 = meth True -- t2 = l2r False -- This fails because no FDs in type families |]) singletons-2.5.1/tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template0000755000000000000000000063075307346545000027130 0ustar0000000000000000Singletons/FunctorLikeDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| data T x a = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) deriving (Functor, Foldable, Traversable) data Empty (a :: Type) deriving (Functor, Foldable, Traversable) |] ======> data T x a = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) deriving (Functor, Foldable, Traversable) data Empty (a :: Type) deriving (Functor, Foldable, Traversable) type MkT1Sym4 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) (t0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkT1Sym3KindInference) ()) data MkT1Sym3 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210) where MkT1Sym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkT1Sym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkT1Sym2KindInference) ()) data MkT1Sym2 (t0123456789876543210 :: x0123456789876543210) (t0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)) where MkT1Sym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) arg) (MkT1Sym3 t0123456789876543210 t0123456789876543210 arg) => MkT1Sym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (MkT1Sym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = MkT1Sym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkT1Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkT1Sym1KindInference) ()) data MkT1Sym1 (t0123456789876543210 :: x0123456789876543210) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210))) where MkT1Sym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkT1Sym1 t0123456789876543210) arg) (MkT1Sym2 t0123456789876543210 arg) => MkT1Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkT1Sym1 t0123456789876543210) t0123456789876543210 = MkT1Sym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkT1Sym0 where suppressUnusedWarnings = snd (((,) MkT1Sym0KindInference) ()) data MkT1Sym0 :: forall a0123456789876543210 x0123456789876543210. (~>) x0123456789876543210 ((~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) ((~>) (Maybe (Maybe a0123456789876543210)) (T x0123456789876543210 a0123456789876543210)))) where MkT1Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkT1Sym0 arg) (MkT1Sym1 arg) => MkT1Sym0 t0123456789876543210 type instance Apply MkT1Sym0 t0123456789876543210 = MkT1Sym1 t0123456789876543210 type MkT2Sym1 (t0123456789876543210 :: Maybe x0123456789876543210) = MkT2 t0123456789876543210 instance SuppressUnusedWarnings MkT2Sym0 where suppressUnusedWarnings = snd (((,) MkT2Sym0KindInference) ()) data MkT2Sym0 :: forall a0123456789876543210 x0123456789876543210. (~>) (Maybe x0123456789876543210) (T x0123456789876543210 a0123456789876543210) where MkT2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkT2Sym0 arg) (MkT2Sym1 arg) => MkT2Sym0 t0123456789876543210 type instance Apply MkT2Sym0 t0123456789876543210 = MkT2 t0123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: T x a) :: T x b where Fmap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply FmapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply FmapSym0 _f_0123456789876543210)) a_0123456789876543210) Fmap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: forall x0123456789876543210. (~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210) where Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) (T x0123456789876543210 b0123456789876543210)) where Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => Fmap_0123456789876543210Sym0 a0123456789876543210 type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = _z_0123456789876543210 type Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = n_0123456789876543210 type Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _z_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _z_01234567898765432100123456789876543210 type family TFHelper_0123456789876543210 (a :: a) (a :: T x b) :: T x a where TFHelper_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply MkT1Sym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply (<$@#@$) _z_0123456789876543210) a_0123456789876543210)) (Apply (Apply FmapSym0 (Apply (<$@#@$) _z_0123456789876543210)) a_0123456789876543210) TFHelper_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply MkT2Sym0 (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 b0123456789876543210) = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 x0123456789876543210. (~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210) where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210. (~>) a0123456789876543210 ((~>) (T x0123456789876543210 b0123456789876543210) (T x0123456789876543210 a0123456789876543210)) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 instance PFunctor (T x) where type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 type Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 _f_0123456789876543210 a_0123456789876543210 n_0123456789876543210 = MemptySym0 type Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: T x a) :: m where FoldMap_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply MappendSym0 (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply _f_0123456789876543210 a_0123456789876543210)) (Apply (Apply MappendSym0 (Apply (Apply FoldMapSym0 _f_0123456789876543210) a_0123456789876543210)) (Apply (Apply FoldMapSym0 (Apply FoldMapSym0 _f_0123456789876543210)) a_0123456789876543210))) FoldMap_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210 type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: forall x0123456789876543210. (~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210 where FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210 m0123456789876543210 x0123456789876543210. (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (T x0123456789876543210 a0123456789876543210) m0123456789876543210) where FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => FoldMap_0123456789876543210Sym0 a0123456789876543210 type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 _f_0123456789876543210) n2_0123456789876543210) n1_0123456789876543210 type Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym9KindInference) ()) data Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym9KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym10 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym9 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym8KindInference) ()) data Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym8KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym9 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym9 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym8 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 n2_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n2_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 n1_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n2_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) n1_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 n1_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = Apply (Apply (Apply FoldrSym0 (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) n2_0123456789876543210) n1_0123456789876543210 type Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym7KindInference) ()) data Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym7KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym8 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym7 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym6KindInference) ()) data Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym6KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym7 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym7 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym5KindInference) ()) data Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym5KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym6 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym6 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym5 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 a_0123456789876543210 n1_0123456789876543210 n2_0123456789876543210 = n2_0123456789876543210 type Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym4 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym3 _z_01234567898765432100123456789876543210 _f_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210) _z_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 _f_01234567898765432100123456789876543210 _z_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall _f_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 _f_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 _f_01234567898765432100123456789876543210 type family Foldr_0123456789876543210 (a :: (~>) a ((~>) b b)) (a :: b) (a :: T x a) :: b where Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply _f_0123456789876543210 a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) (Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210))) Foldr_0123456789876543210 _f_0123456789876543210 _z_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) _z_0123456789876543210 type Foldr_0123456789876543210Sym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foldr_0123456789876543210Sym2KindInference) ()) data Foldr_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: b0123456789876543210) :: forall x0123456789876543210. (~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210 where Foldr_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (Foldr_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foldr_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foldr_0123456789876543210Sym1KindInference) ()) data Foldr_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210. (~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210) where Foldr_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) arg) (Foldr_0123456789876543210Sym2 a0123456789876543210 arg) => Foldr_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foldr_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Foldr_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foldr_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Foldr_0123456789876543210Sym0KindInference) ()) data Foldr_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210. (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210)) ((~>) b0123456789876543210 ((~>) (T x0123456789876543210 a0123456789876543210) b0123456789876543210)) where Foldr_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foldr_0123456789876543210Sym0 arg) (Foldr_0123456789876543210Sym1 arg) => Foldr_0123456789876543210Sym0 a0123456789876543210 type instance Apply Foldr_0123456789876543210Sym0 a0123456789876543210 = Foldr_0123456789876543210Sym1 a0123456789876543210 instance PFoldable (T x) where type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a type Foldr a a a = Apply (Apply (Apply Foldr_0123456789876543210Sym0 a) a) a type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: T x a) :: f (T x b) where Traverse_0123456789876543210 _f_0123456789876543210 (MkT1 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) = Apply (Apply (<*>@#@$) (Apply (Apply (<*>@#@$) (Apply (Apply (Apply LiftA2Sym0 MkT1Sym0) (Apply PureSym0 a_0123456789876543210)) (Apply _f_0123456789876543210 a_0123456789876543210))) (Apply (Apply TraverseSym0 _f_0123456789876543210) a_0123456789876543210))) (Apply (Apply TraverseSym0 (Apply TraverseSym0 _f_0123456789876543210)) a_0123456789876543210) Traverse_0123456789876543210 _f_0123456789876543210 (MkT2 a_0123456789876543210) = Apply (Apply FmapSym0 MkT2Sym0) (Apply PureSym0 a_0123456789876543210) type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: T x0123456789876543210 a0123456789876543210) = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: forall x0123456789876543210. (~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210)) where Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 f0123456789876543210 x0123456789876543210. (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (T x0123456789876543210 a0123456789876543210) (f0123456789876543210 (T x0123456789876543210 b0123456789876543210))) where Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => Traverse_0123456789876543210Sym0 a0123456789876543210 type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 instance PTraversable (T x) where type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a type family Case_0123456789876543210 v_0123456789876543210 t where type family Fmap_0123456789876543210 (a :: (~>) a b) (a :: Empty a) :: Empty b where Fmap_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 type Fmap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Fmap_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym1KindInference) ()) data Fmap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Empty a0123456789876543210) (Empty b0123456789876543210) where Fmap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) arg) (Fmap_0123456789876543210Sym2 a0123456789876543210 arg) => Fmap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Fmap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Fmap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Fmap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Fmap_0123456789876543210Sym0KindInference) ()) data Fmap_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Empty a0123456789876543210) (Empty b0123456789876543210)) where Fmap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Fmap_0123456789876543210Sym0 arg) (Fmap_0123456789876543210Sym1 arg) => Fmap_0123456789876543210Sym0 a0123456789876543210 type instance Apply Fmap_0123456789876543210Sym0 a0123456789876543210 = Fmap_0123456789876543210Sym1 a0123456789876543210 type family Case_0123456789876543210 v_0123456789876543210 t where type family TFHelper_0123456789876543210 (a :: a) (a :: Empty b) :: Empty a where TFHelper_0123456789876543210 _ v_0123456789876543210 = Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210 type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Empty b0123456789876543210) = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) (Empty b0123456789876543210) (Empty a0123456789876543210) where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) (Empty b0123456789876543210) (Empty a0123456789876543210)) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 instance PFunctor Empty where type Fmap a a = Apply (Apply Fmap_0123456789876543210Sym0 a) a type (<$) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a type family FoldMap_0123456789876543210 (a :: (~>) a m) (a :: Empty a) :: m where FoldMap_0123456789876543210 _ _ = MemptySym0 type FoldMap_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) (a0123456789876543210 :: Empty a0123456789876543210) = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FoldMap_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym1KindInference) ()) data FoldMap_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 m0123456789876543210) :: (~>) (Empty a0123456789876543210) m0123456789876543210 where FoldMap_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) arg) (FoldMap_0123456789876543210Sym2 a0123456789876543210 arg) => FoldMap_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (FoldMap_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoldMap_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FoldMap_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FoldMap_0123456789876543210Sym0KindInference) ()) data FoldMap_0123456789876543210Sym0 :: forall a0123456789876543210 m0123456789876543210. (~>) ((~>) a0123456789876543210 m0123456789876543210) ((~>) (Empty a0123456789876543210) m0123456789876543210) where FoldMap_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FoldMap_0123456789876543210Sym0 arg) (FoldMap_0123456789876543210Sym1 arg) => FoldMap_0123456789876543210Sym0 a0123456789876543210 type instance Apply FoldMap_0123456789876543210Sym0 a0123456789876543210 = FoldMap_0123456789876543210Sym1 a0123456789876543210 instance PFoldable Empty where type FoldMap a a = Apply (Apply FoldMap_0123456789876543210Sym0 a) a type family Case_0123456789876543210 v_0123456789876543210 t where type family Traverse_0123456789876543210 (a :: (~>) a (f b)) (a :: Empty a) :: f (Empty b) where Traverse_0123456789876543210 _ v_0123456789876543210 = Apply PureSym0 (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) type Traverse_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: Empty a0123456789876543210) = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Traverse_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym1KindInference) ()) data Traverse_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) :: (~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210)) where Traverse_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) arg) (Traverse_0123456789876543210Sym2 a0123456789876543210 arg) => Traverse_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Traverse_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Traverse_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Traverse_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Traverse_0123456789876543210Sym0KindInference) ()) data Traverse_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 f0123456789876543210. (~>) ((~>) a0123456789876543210 (f0123456789876543210 b0123456789876543210)) ((~>) (Empty a0123456789876543210) (f0123456789876543210 (Empty b0123456789876543210))) where Traverse_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Traverse_0123456789876543210Sym0 arg) (Traverse_0123456789876543210Sym1 arg) => Traverse_0123456789876543210Sym0 a0123456789876543210 type instance Apply Traverse_0123456789876543210Sym0 a0123456789876543210 = Traverse_0123456789876543210Sym1 a0123456789876543210 instance PTraversable Empty where type Traverse a a = Apply (Apply Traverse_0123456789876543210Sym0 a) a data instance Sing :: T x a -> Type where SMkT1 :: forall x a (n :: x) (n :: a) (n :: Maybe a) (n :: Maybe (Maybe a)). (Sing (n :: x)) -> (Sing (n :: a)) -> (Sing (n :: Maybe a)) -> (Sing (n :: Maybe (Maybe a))) -> Sing (MkT1 n n n n) SMkT2 :: forall x (n :: Maybe x). (Sing (n :: Maybe x)) -> Sing (MkT2 n) type ST = (Sing :: T x a -> Type) instance (SingKind x, SingKind a) => SingKind (T x a) where type Demote (T x a) = T (Demote x) (Demote a) fromSing (SMkT1 b b b b) = (((MkT1 (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SMkT2 b) = MkT2 (fromSing b) toSing (MkT1 (b :: Demote x) (b :: Demote a) (b :: Demote (Maybe a)) (b :: Demote (Maybe (Maybe a)))) = case ((((,,,) (toSing b :: SomeSing x)) (toSing b :: SomeSing a)) (toSing b :: SomeSing (Maybe a))) (toSing b :: SomeSing (Maybe (Maybe a))) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SMkT1 c) c) c) c) } toSing (MkT2 (b :: Demote (Maybe x))) = case toSing b :: SomeSing (Maybe x) of { SomeSing c -> SomeSing (SMkT2 c) } data instance Sing :: Empty a -> Type type SEmpty = (Sing :: Empty a -> Type) instance SingKind a => SingKind (Empty a) where type Demote (Empty a) = Empty (Demote a) fromSing x = case x of toSing x = SomeSing (case x of) instance SFunctor (T x) where sFmap :: forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: T x a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (T x a) (T x b)) -> Type) t1) t2) (%<$) :: forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: T x b). Sing t1 -> Sing t2 -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (T x b) (T x a)) -> Type) t1) t2) sFmap (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((applySing ((applySing ((singFun4 @MkT1Sym0) SMkT1)) ((applySing ((singFun1 @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) sA_0123456789876543210))) ((applySing _sf_0123456789876543210) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @FmapSym0) sFmap)) _sf_0123456789876543210)) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @FmapSym0) sFmap)) ((applySing ((singFun2 @FmapSym0) sFmap)) _sf_0123456789876543210))) sA_0123456789876543210) sFmap (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((singFun1 @MkT2Sym0) SMkT2)) ((applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) sA_0123456789876543210) (%<$) (_sz_0123456789876543210 :: Sing _z_0123456789876543210) (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((applySing ((applySing ((singFun4 @MkT1Sym0) SMkT1)) ((applySing ((singFun1 @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) sA_0123456789876543210))) ((applySing ((singFun1 @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> _sz_0123456789876543210 }))) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @(<$@#@$)) (%<$))) _sz_0123456789876543210)) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @FmapSym0) sFmap)) ((applySing ((singFun2 @(<$@#@$)) (%<$))) _sz_0123456789876543210))) sA_0123456789876543210) (%<$) (_sz_0123456789876543210 :: Sing _z_0123456789876543210) (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((singFun1 @MkT2Sym0) SMkT2)) ((applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 _z_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sN_0123456789876543210 }))) sA_0123456789876543210) instance SFoldable (T x) where sFoldMap :: forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: T x a). SMonoid m => Sing t1 -> Sing t2 -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (T x a) m) -> Type) t1) t2) sFoldr :: forall (a :: Type) (b :: Type) (t1 :: (~>) a ((~>) b b)) (t2 :: b) (t3 :: T x a). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (FoldrSym0 :: TyFun ((~>) a ((~>) b b)) ((~>) b ((~>) (T x a) b)) -> Type) t1) t2) t3) sFoldMap (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((singFun2 @MappendSym0) sMappend)) ((applySing ((singFun1 @(Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sMempty }))) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @MappendSym0) sMappend)) ((applySing _sf_0123456789876543210) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @MappendSym0) sMappend)) ((applySing ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) _sf_0123456789876543210)) sA_0123456789876543210))) ((applySing ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) ((applySing ((singFun2 @FoldMapSym0) sFoldMap)) _sf_0123456789876543210))) sA_0123456789876543210))) sFoldMap (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) a_0123456789876543210)) (\ sN_0123456789876543210 -> case sN_0123456789876543210 of { (_ :: Sing n_0123456789876543210) -> sMempty }))) sA_0123456789876543210 sFoldr (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (_sz_0123456789876543210 :: Sing _z_0123456789876543210) (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((singFun2 @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { (,) (_ :: Sing n1_0123456789876543210) (_ :: Sing n2_0123456789876543210) -> sN2_0123456789876543210 }))) sA_0123456789876543210)) ((applySing ((applySing _sf_0123456789876543210) sA_0123456789876543210)) ((applySing ((applySing ((singFun2 @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { (,) (_ :: Sing n1_0123456789876543210) (_ :: Sing n2_0123456789876543210) -> (applySing ((applySing ((applySing ((singFun3 @FoldrSym0) sFoldr)) _sf_0123456789876543210)) sN2_0123456789876543210)) sN1_0123456789876543210 }))) sA_0123456789876543210)) ((applySing ((applySing ((singFun2 @(Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { (,) (_ :: Sing n1_0123456789876543210) (_ :: Sing n2_0123456789876543210) -> (applySing ((applySing ((applySing ((singFun3 @FoldrSym0) sFoldr)) ((singFun2 @(Apply (Apply (Apply (Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) n1_0123456789876543210) n2_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { (,) (_ :: Sing n1_0123456789876543210) (_ :: Sing n2_0123456789876543210) -> (applySing ((applySing ((applySing ((singFun3 @FoldrSym0) sFoldr)) _sf_0123456789876543210)) sN2_0123456789876543210)) sN1_0123456789876543210 })))) sN2_0123456789876543210)) sN1_0123456789876543210 }))) sA_0123456789876543210)) _sz_0123456789876543210))) sFoldr (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (_sz_0123456789876543210 :: Sing _z_0123456789876543210) (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((singFun2 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 _f_0123456789876543210) _z_0123456789876543210) a_0123456789876543210)) (\ sN1_0123456789876543210 sN2_0123456789876543210 -> case ((,) sN1_0123456789876543210) sN2_0123456789876543210 of { (,) (_ :: Sing n1_0123456789876543210) (_ :: Sing n2_0123456789876543210) -> sN2_0123456789876543210 }))) sA_0123456789876543210)) _sz_0123456789876543210 instance STraversable (T x) where sTraverse :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (t1 :: (~>) a (f b)) (t2 :: T x a). SApplicative f => Sing t1 -> Sing t2 -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (T x a) (f (T x b))) -> Type) t1) t2) sTraverse (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT1 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((singFun2 @(<*>@#@$)) (%<*>))) ((applySing ((applySing ((singFun2 @(<*>@#@$)) (%<*>))) ((applySing ((applySing ((applySing ((singFun3 @LiftA2Sym0) sLiftA2)) ((singFun4 @MkT1Sym0) SMkT1))) ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210))) ((applySing _sf_0123456789876543210) sA_0123456789876543210)))) ((applySing ((applySing ((singFun2 @TraverseSym0) sTraverse)) _sf_0123456789876543210)) sA_0123456789876543210)))) ((applySing ((applySing ((singFun2 @TraverseSym0) sTraverse)) ((applySing ((singFun2 @TraverseSym0) sTraverse)) _sf_0123456789876543210))) sA_0123456789876543210) sTraverse (_sf_0123456789876543210 :: Sing _f_0123456789876543210) (SMkT2 (sA_0123456789876543210 :: Sing a_0123456789876543210)) = (applySing ((applySing ((singFun2 @FmapSym0) sFmap)) ((singFun1 @MkT2Sym0) SMkT2))) ((applySing ((singFun1 @PureSym0) sPure)) sA_0123456789876543210) instance SFunctor Empty where sFmap :: forall (a :: Type) (b :: Type) (t1 :: (~>) a b) (t2 :: Empty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (FmapSym0 :: TyFun ((~>) a b) ((~>) (Empty a) (Empty b)) -> Type) t1) t2) (%<$) :: forall (a :: Type) (b :: Type) (t1 :: a) (t2 :: Empty b). Sing t1 -> Sing t2 -> Sing (Apply (Apply ((<$@#@$) :: TyFun a ((~>) (Empty b) (Empty a)) -> Type) t1) t2) sFmap _ (sV_0123456789876543210 :: Sing v_0123456789876543210) = (case sV_0123456789876543210 of) :: Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) (%<$) _ (sV_0123456789876543210 :: Sing v_0123456789876543210) = (case sV_0123456789876543210 of) :: Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210) instance SFoldable Empty where sFoldMap :: forall (m :: Type) (a :: Type) (t1 :: (~>) a m) (t2 :: Empty a). SMonoid m => Sing t1 -> Sing t2 -> Sing (Apply (Apply (FoldMapSym0 :: TyFun ((~>) a m) ((~>) (Empty a) m) -> Type) t1) t2) sFoldMap _ _ = sMempty instance STraversable Empty where sTraverse :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (t1 :: (~>) a (f b)) (t2 :: Empty a). SApplicative f => Sing t1 -> Sing t2 -> Sing (Apply (Apply (TraverseSym0 :: TyFun ((~>) a (f b)) ((~>) (Empty a) (f (Empty b))) -> Type) t1) t2) sTraverse _ (sV_0123456789876543210 :: Sing v_0123456789876543210) = (applySing ((singFun1 @PureSym0) sPure)) ((case sV_0123456789876543210 of) :: Sing (Case_0123456789876543210 v_0123456789876543210 v_0123456789876543210)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (MkT1 (n :: x) (n :: a) (n :: Maybe a) (n :: Maybe (Maybe a))) where sing = (((SMkT1 sing) sing) sing) sing instance SingI (MkT1Sym0 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where sing = (singFun4 @MkT1Sym0) SMkT1 instance SingI (TyCon4 MkT1 :: (~>) x ((~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))))) where sing = (singFun4 @(TyCon4 MkT1)) SMkT1 instance SingI d => SingI (MkT1Sym1 (d :: x) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where sing = (singFun3 @(MkT1Sym1 (d :: x))) (SMkT1 (sing @d)) instance SingI d => SingI (TyCon3 (MkT1 (d :: x)) :: (~>) a ((~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a)))) where sing = (singFun3 @(TyCon3 (MkT1 (d :: x)))) (SMkT1 (sing @d)) instance (SingI d, SingI d) => SingI (MkT1Sym2 (d :: x) (d :: a) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where sing = (singFun2 @(MkT1Sym2 (d :: x) (d :: a))) ((SMkT1 (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (MkT1 (d :: x) (d :: a)) :: (~>) (Maybe a) ((~>) (Maybe (Maybe a)) (T x a))) where sing = (singFun2 @(TyCon2 (MkT1 (d :: x) (d :: a)))) ((SMkT1 (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a) :: (~>) (Maybe (Maybe a)) (T x a)) where sing = (singFun1 @(MkT1Sym3 (d :: x) (d :: a) (d :: Maybe a))) (((SMkT1 (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a)) :: (~>) (Maybe (Maybe a)) (T x a)) where sing = (singFun1 @(TyCon1 (MkT1 (d :: x) (d :: a) (d :: Maybe a)))) (((SMkT1 (sing @d)) (sing @d)) (sing @d)) instance SingI n => SingI (MkT2 (n :: Maybe x)) where sing = SMkT2 sing instance SingI (MkT2Sym0 :: (~>) (Maybe x) (T x a)) where sing = (singFun1 @MkT2Sym0) SMkT2 instance SingI (TyCon1 MkT2 :: (~>) (Maybe x) (T x a)) where sing = (singFun1 @(TyCon1 MkT2)) SMkT2 singletons-2.5.1/tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs0000755000000000000000000000067107346545000024777 0ustar0000000000000000{-# LANGUAGE DeriveTraversable #-} -- Ensure that we can derive Functor, Foldable, and Traversable using only -- an import of Data.Singletons.TH module FunctorLikeDeriving where import Data.Kind import Data.Singletons.TH $(singletons [d| data T x a = MkT1 x a (Maybe a) (Maybe (Maybe a)) | MkT2 (Maybe x) deriving (Functor, Foldable, Traversable) data Empty (a :: Type) deriving (Functor, Foldable, Traversable) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/HigherOrder.ghc86.template0000755000000000000000000010453107346545000025403 0ustar0000000000000000Singletons/HigherOrder.hs:(0,0)-(0,0): Splicing declarations singletons [d| map :: (a -> b) -> [a] -> [b] map _ [] = [] map f (h : t) = (f h) : (map f t) liftMaybe :: (a -> b) -> Maybe a -> Maybe b liftMaybe f (Just x) = Just (f x) liftMaybe _ Nothing = Nothing zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f (x : xs) (y : ys) = f x y : zipWith f xs ys zipWith _ [] [] = [] zipWith _ (_ : _) [] = [] zipWith _ [] (_ : _) = [] foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b foo f g a = f g a splunge :: [Nat] -> [Bool] -> [Nat] splunge ns bs = zipWith (\ n b -> if b then Succ (Succ n) else n) ns bs etad :: [Nat] -> [Bool] -> [Nat] etad = zipWith (\ n b -> if b then Succ (Succ n) else n) data Either a b = Left a | Right b |] ======> data Either a b = Left a | Right b map :: (a -> b) -> [a] -> [b] map _ [] = [] map f (h : t) = (f h : (map f) t) liftMaybe :: (a -> b) -> Maybe a -> Maybe b liftMaybe f (Just x) = Just (f x) liftMaybe _ Nothing = Nothing zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f (x : xs) (y : ys) = ((f x) y : ((zipWith f) xs) ys) zipWith _ [] [] = [] zipWith _ (_ : _) [] = [] zipWith _ [] (_ : _) = [] foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b foo f g a = (f g) a splunge :: [Nat] -> [Bool] -> [Nat] splunge ns bs = ((zipWith (\ n b -> if b then Succ (Succ n) else n)) ns) bs etad :: [Nat] -> [Bool] -> [Nat] etad = zipWith (\ n b -> if b then Succ (Succ n) else n) type LeftSym1 (t0123456789876543210 :: a0123456789876543210) = Left t0123456789876543210 instance SuppressUnusedWarnings LeftSym0 where suppressUnusedWarnings = snd (((,) LeftSym0KindInference) ()) data LeftSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 (Either a0123456789876543210 b0123456789876543210) where LeftSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) => LeftSym0 t0123456789876543210 type instance Apply LeftSym0 t0123456789876543210 = Left t0123456789876543210 type RightSym1 (t0123456789876543210 :: b0123456789876543210) = Right t0123456789876543210 instance SuppressUnusedWarnings RightSym0 where suppressUnusedWarnings = snd (((,) RightSym0KindInference) ()) data RightSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 (Either a0123456789876543210 b0123456789876543210) where RightSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) => RightSym0 t0123456789876543210 type instance Apply RightSym0 t0123456789876543210 = Right t0123456789876543210 type family Case_0123456789876543210 ns bs n b t where Case_0123456789876543210 ns bs n b 'True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789876543210 ns bs n b 'False = n type family Lambda_0123456789876543210 ns bs t t where Lambda_0123456789876543210 ns bs n b = Case_0123456789876543210 ns bs n b b type Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall ns0123456789876543210 bs0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ns0123456789876543210 bs0123456789876543210 arg) => Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 bs0123456789876543210 ns0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 bs0123456789876543210 ns0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ns0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall ns0123456789876543210 bs0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ns0123456789876543210 arg) => Lambda_0123456789876543210Sym1 ns0123456789876543210 bs0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 ns0123456789876543210) bs0123456789876543210 = Lambda_0123456789876543210Sym2 ns0123456789876543210 bs0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 ns0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall ns0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 ns0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 ns0123456789876543210 = Lambda_0123456789876543210Sym1 ns0123456789876543210 type family Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'True = Apply SuccSym0 (Apply SuccSym0 n) Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 'False = n type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 n b = Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 type FooSym3 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FooSym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FooSym2KindInference) ()) data FooSym2 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) a0123456789876543210 b0123456789876543210 where FooSym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FooSym2 a0123456789876543210 a0123456789876543210) arg) (FooSym3 a0123456789876543210 a0123456789876543210 arg) => FooSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (FooSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FooSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) data FooSym1 (a0123456789876543210 :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) where FooSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FooSym1 a0123456789876543210) arg) (FooSym2 a0123456789876543210 arg) => FooSym1 a0123456789876543210 a0123456789876543210 type instance Apply (FooSym1 a0123456789876543210) a0123456789876543210 = FooSym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = FooSym1 a0123456789876543210 type ZipWithSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ZipWithSym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ZipWithSym2KindInference) ()) data ZipWithSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [b0123456789876543210] [c0123456789876543210] where ZipWithSym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) arg) (ZipWithSym3 a0123456789876543210 a0123456789876543210 arg) => ZipWithSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ZipWithSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ZipWith a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ZipWithSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ZipWithSym1KindInference) ()) data ZipWithSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) :: (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210]) where ZipWithSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ZipWithSym1 a0123456789876543210) arg) (ZipWithSym2 a0123456789876543210 arg) => ZipWithSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ZipWithSym1 a0123456789876543210) a0123456789876543210 = ZipWithSym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ZipWithSym0 where suppressUnusedWarnings = snd (((,) ZipWithSym0KindInference) ()) data ZipWithSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210. (~>) ((~>) a0123456789876543210 ((~>) b0123456789876543210 c0123456789876543210)) ((~>) [a0123456789876543210] ((~>) [b0123456789876543210] [c0123456789876543210])) where ZipWithSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) => ZipWithSym0 a0123456789876543210 type instance Apply ZipWithSym0 a0123456789876543210 = ZipWithSym1 a0123456789876543210 type SplungeSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = Splunge a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (SplungeSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SplungeSym1KindInference) ()) data SplungeSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] where SplungeSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (SplungeSym1 a0123456789876543210) arg) (SplungeSym2 a0123456789876543210 arg) => SplungeSym1 a0123456789876543210 a0123456789876543210 type instance Apply (SplungeSym1 a0123456789876543210) a0123456789876543210 = Splunge a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings SplungeSym0 where suppressUnusedWarnings = snd (((,) SplungeSym0KindInference) ()) data SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) where SplungeSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) => SplungeSym0 a0123456789876543210 type instance Apply SplungeSym0 a0123456789876543210 = SplungeSym1 a0123456789876543210 type EtadSym2 (a0123456789876543210 :: [Nat]) (a0123456789876543210 :: [Bool]) = Etad a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (EtadSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) EtadSym1KindInference) ()) data EtadSym1 (a0123456789876543210 :: [Nat]) :: (~>) [Bool] [Nat] where EtadSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (EtadSym1 a0123456789876543210) arg) (EtadSym2 a0123456789876543210 arg) => EtadSym1 a0123456789876543210 a0123456789876543210 type instance Apply (EtadSym1 a0123456789876543210) a0123456789876543210 = Etad a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings EtadSym0 where suppressUnusedWarnings = snd (((,) EtadSym0KindInference) ()) data EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat]) where EtadSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) => EtadSym0 a0123456789876543210 type instance Apply EtadSym0 a0123456789876543210 = EtadSym1 a0123456789876543210 type LiftMaybeSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = LiftMaybe a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (LiftMaybeSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) LiftMaybeSym1KindInference) ()) data LiftMaybeSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210) where LiftMaybeSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (LiftMaybeSym1 a0123456789876543210) arg) (LiftMaybeSym2 a0123456789876543210 arg) => LiftMaybeSym1 a0123456789876543210 a0123456789876543210 type instance Apply (LiftMaybeSym1 a0123456789876543210) a0123456789876543210 = LiftMaybe a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings LiftMaybeSym0 where suppressUnusedWarnings = snd (((,) LiftMaybeSym0KindInference) ()) data LiftMaybeSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) (Maybe a0123456789876543210) (Maybe b0123456789876543210)) where LiftMaybeSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) => LiftMaybeSym0 a0123456789876543210 type instance Apply LiftMaybeSym0 a0123456789876543210 = LiftMaybeSym1 a0123456789876543210 type MapSym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: [a0123456789876543210]) = Map a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (MapSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) MapSym1KindInference) ()) data MapSym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) [a0123456789876543210] [b0123456789876543210] where MapSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (MapSym1 a0123456789876543210) arg) (MapSym2 a0123456789876543210 arg) => MapSym1 a0123456789876543210 a0123456789876543210 type instance Apply (MapSym1 a0123456789876543210) a0123456789876543210 = Map a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings MapSym0 where suppressUnusedWarnings = snd (((,) MapSym0KindInference) ()) data MapSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) [a0123456789876543210] [b0123456789876543210]) where MapSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) => MapSym0 a0123456789876543210 type instance Apply MapSym0 a0123456789876543210 = MapSym1 a0123456789876543210 type family Foo (a :: (~>) ((~>) a b) ((~>) a b)) (a :: (~>) a b) (a :: a) :: b where Foo f g a = Apply (Apply f g) a type family ZipWith (a :: (~>) a ((~>) b c)) (a :: [a]) (a :: [b]) :: [c] where ZipWith f ( '(:) x xs) ( '(:) y ys) = Apply (Apply (:@#@$) (Apply (Apply f x) y)) (Apply (Apply (Apply ZipWithSym0 f) xs) ys) ZipWith _ '[] '[] = '[] ZipWith _ ( '(:) _ _) '[] = '[] ZipWith _ '[] ( '(:) _ _) = '[] type family Splunge (a :: [Nat]) (a :: [Bool]) :: [Nat] where Splunge ns bs = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) ns) bs type family Etad (a :: [Nat]) (a :: [Bool]) :: [Nat] where Etad a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply ZipWithSym0 (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) a_0123456789876543210) a_0123456789876543210 type family LiftMaybe (a :: (~>) a b) (a :: Maybe a) :: Maybe b where LiftMaybe f ( 'Just x) = Apply JustSym0 (Apply f x) LiftMaybe _ 'Nothing = NothingSym0 type family Map (a :: (~>) a b) (a :: [a]) :: [b] where Map _ '[] = '[] Map f ( '(:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t) sFoo :: forall a b (t :: (~>) ((~>) a b) ((~>) a b)) (t :: (~>) a b) (t :: a). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b) sZipWith :: forall a b c (t :: (~>) a ((~>) b c)) (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ZipWithSym0 t) t) t :: [c]) sSplunge :: forall (t :: [Nat]) (t :: [Bool]). Sing t -> Sing t -> Sing (Apply (Apply SplungeSym0 t) t :: [Nat]) sEtad :: forall (t :: [Nat]) (t :: [Bool]). Sing t -> Sing t -> Sing (Apply (Apply EtadSym0 t) t :: [Nat]) sLiftMaybe :: forall a b (t :: (~>) a b) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b) sMap :: forall a b (t :: (~>) a b) (t :: [a]). Sing t -> Sing t -> Sing (Apply (Apply MapSym0 t) t :: [b]) sFoo (sF :: Sing f) (sG :: Sing g) (sA :: Sing a) = (applySing ((applySing sF) sG)) sA sZipWith (sF :: Sing f) (SCons (sX :: Sing x) (sXs :: Sing xs)) (SCons (sY :: Sing y) (sYs :: Sing ys)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing sF) sX)) sY))) ((applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) sF)) sXs)) sYs) sZipWith _ SNil SNil = SNil sZipWith _ (SCons _ _) SNil = SNil sZipWith _ SNil (SCons _ _) = SNil sSplunge (sNs :: Sing ns) (sBs :: Sing bs) = (applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 ns) bs)) (\ sN sB -> case ((,) sN) sB of { (,) (_ :: Sing n) (_ :: Sing b) -> (case sB of STrue -> (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) sN) SFalse -> sN) :: Sing (Case_0123456789876543210 ns bs n b b) })))) sNs)) sBs sEtad (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) (\ sN sB -> case ((,) sN) sB of { (,) (_ :: Sing n) (_ :: Sing b) -> (case sB of STrue -> (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) sN) SFalse -> sN) :: Sing (Case_0123456789876543210 n b a_0123456789876543210 a_0123456789876543210 b) })))) sA_0123456789876543210)) sA_0123456789876543210 sLiftMaybe (sF :: Sing f) (SJust (sX :: Sing x)) = (applySing ((singFun1 @JustSym0) SJust)) ((applySing sF) sX) sLiftMaybe _ SNothing = SNothing sMap _ SNil = SNil sMap (sF :: Sing f) (SCons (sH :: Sing h) (sT :: Sing t)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing sF) sH))) ((applySing ((applySing ((singFun2 @MapSym0) sMap)) sF)) sT) instance SingI (FooSym0 :: (~>) ((~>) ((~>) a b) ((~>) a b)) ((~>) ((~>) a b) ((~>) a b))) where sing = (singFun3 @FooSym0) sFoo instance SingI d => SingI (FooSym1 (d :: (~>) ((~>) a b) ((~>) a b)) :: (~>) ((~>) a b) ((~>) a b)) where sing = (singFun2 @(FooSym1 (d :: (~>) ((~>) a b) ((~>) a b)))) (sFoo (sing @d)) instance (SingI d, SingI d) => SingI (FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b) :: (~>) a b) where sing = (singFun1 @(FooSym2 (d :: (~>) ((~>) a b) ((~>) a b)) (d :: (~>) a b))) ((sFoo (sing @d)) (sing @d)) instance SingI (ZipWithSym0 :: (~>) ((~>) a ((~>) b c)) ((~>) [a] ((~>) [b] [c]))) where sing = (singFun3 @ZipWithSym0) sZipWith instance SingI d => SingI (ZipWithSym1 (d :: (~>) a ((~>) b c)) :: (~>) [a] ((~>) [b] [c])) where sing = (singFun2 @(ZipWithSym1 (d :: (~>) a ((~>) b c)))) (sZipWith (sing @d)) instance (SingI d, SingI d) => SingI (ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]) :: (~>) [b] [c]) where sing = (singFun1 @(ZipWithSym2 (d :: (~>) a ((~>) b c)) (d :: [a]))) ((sZipWith (sing @d)) (sing @d)) instance SingI (SplungeSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where sing = (singFun2 @SplungeSym0) sSplunge instance SingI d => SingI (SplungeSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where sing = (singFun1 @(SplungeSym1 (d :: [Nat]))) (sSplunge (sing @d)) instance SingI (EtadSym0 :: (~>) [Nat] ((~>) [Bool] [Nat])) where sing = (singFun2 @EtadSym0) sEtad instance SingI d => SingI (EtadSym1 (d :: [Nat]) :: (~>) [Bool] [Nat]) where sing = (singFun1 @(EtadSym1 (d :: [Nat]))) (sEtad (sing @d)) instance SingI (LiftMaybeSym0 :: (~>) ((~>) a b) ((~>) (Maybe a) (Maybe b))) where sing = (singFun2 @LiftMaybeSym0) sLiftMaybe instance SingI d => SingI (LiftMaybeSym1 (d :: (~>) a b) :: (~>) (Maybe a) (Maybe b)) where sing = (singFun1 @(LiftMaybeSym1 (d :: (~>) a b))) (sLiftMaybe (sing @d)) instance SingI (MapSym0 :: (~>) ((~>) a b) ((~>) [a] [b])) where sing = (singFun2 @MapSym0) sMap instance SingI d => SingI (MapSym1 (d :: (~>) a b) :: (~>) [a] [b]) where sing = (singFun1 @(MapSym1 (d :: (~>) a b))) (sMap (sing @d)) data instance Sing :: Either a b -> GHC.Types.Type where SLeft :: forall a (n :: a). (Sing (n :: a)) -> Sing (Left n) SRight :: forall b (n :: b). (Sing (n :: b)) -> Sing (Right n) type SEither = (Sing :: Either a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Either a b) where type Demote (Either a b) = Either (Demote a) (Demote b) fromSing (SLeft b) = Left (fromSing b) fromSing (SRight b) = Right (fromSing b) toSing (Left (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SLeft c) } toSing (Right (b :: Demote b)) = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SRight c) } instance SingI n => SingI (Left (n :: a)) where sing = SLeft sing instance SingI (LeftSym0 :: (~>) a (Either a b)) where sing = (singFun1 @LeftSym0) SLeft instance SingI (TyCon1 Left :: (~>) a (Either a b)) where sing = (singFun1 @(TyCon1 Left)) SLeft instance SingI n => SingI (Right (n :: b)) where sing = SRight sing instance SingI (RightSym0 :: (~>) b (Either a b)) where sing = (singFun1 @RightSym0) SRight instance SingI (TyCon1 Right :: (~>) b (Either a b)) where sing = (singFun1 @(TyCon1 Right)) SRight singletons-2.5.1/tests/compile-and-dump/Singletons/HigherOrder.hs0000755000000000000000000000302307346545000023256 0ustar0000000000000000module Singletons.HigherOrder where import Data.Singletons import Data.Singletons.TH import Data.Singletons.Prelude.List hiding ( sMap, Map, MapSym0, MapSym1, MapSym2, ZipWith, sZipWith, ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3 ) import Data.Singletons.Prelude.Maybe import Singletons.Nat import Prelude hiding (Either(..)) import Data.Singletons.SuppressUnusedWarnings $(singletons [d| data Either a b = Left a | Right b map :: (a -> b) -> [a] -> [b] map _ [] = [] map f (h:t) = (f h) : (map f t) liftMaybe :: (a -> b) -> Maybe a -> Maybe b liftMaybe f (Just x) = Just (f x) liftMaybe _ Nothing = Nothing zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys zipWith _ [] [] = [] zipWith _ (_:_) [] = [] zipWith _ [] (_:_) = [] foo :: ((a -> b) -> a -> b) -> (a -> b) -> a -> b foo f g a = f g a splunge :: [Nat] -> [Bool] -> [Nat] splunge ns bs = zipWith (\n b -> if b then Succ (Succ n) else n) ns bs etad :: [Nat] -> [Bool] -> [Nat] etad = zipWith (\n b -> if b then Succ (Succ n) else n) |]) foo1a :: Proxy (ZipWith (TyCon Either) '[Int, Bool] '[Char, Double]) foo1a = Proxy foo1b :: Proxy ('[Either Int Char, Either Bool Double]) foo1b = foo1a foo2a :: Proxy (Map (TyCon (Either Int)) '[Bool, Double]) foo2a = Proxy foo2b :: Proxy ('[Either Int Bool, Either Int Double]) foo2b = foo2a foo3a :: Proxy (Map PredSym0 '[Succ Zero, Succ (Succ Zero)]) foo3a = Proxy foo3b :: Proxy '[Zero, Succ Zero] foo3b = foo3a singletons-2.5.1/tests/compile-and-dump/Singletons/LambdaCase.ghc86.template0000755000000000000000000004262707346545000025164 0ustar0000000000000000Singletons/LambdaCase.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo1 :: a -> Maybe a -> a foo1 d x = (\case Just y -> y Nothing -> d) x foo2 :: a -> Maybe a -> a foo2 d _ = (\case Just y -> y Nothing -> d) (Just d) foo3 :: a -> b -> a foo3 a b = (\case (p, _) -> p) (a, b) |] ======> foo1 :: a -> Maybe a -> a foo1 d x = (\case Just y -> y Nothing -> d) x foo2 :: a -> Maybe a -> a foo2 d _ = (\case Just y -> y Nothing -> d) (Just d) foo3 :: a -> b -> a foo3 a b = (\case (p, _) -> p) (a, b) type family Case_0123456789876543210 a b x_0123456789876543210 t where Case_0123456789876543210 a b x_0123456789876543210 '(p, _) = p type family Lambda_0123456789876543210 a b t where Lambda_0123456789876543210 a b x_0123456789876543210 = Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210 type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 b0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Case_0123456789876543210 d x_0123456789876543210 t where Case_0123456789876543210 d x_0123456789876543210 ( 'Just y) = y Case_0123456789876543210 d x_0123456789876543210 'Nothing = d type family Lambda_0123456789876543210 d t where Lambda_0123456789876543210 d x_0123456789876543210 = Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210 type Lambda_0123456789876543210Sym2 d0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => Lambda_0123456789876543210Sym1 d0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 d0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 d0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 type family Case_0123456789876543210 d x x_0123456789876543210 t where Case_0123456789876543210 d x x_0123456789876543210 ( 'Just y) = y Case_0123456789876543210 d x x_0123456789876543210 'Nothing = d type family Lambda_0123456789876543210 d x t where Lambda_0123456789876543210 d x x_0123456789876543210 = Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210 type Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 d0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall d0123456789876543210 x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym3 d0123456789876543210 x0123456789876543210 arg) => Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 d0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 d0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 d0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall d0123456789876543210 x0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) arg) (Lambda_0123456789876543210Sym2 d0123456789876543210 arg) => Lambda_0123456789876543210Sym1 d0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 d0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym2 d0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 d0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall d0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 d0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 d0123456789876543210 = Lambda_0123456789876543210Sym1 d0123456789876543210 type Foo3Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo3Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo3Sym1KindInference) ()) data Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo3Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo3Sym1 a0123456789876543210) arg) (Foo3Sym2 a0123456789876543210 arg) => Foo3Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo3Sym1 a0123456789876543210) a0123456789876543210 = Foo3 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3Sym1 a0123456789876543210 type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => Foo2Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: Maybe a0123456789876543210) = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo1Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => Foo1Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) (Maybe a0123456789876543210) a0123456789876543210) where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 type family Foo3 (a :: a) (a :: b) :: a where Foo3 a b = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) (Apply (Apply Tuple2Sym0 a) b) type family Foo2 (a :: a) (a :: Maybe a) :: a where Foo2 d _ = Apply (Apply Lambda_0123456789876543210Sym0 d) (Apply JustSym0 d) type family Foo1 (a :: a) (a :: Maybe a) :: a where Foo1 d x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 d) x) x sFoo3 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a) sFoo2 :: forall a (t :: a) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) sFoo1 :: forall a (t :: a) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) sFoo3 (sA :: Sing a) (sB :: Sing b) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) (\ sX_0123456789876543210 -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (case sX_0123456789876543210 of { STuple2 (sP :: Sing p) _ -> sP }) :: Sing (Case_0123456789876543210 a b x_0123456789876543210 x_0123456789876543210) }))) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sA)) sB) sFoo2 (sD :: Sing d) _ = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 d)) (\ sX_0123456789876543210 -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (case sX_0123456789876543210 of SJust (sY :: Sing y) -> sY SNothing -> sD) :: Sing (Case_0123456789876543210 d x_0123456789876543210 x_0123456789876543210) }))) ((applySing ((singFun1 @JustSym0) SJust)) sD) sFoo1 (sD :: Sing d) (sX :: Sing x) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 d) x)) (\ sX_0123456789876543210 -> case sX_0123456789876543210 of { (_ :: Sing x_0123456789876543210) -> (case sX_0123456789876543210 of SJust (sY :: Sing y) -> sY SNothing -> sD) :: Sing (Case_0123456789876543210 d x x_0123456789876543210 x_0123456789876543210) }))) sX instance SingI (Foo3Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo3Sym0) sFoo3 instance SingI d => SingI (Foo3Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo3Sym1 (d :: a))) (sFoo3 (sing @d)) instance SingI (Foo2Sym0 :: (~>) a ((~>) (Maybe a) a)) where sing = (singFun2 @Foo2Sym0) sFoo2 instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) (Maybe a) a) where sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) instance SingI (Foo1Sym0 :: (~>) a ((~>) (Maybe a) a)) where sing = (singFun2 @Foo1Sym0) sFoo1 instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) (Maybe a) a) where sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/LambdaCase.hs0000755000000000000000000000131407346545000023031 0ustar0000000000000000module Singletons.LambdaCase where import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH $(singletons [d| foo1 :: a -> Maybe a -> a foo1 d x = (\case Just y -> y Nothing -> d) x foo2 :: a -> Maybe a -> a foo2 d _ = (\case Just y -> y Nothing -> d) (Just d) foo3 :: a -> b -> a foo3 a b = (\case (p, _) -> p) (a, b) |]) foo1a :: Proxy (Foo1 Int (Just Char)) foo1a = Proxy foo1b :: Proxy Char foo1b = foo1a foo2a :: Proxy (Foo2 Char Nothing) foo2a = Proxy foo2b :: Proxy Char foo2b = foo2a foo3a :: Proxy (Foo3 Int Char) foo3a = Proxy foo3b :: Proxy Int foo3b = foo3a singletons-2.5.1/tests/compile-and-dump/Singletons/Lambdas.ghc86.template0000755000000000000000000020141507346545000024543 0ustar0000000000000000Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo0 :: a -> b -> a foo0 = (\ x y -> x) foo1 :: a -> b -> a foo1 x = (\ _ -> x) foo2 :: a -> b -> a foo2 x y = (\ _ -> x) y foo3 :: a -> a foo3 x = (\ y -> y) x foo4 :: a -> b -> c -> a foo4 x y z = (\ _ _ -> x) y z foo5 :: a -> b -> b foo5 x y = (\ x -> x) y foo6 :: a -> b -> a foo6 a b = (\ x -> \ _ -> x) a b foo7 :: a -> b -> b foo7 x y = (\ (_, b) -> b) (x, y) foo8 :: Foo a b -> a foo8 x = (\ (Foo a _) -> a) x data Foo a b = Foo a b |] ======> foo0 :: a -> b -> a foo0 = \ x y -> x foo1 :: a -> b -> a foo1 x = \ _ -> x foo2 :: a -> b -> a foo2 x y = (\ _ -> x) y foo3 :: a -> a foo3 x = (\ y -> y) x foo4 :: a -> b -> c -> a foo4 x y z = ((\ _ _ -> x) y) z foo5 :: a -> b -> b foo5 x y = (\ x -> x) y foo6 :: a -> b -> a foo6 a b = ((\ x -> \ _ -> x) a) b foo7 :: a -> b -> b foo7 x y = (\ (_, b) -> b) (x, y) data Foo a b = Foo a b foo8 :: Foo a b -> a foo8 x = (\ (Foo a _) -> a) x type FooSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = Foo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FooSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) data FooSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210) where FooSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (FooSym1 t0123456789876543210) arg) (FooSym2 t0123456789876543210 arg) => FooSym1 t0123456789876543210 t0123456789876543210 type instance Apply (FooSym1 t0123456789876543210) t0123456789876543210 = Foo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)) where FooSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 t0123456789876543210 type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210 type family Case_0123456789876543210 x arg_0123456789876543210 t where Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 a b x arg_0123456789876543210 t where Case_0123456789876543210 a b x arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 a b x t where Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 a b t where Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 b0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y x = x type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_, _) = x type family Lambda_0123456789876543210 x y z t t where Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) => Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 z0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x y = y type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x type family Lambda_0123456789876543210 x a_0123456789876543210 t where Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 type Foo8Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) = Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210 where Foo8Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Foo7Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => Foo7Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Foo7Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => Foo7Sym0 a0123456789876543210 type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 type Foo6Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo6 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo6Sym1KindInference) ()) data Foo6Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo6Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => Foo6Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo6Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 type Foo5Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo5 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo5Sym1KindInference) ()) data Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Foo5Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => Foo5Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Foo5Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 type Foo4Sym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo4Sym2KindInference) ()) data Foo4Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210. (~>) c0123456789876543210 a0123456789876543210 where Foo4Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) => Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo4Sym1KindInference) ()) data Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210) where Foo4Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) => Foo4Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210)) where Foo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 type Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo3 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => Foo2Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo1Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => Foo1Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 type Foo0Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo0 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo0Sym1KindInference) ()) data Foo0Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo0Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) => Foo0Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo0Sym0 where suppressUnusedWarnings = snd (((,) Foo0Sym0KindInference) ()) data Foo0Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo0Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => Foo0Sym0 a0123456789876543210 type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210 type family Foo8 (a :: Foo a b) :: a where Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x type family Foo7 (a :: a) (a :: b) :: b where Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) type family Foo6 (a :: a) (a :: b) :: a where Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b type family Foo5 (a :: a) (a :: b) :: b where Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type family Foo4 (a :: a) (a :: b) (a :: c) :: a where Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z type family Foo3 (a :: a) :: a where Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x type family Foo2 (a :: a) (a :: b) :: a where Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type family Foo1 (a :: a) (a :: b) :: a where Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 type family Foo0 (a :: a) (a :: b) :: a where Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 sFoo8 :: forall a b (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) sFoo7 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) sFoo6 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) sFoo5 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) sFoo4 :: forall a b c (t :: a) (t :: b) (t :: c). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) sFoo3 :: forall a (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) sFoo2 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) sFoo1 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) sFoo0 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) sFoo8 (sX :: Sing x) = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { SFoo (sA :: Sing a) _ -> sA }) :: Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))) sX sFoo7 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { STuple2 _ (sB :: Sing b) -> sB }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) sFoo6 (sA :: Sing a) (sB :: Sing b) = (applySing ((applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) (\ sX -> case sX of { (_ :: Sing x) -> (singFun1 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) }))) sA)) sB sFoo5 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sX -> case sX of { (_ :: Sing x) -> sX }))) sY sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z) = (applySing ((applySing ((singFun2 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z)) (\ sArg_0123456789876543210 sArg_0123456789876543210 -> case ((,) sArg_0123456789876543210) sArg_0123456789876543210 of { (,) (_ :: Sing arg_0123456789876543210) (_ :: Sing arg_0123456789876543210) -> (case (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sArg_0123456789876543210)) sArg_0123456789876543210 of { STuple2 _ _ -> sX }) :: Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) }))) sY)) sZ sFoo3 (sX :: Sing x) = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sY -> case sY of { (_ :: Sing y) -> sY }))) sX sFoo2 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) sY sFoo1 (sX :: Sing x) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) sA_0123456789876543210 sFoo0 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) (\ sX sY -> case ((,) sX) sY of { (,) (_ :: Sing x) (_ :: Sing y) -> sX }))) sA_0123456789876543210)) sA_0123456789876543210 instance SingI (Foo8Sym0 :: (~>) (Foo a b) a) where sing = (singFun1 @Foo8Sym0) sFoo8 instance SingI (Foo7Sym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @Foo7Sym0) sFoo7 instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d)) instance SingI (Foo6Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo6Sym0) sFoo6 instance SingI d => SingI (Foo6Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo6Sym1 (d :: a))) (sFoo6 (sing @d)) instance SingI (Foo5Sym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @Foo5Sym0) sFoo5 instance SingI d => SingI (Foo5Sym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(Foo5Sym1 (d :: a))) (sFoo5 (sing @d)) instance SingI (Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))) where sing = (singFun3 @Foo4Sym0) sFoo4 instance SingI d => SingI (Foo4Sym1 (d :: a) :: (~>) b ((~>) c a)) where sing = (singFun2 @(Foo4Sym1 (d :: a))) (sFoo4 (sing @d)) instance (SingI d, SingI d) => SingI (Foo4Sym2 (d :: a) (d :: b) :: (~>) c a) where sing = (singFun1 @(Foo4Sym2 (d :: a) (d :: b))) ((sFoo4 (sing @d)) (sing @d)) instance SingI (Foo3Sym0 :: (~>) a a) where sing = (singFun1 @Foo3Sym0) sFoo3 instance SingI (Foo2Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo2Sym0) sFoo2 instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) instance SingI (Foo1Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo1Sym0) sFoo1 instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) instance SingI (Foo0Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo0Sym0) sFoo0 instance SingI d => SingI (Foo0Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo0Sym1 (d :: a))) (sFoo0 (sing @d)) data instance Sing :: Foo a b -> GHC.Types.Type where SFoo :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Foo n n) type SFoo = (Sing :: Foo a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Foo a b) where type Demote (Foo a b) = Foo (Demote a) (Demote b) fromSing (SFoo b b) = (Foo (fromSing b)) (fromSing b) toSing (Foo (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) } instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where sing = (SFoo sing) sing instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where sing = (singFun2 @FooSym0) SFoo instance SingI (TyCon2 Foo :: (~>) a ((~>) b (Foo a b))) where sing = (singFun2 @(TyCon2 Foo)) SFoo instance SingI d => SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where sing = (singFun1 @(FooSym1 (d :: a))) (SFoo (sing @d)) instance SingI d => SingI (TyCon1 (Foo (d :: a)) :: (~>) b (Foo a b)) where sing = (singFun1 @(TyCon1 (Foo (d :: a)))) (SFoo (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Lambdas.hs0000755000000000000000000000357707346545000022435 0ustar0000000000000000{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing #-} {-# LANGUAGE UnboxedTuples #-} -- We expect unused binds and name shadowing in foo5 test. module Singletons.Lambdas where import Data.Proxy import Data.Singletons import Data.Singletons.TH $(singletons [d| -- nothing in scope foo0 :: a -> b -> a foo0 = (\x y -> x) -- eta-reduced function foo1 :: a -> b -> a foo1 x = (\_ -> x) -- same as before, but without eta-reduction foo2 :: a -> b -> a foo2 x y = (\_ -> x) y foo3 :: a -> a foo3 x = (\y -> y) x -- more lambda parameters + returning in-scope variable foo4 :: a -> b -> c -> a foo4 x y z = (\_ _ -> x) y z -- name shadowing -- Note: due to -dsuppress-uniques output of this test does not really -- prove that the result is correct. Compiling this file manually and -- examining dumped splise of relevant Lamdba reveals that indeed that Lambda -- returns its last parameter (ie. y passed in a call) rather than the -- first one (ie. x that is shadowed by the binder in a lambda). foo5 :: a -> b -> b foo5 x y = (\x -> x) y -- nested lambdas foo6 :: a -> b -> a foo6 a b = (\x -> \_ -> x) a b -- tuple patterns foo7 :: a -> b -> b foo7 x y = (\(_, b) -> b) (x, y) -- constructor patters=ns data Foo a b = Foo a b foo8 :: Foo a b -> a foo8 x = (\(Foo a _) -> a) x |]) foo1a :: Proxy (Foo1 Int Char) foo1a = Proxy foo1b :: Proxy Int foo1b = foo1a foo2a :: Proxy (Foo2 Int Char) foo2a = Proxy foo2b :: Proxy Int foo2b = foo2a foo3a :: Proxy (Foo3 Int) foo3a = Proxy foo3b :: Proxy Int foo3b = foo3a foo4a :: Proxy (Foo4 Int Char Bool) foo4a = Proxy foo4b :: Proxy Int foo4b = foo4a foo5a :: Proxy (Foo5 Int Bool) foo5a = Proxy foo5b :: Proxy Bool foo5b = foo5a foo6a :: Proxy (Foo6 Int Char) foo6a = Proxy foo6b :: Proxy Int foo6b = foo6a foo7a :: Proxy (Foo7 Int Char) foo7a = Proxy foo7b :: Proxy Char foo7b = foo7a singletons-2.5.1/tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.template0000755000000000000000000000716407346545000027300 0ustar0000000000000000Singletons/LambdasComprehensive.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: [Nat] foo = map (\ x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] bar :: [Nat] bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |] ======> foo :: [Nat] foo = (map (\ x -> ((either_ pred) Succ) x)) [Left Zero, Right (Succ Zero)] bar :: [Nat] bar = (map ((either_ pred) Succ)) [Left Zero, Right (Succ Zero)] type family Lambda_0123456789876543210 t where Lambda_0123456789876543210 x = Apply (Apply (Apply Either_Sym0 PredSym0) SuccSym0) x type Lambda_0123456789876543210Sym1 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 t0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 t0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 type BarSym0 = Bar type FooSym0 = Foo type family Bar :: [Nat] where Bar = Apply (Apply MapSym0 (Apply (Apply Either_Sym0 PredSym0) SuccSym0)) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) type family Foo :: [Nat] where Foo = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) (Apply LeftSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply RightSym0 (Apply SuccSym0 ZeroSym0))) '[])) sBar :: Sing (BarSym0 :: [Nat]) sFoo :: Sing (FooSym0 :: [Nat]) sBar = (applySing ((applySing ((singFun2 @MapSym0) sMap)) ((applySing ((applySing ((singFun3 @Either_Sym0) sEither_)) ((singFun1 @PredSym0) sPred))) ((singFun1 @SuccSym0) SSucc)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @RightSym0) SRight)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) SNil)) sFoo = (applySing ((applySing ((singFun2 @MapSym0) sMap)) ((singFun1 @Lambda_0123456789876543210Sym0) (\ sX -> case sX of { (_ :: Sing x) -> (applySing ((applySing ((applySing ((singFun3 @Either_Sym0) sEither_)) ((singFun1 @PredSym0) sPred))) ((singFun1 @SuccSym0) SSucc))) sX })))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @LeftSym0) SLeft)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @RightSym0) SRight)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) SNil)) singletons-2.5.1/tests/compile-and-dump/Singletons/LambdasComprehensive.hs0000755000000000000000000000123507346545000025152 0ustar0000000000000000module Singletons.LambdasComprehensive where import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Data.Singletons.Prelude import Singletons.Nat import Prelude hiding (pred) $(singletons [d| foo :: [Nat] foo = map (\x -> either_ pred Succ x) [Left Zero, Right (Succ Zero)] -- this is the same as above except that it does not use lambdas bar :: [Nat] bar = map (either_ pred Succ) [Left Zero, Right (Succ Zero)] |]) fooTest1a :: Proxy Foo fooTest1a = Proxy fooTest1b :: Proxy [Zero, Succ (Succ Zero)] fooTest1b = fooTest1a barTest1a :: Proxy Bar barTest1a = Proxy barTest1b :: Proxy [Zero, Succ (Succ Zero)] barTest1b = barTest1a singletons-2.5.1/tests/compile-and-dump/Singletons/LetStatements.ghc86.template0000755000000000000000000016076207346545000026005 0ustar0000000000000000Singletons/LetStatements.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo1 :: Nat -> Nat foo1 x = let y :: Nat y = Succ Zero in y foo2 :: Nat foo2 = let y = Succ Zero z = Succ y in z foo3 :: Nat -> Nat foo3 x = let y :: Nat y = Succ x in y foo4 :: Nat -> Nat foo4 x = let f :: Nat -> Nat f y = Succ y in f x foo5 :: Nat -> Nat foo5 x = let f :: Nat -> Nat f y = let z :: Nat z = Succ y in Succ z in f x foo6 :: Nat -> Nat foo6 x = let f :: Nat -> Nat f y = Succ y in let z :: Nat z = f x in z foo7 :: Nat -> Nat foo7 x = let x :: Nat x = Zero in x foo8 :: Nat -> Nat foo8 x = let z :: Nat z = (\ x -> x) Zero in z foo9 :: Nat -> Nat foo9 x = let z :: Nat -> Nat z = (\ x -> x) in z x foo10 :: Nat -> Nat foo10 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) in (Succ Zero) + x foo11 :: Nat -> Nat foo11 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) z :: Nat z = x in (Succ Zero) + z foo12 :: Nat -> Nat foo12 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + x) in x + (Succ (Succ Zero)) foo13 :: forall a. a -> a foo13 x = let bar :: a bar = x in foo13_ bar foo13_ :: a -> a foo13_ y = y foo14 :: Nat -> (Nat, Nat) foo14 x = let (y, z) = (Succ x, x) in (z, y) |] ======> foo1 :: Nat -> Nat foo1 x = let y :: Nat y = Succ Zero in y foo2 :: Nat foo2 = let y = Succ Zero z = Succ y in z foo3 :: Nat -> Nat foo3 x = let y :: Nat y = Succ x in y foo4 :: Nat -> Nat foo4 x = let f :: Nat -> Nat f y = Succ y in f x foo5 :: Nat -> Nat foo5 x = let f :: Nat -> Nat f y = let z :: Nat z = Succ y in Succ z in f x foo6 :: Nat -> Nat foo6 x = let f :: Nat -> Nat f y = Succ y in let z :: Nat z = f x in z foo7 :: Nat -> Nat foo7 x = let x :: Nat x = Zero in x foo8 :: Nat -> Nat foo8 x = let z :: Nat z = (\ x -> x) Zero in z foo9 :: Nat -> Nat foo9 x = let z :: Nat -> Nat z = \ x -> x in z x foo10 :: Nat -> Nat foo10 x = let (+) :: Nat -> Nat -> Nat (+) Zero m = m (+) (Succ n) m = Succ (n + m) in (Succ Zero + x) foo11 :: Nat -> Nat foo11 x = let (+) :: Nat -> Nat -> Nat z :: Nat (+) Zero m = m (+) (Succ n) m = Succ (n + m) z = x in (Succ Zero + z) foo12 :: Nat -> Nat foo12 x = let (+) :: Nat -> Nat -> Nat (+) Zero m = m (+) (Succ n) m = Succ (n + x) in (x + Succ (Succ Zero)) foo13 :: forall a. a -> a foo13 x = let bar :: a bar = x in foo13_ bar foo13_ :: a -> a foo13_ y = y foo14 :: Nat -> (Nat, Nat) foo14 x = let (y, z) = (Succ x, x) in (z, y) type family Case_0123456789876543210 x t where Case_0123456789876543210 x '(y_0123456789876543210, _) = y_0123456789876543210 type family Case_0123456789876543210 x t where Case_0123456789876543210 x '(_, y_0123456789876543210) = y_0123456789876543210 type Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) data Let0123456789876543210YSym0 x0123456789876543210 where Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 type Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 type Let0123456789876543210X_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210X_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 where Let0123456789876543210X_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) => Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210X_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210X_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Y x where Let0123456789876543210Y x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) type family Let0123456789876543210Z x where Let0123456789876543210Z x = Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x) type family Let0123456789876543210X_0123456789876543210 x where Let0123456789876543210X_0123456789876543210 x = Apply (Apply Tuple2Sym0 (Apply SuccSym0 x)) x type Let0123456789876543210BarSym1 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210BarSym0KindInference) ()) data Let0123456789876543210BarSym0 x0123456789876543210 where Let0123456789876543210BarSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) => Let0123456789876543210BarSym0 x0123456789876543210 type instance Apply Let0123456789876543210BarSym0 x0123456789876543210 = Let0123456789876543210Bar x0123456789876543210 type family Let0123456789876543210Bar x :: a where Let0123456789876543210Bar x = x type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) x) type Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = x type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (<<<%%%%%%%%%%%%%%%%%%%%) x0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###) :: forall x0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) x0123456789876543210 a0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) a0123456789876543210 x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%) a0123456789876543210 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 :: (~>) Nat ((~>) Nat Nat) where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###) :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 a0123456789876543210 type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210) a0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where suppressUnusedWarnings = snd (((,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) ()) data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 where (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###) :: forall x0123456789876543210 arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) => (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) x0123456789876543210 = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x0123456789876543210 type family (<<<%%%%%%%%%%%%%%%%%%%%) x (a :: Nat) (a :: Nat) :: Nat where (<<<%%%%%%%%%%%%%%%%%%%%) x 'Zero m = m (<<<%%%%%%%%%%%%%%%%%%%%) x ( 'Succ n) m = Apply SuccSym0 (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) n) m) type family Lambda_0123456789876543210 x a_0123456789876543210 t where Lambda_0123456789876543210 x a_0123456789876543210 x = x type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type Let0123456789876543210ZSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) data Let0123456789876543210ZSym1 x0123456789876543210 :: (~>) Nat Nat where Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => Let0123456789876543210ZSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210Z x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 type family Let0123456789876543210Z x (a :: Nat) :: Nat where Let0123456789876543210Z x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x x = x type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0 type Let0123456789876543210XSym1 x0123456789876543210 = Let0123456789876543210X x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) data Let0123456789876543210XSym0 x0123456789876543210 where Let0123456789876543210XSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 x0123456789876543210 type instance Apply Let0123456789876543210XSym0 x0123456789876543210 = Let0123456789876543210X x0123456789876543210 type family Let0123456789876543210X x :: Nat where Let0123456789876543210X x = ZeroSym0 type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat where Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210FSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym0KindInference) ()) data Let0123456789876543210FSym0 x0123456789876543210 where Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => Let0123456789876543210FSym0 x0123456789876543210 type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where Let0123456789876543210F x y = Apply SuccSym0 y type Let0123456789876543210ZSym1 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210Z x0123456789876543210 type family Let0123456789876543210Z x :: Nat where Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x type Let0123456789876543210ZSym2 x0123456789876543210 y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210ZSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym1KindInference) ()) data Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 where Let0123456789876543210ZSym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Let0123456789876543210ZSym1 x0123456789876543210) arg) (Let0123456789876543210ZSym2 x0123456789876543210 arg) => Let0123456789876543210ZSym1 x0123456789876543210 y0123456789876543210 type instance Apply (Let0123456789876543210ZSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210Z x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210ZSym0KindInference) ()) data Let0123456789876543210ZSym0 x0123456789876543210 where Let0123456789876543210ZSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) => Let0123456789876543210ZSym0 x0123456789876543210 type instance Apply Let0123456789876543210ZSym0 x0123456789876543210 = Let0123456789876543210ZSym1 x0123456789876543210 type family Let0123456789876543210Z x y :: Nat where Let0123456789876543210Z x y = Apply SuccSym0 y type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat where Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210FSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym0KindInference) ()) data Let0123456789876543210FSym0 x0123456789876543210 where Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => Let0123456789876543210FSym0 x0123456789876543210 type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y) type Let0123456789876543210FSym2 x0123456789876543210 (a0123456789876543210 :: Nat) = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210FSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym1KindInference) ()) data Let0123456789876543210FSym1 x0123456789876543210 :: (~>) Nat Nat where Let0123456789876543210FSym1KindInference :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210FSym1 x0123456789876543210) arg) (Let0123456789876543210FSym2 x0123456789876543210 arg) => Let0123456789876543210FSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210FSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210F x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210FSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210FSym0KindInference) ()) data Let0123456789876543210FSym0 x0123456789876543210 where Let0123456789876543210FSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) => Let0123456789876543210FSym0 x0123456789876543210 type instance Apply Let0123456789876543210FSym0 x0123456789876543210 = Let0123456789876543210FSym1 x0123456789876543210 type family Let0123456789876543210F x (a :: Nat) :: Nat where Let0123456789876543210F x y = Apply SuccSym0 y type Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) data Let0123456789876543210YSym0 x0123456789876543210 where Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 type family Let0123456789876543210Y x :: Nat where Let0123456789876543210Y x = Apply SuccSym0 x type Let0123456789876543210YSym0 = Let0123456789876543210Y type Let0123456789876543210ZSym0 = Let0123456789876543210Z type family Let0123456789876543210Y where Let0123456789876543210Y = Apply SuccSym0 ZeroSym0 type family Let0123456789876543210Z where Let0123456789876543210Z = Apply SuccSym0 Let0123456789876543210YSym0 type Let0123456789876543210YSym1 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210YSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210YSym0KindInference) ()) data Let0123456789876543210YSym0 x0123456789876543210 where Let0123456789876543210YSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) => Let0123456789876543210YSym0 x0123456789876543210 type instance Apply Let0123456789876543210YSym0 x0123456789876543210 = Let0123456789876543210Y x0123456789876543210 type family Let0123456789876543210Y x :: Nat where Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0 type Foo14Sym1 (a0123456789876543210 :: Nat) = Foo14 a0123456789876543210 instance SuppressUnusedWarnings Foo14Sym0 where suppressUnusedWarnings = snd (((,) Foo14Sym0KindInference) ()) data Foo14Sym0 :: (~>) Nat (Nat, Nat) where Foo14Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) => Foo14Sym0 a0123456789876543210 type instance Apply Foo14Sym0 a0123456789876543210 = Foo14 a0123456789876543210 type Foo13_Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo13_ a0123456789876543210 instance SuppressUnusedWarnings Foo13_Sym0 where suppressUnusedWarnings = snd (((,) Foo13_Sym0KindInference) ()) data Foo13_Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo13_Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) => Foo13_Sym0 a0123456789876543210 type instance Apply Foo13_Sym0 a0123456789876543210 = Foo13_ a0123456789876543210 type Foo13Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo13 a0123456789876543210 instance SuppressUnusedWarnings Foo13Sym0 where suppressUnusedWarnings = snd (((,) Foo13Sym0KindInference) ()) data Foo13Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo13Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) => Foo13Sym0 a0123456789876543210 type instance Apply Foo13Sym0 a0123456789876543210 = Foo13 a0123456789876543210 type Foo12Sym1 (a0123456789876543210 :: Nat) = Foo12 a0123456789876543210 instance SuppressUnusedWarnings Foo12Sym0 where suppressUnusedWarnings = snd (((,) Foo12Sym0KindInference) ()) data Foo12Sym0 :: (~>) Nat Nat where Foo12Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) => Foo12Sym0 a0123456789876543210 type instance Apply Foo12Sym0 a0123456789876543210 = Foo12 a0123456789876543210 type Foo11Sym1 (a0123456789876543210 :: Nat) = Foo11 a0123456789876543210 instance SuppressUnusedWarnings Foo11Sym0 where suppressUnusedWarnings = snd (((,) Foo11Sym0KindInference) ()) data Foo11Sym0 :: (~>) Nat Nat where Foo11Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) => Foo11Sym0 a0123456789876543210 type instance Apply Foo11Sym0 a0123456789876543210 = Foo11 a0123456789876543210 type Foo10Sym1 (a0123456789876543210 :: Nat) = Foo10 a0123456789876543210 instance SuppressUnusedWarnings Foo10Sym0 where suppressUnusedWarnings = snd (((,) Foo10Sym0KindInference) ()) data Foo10Sym0 :: (~>) Nat Nat where Foo10Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) => Foo10Sym0 a0123456789876543210 type instance Apply Foo10Sym0 a0123456789876543210 = Foo10 a0123456789876543210 type Foo9Sym1 (a0123456789876543210 :: Nat) = Foo9 a0123456789876543210 instance SuppressUnusedWarnings Foo9Sym0 where suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) data Foo9Sym0 :: (~>) Nat Nat where Foo9Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => Foo9Sym0 a0123456789876543210 type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 type Foo8Sym1 (a0123456789876543210 :: Nat) = Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: (~>) Nat Nat where Foo8Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 type Foo7Sym1 (a0123456789876543210 :: Nat) = Foo7 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: (~>) Nat Nat where Foo7Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => Foo7Sym0 a0123456789876543210 type instance Apply Foo7Sym0 a0123456789876543210 = Foo7 a0123456789876543210 type Foo6Sym1 (a0123456789876543210 :: Nat) = Foo6 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: (~>) Nat Nat where Foo6Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 type Foo5Sym1 (a0123456789876543210 :: Nat) = Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: (~>) Nat Nat where Foo5Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 type Foo4Sym1 (a0123456789876543210 :: Nat) = Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: (~>) Nat Nat where Foo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 type Foo3Sym1 (a0123456789876543210 :: Nat) = Foo3 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: (~>) Nat Nat where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 type Foo2Sym0 = Foo2 type Foo1Sym1 (a0123456789876543210 :: Nat) = Foo1 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: (~>) Nat Nat where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 type family Foo14 (a :: Nat) :: (Nat, Nat) where Foo14 x = Apply (Apply Tuple2Sym0 (Let0123456789876543210ZSym1 x)) (Let0123456789876543210YSym1 x) type family Foo13_ (a :: a) :: a where Foo13_ y = y type family Foo13 (a :: a) :: a where Foo13 x = Apply Foo13_Sym0 (Let0123456789876543210BarSym1 x) type family Foo12 (a :: Nat) :: Nat where Foo12 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) x) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0)) type family Foo11 (a :: Nat) :: Nat where Foo11 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) (Let0123456789876543210ZSym1 x) type family Foo10 (a :: Nat) :: Nat where Foo10 x = Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) (Apply SuccSym0 ZeroSym0)) x type family Foo9 (a :: Nat) :: Nat where Foo9 x = Apply (Let0123456789876543210ZSym1 x) x type family Foo8 (a :: Nat) :: Nat where Foo8 x = Let0123456789876543210ZSym1 x type family Foo7 (a :: Nat) :: Nat where Foo7 x = Let0123456789876543210XSym1 x type family Foo6 (a :: Nat) :: Nat where Foo6 x = Let0123456789876543210ZSym1 x type family Foo5 (a :: Nat) :: Nat where Foo5 x = Apply (Let0123456789876543210FSym1 x) x type family Foo4 (a :: Nat) :: Nat where Foo4 x = Apply (Let0123456789876543210FSym1 x) x type family Foo3 (a :: Nat) :: Nat where Foo3 x = Let0123456789876543210YSym1 x type family Foo2 :: Nat where Foo2 = Let0123456789876543210ZSym0 type family Foo1 (a :: Nat) :: Nat where Foo1 x = Let0123456789876543210YSym1 x sFoo14 :: forall (t :: Nat). Sing t -> Sing (Apply Foo14Sym0 t :: (Nat, Nat)) sFoo13_ :: forall a (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a) sFoo13 :: forall a (t :: a). Sing t -> Sing (Apply Foo13Sym0 t :: a) sFoo12 :: forall (t :: Nat). Sing t -> Sing (Apply Foo12Sym0 t :: Nat) sFoo11 :: forall (t :: Nat). Sing t -> Sing (Apply Foo11Sym0 t :: Nat) sFoo10 :: forall (t :: Nat). Sing t -> Sing (Apply Foo10Sym0 t :: Nat) sFoo9 :: forall (t :: Nat). Sing t -> Sing (Apply Foo9Sym0 t :: Nat) sFoo8 :: forall (t :: Nat). Sing t -> Sing (Apply Foo8Sym0 t :: Nat) sFoo7 :: forall (t :: Nat). Sing t -> Sing (Apply Foo7Sym0 t :: Nat) sFoo6 :: forall (t :: Nat). Sing t -> Sing (Apply Foo6Sym0 t :: Nat) sFoo5 :: forall (t :: Nat). Sing t -> Sing (Apply Foo5Sym0 t :: Nat) sFoo4 :: forall (t :: Nat). Sing t -> Sing (Apply Foo4Sym0 t :: Nat) sFoo3 :: forall (t :: Nat). Sing t -> Sing (Apply Foo3Sym0 t :: Nat) sFoo2 :: Sing (Foo2Sym0 :: Nat) sFoo1 :: forall (t :: Nat). Sing t -> Sing (Apply Foo1Sym0 t :: Nat) sFoo14 (sX :: Sing x) = let sY :: Sing (Let0123456789876543210YSym1 x) sZ :: Sing (Let0123456789876543210ZSym1 x) sX_0123456789876543210 :: Sing (Let0123456789876543210X_0123456789876543210Sym1 x) sY = (case sX_0123456789876543210 of { STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) sZ = (case sX_0123456789876543210 of { STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 x (Let0123456789876543210X_0123456789876543210Sym1 x)) sX_0123456789876543210 = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) ((applySing ((singFun1 @SuccSym0) SSucc)) sX))) sX in (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sZ)) sY sFoo13_ (sY :: Sing y) = sY sFoo13 (sX :: Sing x) = let sBar :: Sing (Let0123456789876543210BarSym1 x :: a) sBar = sX in (applySing ((singFun1 @Foo13_Sym0) sFoo13_)) sBar sFoo12 (sX :: Sing x) = let (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) (%+) SZero (sM :: Sing m) = sM (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) sN)) sX) in (applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) sX)) ((applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)) sFoo11 (sX :: Sing x) = let sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) sZ = sX (%+) SZero (sM :: Sing m) = sM (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) sN)) sM) in (applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) sZ sFoo10 (sX :: Sing x) = let (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x) t) t :: Nat) (%+) SZero (sM :: Sing m) = sM (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) sN)) sM) in (applySing ((applySing ((singFun2 @((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) x)) (%+))) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) sX sFoo9 (sX :: Sing x) = let sZ :: forall (t :: Nat). Sing t -> Sing (Apply (Let0123456789876543210ZSym1 x) t :: Nat) sZ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) (\ sX -> case sX of { (_ :: Sing x) -> sX }))) sA_0123456789876543210 in (applySing ((singFun1 @(Let0123456789876543210ZSym1 x)) sZ)) sX sFoo8 (sX :: Sing x) = let sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) sZ = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sX -> case sX of { (_ :: Sing x) -> sX }))) SZero in sZ sFoo7 (sX :: Sing x) = let sX :: Sing (Let0123456789876543210XSym1 x :: Nat) sX = SZero in sX sFoo6 (sX :: Sing x) = let sF :: forall (t :: Nat). Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in let sZ :: Sing (Let0123456789876543210ZSym1 x :: Nat) sZ = (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX in sZ sFoo5 (sX :: Sing x) = let sF :: forall (t :: Nat). Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) sF (sY :: Sing y) = let sZ :: Sing (Let0123456789876543210ZSym2 x y :: Nat) sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY in (applySing ((singFun1 @SuccSym0) SSucc)) sZ in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX sFoo4 (sX :: Sing x) = let sF :: forall (t :: Nat). Sing t -> Sing (Apply (Let0123456789876543210FSym1 x) t :: Nat) sF (sY :: Sing y) = (applySing ((singFun1 @SuccSym0) SSucc)) sY in (applySing ((singFun1 @(Let0123456789876543210FSym1 x)) sF)) sX sFoo3 (sX :: Sing x) = let sY :: Sing (Let0123456789876543210YSym1 x :: Nat) sY = (applySing ((singFun1 @SuccSym0) SSucc)) sX in sY sFoo2 = let sY :: Sing Let0123456789876543210YSym0 sZ :: Sing Let0123456789876543210ZSym0 sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero sZ = (applySing ((singFun1 @SuccSym0) SSucc)) sY in sZ sFoo1 (sX :: Sing x) = let sY :: Sing (Let0123456789876543210YSym1 x :: Nat) sY = (applySing ((singFun1 @SuccSym0) SSucc)) SZero in sY instance SingI (Foo14Sym0 :: (~>) Nat (Nat, Nat)) where sing = (singFun1 @Foo14Sym0) sFoo14 instance SingI (Foo13_Sym0 :: (~>) a a) where sing = (singFun1 @Foo13_Sym0) sFoo13_ instance SingI (Foo13Sym0 :: (~>) a a) where sing = (singFun1 @Foo13Sym0) sFoo13 instance SingI (Foo12Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo12Sym0) sFoo12 instance SingI (Foo11Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo11Sym0) sFoo11 instance SingI (Foo10Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo10Sym0) sFoo10 instance SingI (Foo9Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo9Sym0) sFoo9 instance SingI (Foo8Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo8Sym0) sFoo8 instance SingI (Foo7Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo7Sym0) sFoo7 instance SingI (Foo6Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo6Sym0) sFoo6 instance SingI (Foo5Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo5Sym0) sFoo5 instance SingI (Foo4Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo4Sym0) sFoo4 instance SingI (Foo3Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo3Sym0) sFoo3 instance SingI (Foo1Sym0 :: (~>) Nat Nat) where sing = (singFun1 @Foo1Sym0) sFoo1 singletons-2.5.1/tests/compile-and-dump/Singletons/LetStatements.hs0000755000000000000000000001023607346545000023654 0ustar0000000000000000{-# OPTIONS_GHC -Wno-unused-binds -Wno-unused-matches -Wno-name-shadowing #-} module Singletons.LetStatements where import Data.Singletons import Data.Singletons.Prelude import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Singletons.Nat $(singletons [d| -- type signature required for a constant foo1 :: Nat -> Nat foo1 x = let y :: Nat y = Succ Zero in y -- nothing in scope, no type signatures required foo2 :: Nat foo2 = let y = Succ Zero z = Succ y in z -- using in-scope variable foo3 :: Nat -> Nat foo3 x = let y :: Nat y = Succ x in y -- passing in-scope variable to a function. Tests also adding in-scope binders -- at the call site of f foo4 :: Nat -> Nat foo4 x = let f :: Nat -> Nat f y = Succ y in f x -- nested lets, version 1. This could potentially be problematic. foo5 :: Nat -> Nat foo5 x = let f :: Nat -> Nat f y = let z :: Nat z = Succ y in Succ z in f x -- nested lets, version 2. This shouldn't cause any problems, so that's just a -- sanity check. foo6 :: Nat -> Nat foo6 x = let f :: Nat -> Nat f y = Succ y in let z :: Nat z = f x in z -- name shadowing foo7 :: Nat -> Nat foo7 x = let x :: Nat x = Zero in x -- lambda binder in let shadows pattern-bound variable foo8 :: Nat -> Nat foo8 x = let z :: Nat z = (\x -> x) Zero in z -- let-declaring lambdas foo9 :: Nat -> Nat foo9 x = let z :: Nat -> Nat z = (\x -> x) in z x -- infix declaration foo10 :: Nat -> Nat foo10 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) in (Succ Zero) + x -- infix call uses let-bound binder foo11 :: Nat -> Nat foo11 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) z :: Nat z = x in (Succ Zero) + z -- infix let-declaration uses in-scope variable foo12 :: Nat -> Nat foo12 x = let (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + x) in x + (Succ (Succ Zero)) -- make sure that calls to functions declared outside of let don't receive -- extra parameters with in-scope bindings. See #18. foo13 :: forall a. a -> a foo13 x = let bar :: a bar = x in foo13_ bar foo13_ :: a -> a foo13_ y = y -- tuple patterns in let statements. See #20 foo14 :: Nat -> (Nat, Nat) foo14 x = let (y, z) = (Succ x, x) in (z, y) |]) foo1a :: Proxy (Foo1 Zero) foo1a = Proxy foo1b :: Proxy (Succ Zero) foo1b = foo1a foo2a :: Proxy Foo2 foo2a = Proxy foo2b :: Proxy (Succ (Succ Zero)) foo2b = foo2a foo3a :: Proxy (Foo3 (Succ Zero)) foo3a = Proxy foo3b :: Proxy (Succ (Succ Zero)) foo3b = foo3a foo4a :: Proxy (Foo4 (Succ Zero)) foo4a = Proxy foo4b :: Proxy (Succ (Succ Zero)) foo4b = foo4a foo5a :: Proxy (Foo5 Zero) foo5a = Proxy foo5b :: Proxy (Succ (Succ Zero)) foo5b = foo5a foo6a :: Proxy (Foo6 Zero) foo6a = Proxy foo6b :: Proxy (Succ Zero) foo6b = foo6a foo7a :: Proxy (Foo7 (Succ (Succ Zero))) foo7a = Proxy foo7b :: Proxy Zero foo7b = foo7a foo8a :: Proxy (Foo8 (Succ (Succ Zero))) foo8a = Proxy foo8b :: Proxy Zero foo8b = foo8a foo9a :: Proxy (Foo9 (Succ (Succ Zero))) foo9a = Proxy foo9b :: Proxy (Succ (Succ Zero)) foo9b = foo9a foo10a :: Proxy (Foo10 (Succ (Succ Zero))) foo10a = Proxy foo10b :: Proxy (Succ (Succ (Succ Zero))) foo10b = foo10a foo11a :: Proxy (Foo11 (Succ (Succ Zero))) foo11a = Proxy foo11b :: Proxy (Succ (Succ (Succ Zero))) foo11b = foo11a foo12a :: Proxy (Foo12 (Succ (Succ (Succ Zero)))) foo12a = Proxy foo12b :: Proxy (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))) foo12b = foo12a foo13a :: Proxy (Foo13 Zero) foo13a = Proxy foo13b :: Proxy Zero foo13b = foo13a foo14a :: Proxy (Foo14 Zero) foo14a = Proxy foo14b :: Proxy '(Zero, Succ Zero) foo14b = foo14a singletons-2.5.1/tests/compile-and-dump/Singletons/Maybe.ghc86.template0000755000000000000000000002173307346545000024240 0ustar0000000000000000Singletons/Maybe.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Maybe a = Nothing | Just a deriving (Eq, Show) |] ======> data Maybe a = Nothing | Just a deriving (Eq, Show) type NothingSym0 = Nothing type JustSym1 (t0123456789876543210 :: a0123456789876543210) = Just t0123456789876543210 instance SuppressUnusedWarnings JustSym0 where suppressUnusedWarnings = snd (((,) JustSym0KindInference) ()) data JustSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 (Maybe a0123456789876543210) where JustSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) => JustSym0 t0123456789876543210 type instance Apply JustSym0 t0123456789876543210 = Just t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Maybe a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ Nothing a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nothing") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Just arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Just ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) GHC.Types.Nat ((~>) (Maybe a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (Maybe a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: Maybe a) (b :: Maybe a) :: Bool where Equals_0123456789876543210 Nothing Nothing = TrueSym0 Equals_0123456789876543210 (Just a) (Just b) = (==) a b Equals_0123456789876543210 (_ :: Maybe a) (_ :: Maybe a) = FalseSym0 instance PEq (Maybe a) where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: Maybe a -> GHC.Types.Type where SNothing :: Sing Nothing SJust :: forall a (n :: a). (Sing (n :: a)) -> Sing (Just n) type SMaybe = (Sing :: Maybe a -> GHC.Types.Type) instance SingKind a => SingKind (Maybe a) where type Demote (Maybe a) = Maybe (Demote a) fromSing SNothing = Nothing fromSing (SJust b) = Just (fromSing b) toSing Nothing = SomeSing SNothing toSing (Just (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SJust c) } instance SShow a => SShow (Maybe a) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Maybe a) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Maybe a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ SNothing (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Nothing"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SJust (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Just ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))) sA_0123456789876543210 instance SEq a => SEq (Maybe a) where (%==) SNothing SNothing = STrue (%==) SNothing (SJust _) = SFalse (%==) (SJust _) SNothing = SFalse (%==) (SJust a) (SJust b) = ((%==) a) b instance SDecide a => SDecide (Maybe a) where (%~) SNothing SNothing = Proved Refl (%~) SNothing (SJust _) = Disproved (\ x -> case x of) (%~) (SJust _) SNothing = Disproved (\ x -> case x of) (%~) (SJust a) (SJust b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) deriving instance Data.Singletons.ShowSing.ShowSing a => Show (Sing (z :: Maybe a)) instance SingI Nothing where sing = SNothing instance SingI n => SingI (Just (n :: a)) where sing = SJust sing instance SingI (JustSym0 :: (~>) a (Maybe a)) where sing = (singFun1 @JustSym0) SJust instance SingI (TyCon1 Just :: (~>) a (Maybe a)) where sing = (singFun1 @(TyCon1 Just)) SJust singletons-2.5.1/tests/compile-and-dump/Singletons/Maybe.hs0000755000000000000000000000020607346545000022111 0ustar0000000000000000module Singletons.Maybe where import Data.Singletons.TH $(singletons [d| data Maybe a = Nothing | Just a deriving (Eq, Show) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Nat.ghc86.template0000755000000000000000000003676307346545000023736 0ustar0000000000000000Singletons/Nat.hs:(0,0)-(0,0): Splicing declarations singletons [d| plus :: Nat -> Nat -> Nat plus Zero m = m plus (Succ n) m = Succ (plus n m) pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n data Nat where Zero :: Nat Succ :: Nat -> Nat deriving (Eq, Show, Read, Ord) |] ======> data Nat where Zero :: Nat Succ :: Nat -> Nat deriving (Eq, Show, Read, Ord) plus :: Nat -> Nat -> Nat plus Zero m = m plus (Succ n) m = Succ ((plus n) m) pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n type ZeroSym0 = Zero type SuccSym1 (t0123456789876543210 :: Nat) = Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat where SuccSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 type PredSym1 (a0123456789876543210 :: Nat) = Pred a0123456789876543210 instance SuppressUnusedWarnings PredSym0 where suppressUnusedWarnings = snd (((,) PredSym0KindInference) ()) data PredSym0 :: (~>) Nat Nat where PredSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) => PredSym0 a0123456789876543210 type instance Apply PredSym0 a0123456789876543210 = Pred a0123456789876543210 type PlusSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Plus a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (PlusSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) PlusSym1KindInference) ()) data PlusSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where PlusSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (PlusSym1 a0123456789876543210) arg) (PlusSym2 a0123456789876543210 arg) => PlusSym1 a0123456789876543210 a0123456789876543210 type instance Apply (PlusSym1 a0123456789876543210) a0123456789876543210 = Plus a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings PlusSym0 where suppressUnusedWarnings = snd (((,) PlusSym0KindInference) ()) data PlusSym0 :: (~>) Nat ((~>) Nat Nat) where PlusSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) => PlusSym0 a0123456789876543210 type instance Apply PlusSym0 a0123456789876543210 = PlusSym1 a0123456789876543210 type family Pred (a :: Nat) :: Nat where Pred Zero = ZeroSym0 Pred (Succ n) = n type family Plus (a :: Nat) (a :: Nat) :: Nat where Plus Zero m = m Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Nat) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ Zero a_0123456789876543210 = Apply (Apply ShowStringSym0 "Zero") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Succ arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Succ ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Nat) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Nat where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where Equals_0123456789876543210 Zero Zero = TrueSym0 Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 instance PEq Nat where type (==) a b = Equals_0123456789876543210 a b sPred :: forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat) sPlus :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat) sPred SZero = SZero sPred (SSucc (sN :: Sing n)) = sN sPlus SZero (sM :: Sing m) = sM sPlus (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @PlusSym0) sPlus)) sN)) sM) instance SingI (PredSym0 :: (~>) Nat Nat) where sing = (singFun1 @PredSym0) sPred instance SingI (PlusSym0 :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @PlusSym0) sPlus instance SingI d => SingI (PlusSym1 (d :: Nat) :: (~>) Nat Nat) where sing = (singFun1 @(PlusSym1 (d :: Nat))) (sPlus (sing @d)) data instance Sing :: Nat -> GHC.Types.Type where SZero :: Sing Zero SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) type SNat = (Sing :: Nat -> GHC.Types.Type) instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero fromSing (SSucc b) = Succ (fromSing b) toSing Zero = SomeSing SZero toSing (Succ (b :: Demote Nat)) = case toSing b :: SomeSing Nat of { SomeSing c -> SomeSing (SSucc c) } instance SShow Nat => SShow Nat where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Nat) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Nat ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ SZero (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Zero"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SSucc (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Succ ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))) sA_0123456789876543210 instance SOrd Nat => SOrd Nat where sCompare :: forall (t1 :: Nat) (t2 :: Nat). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) -> GHC.Types.Type) t1) t2) sCompare SZero SZero = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) Data.Singletons.Prelude.Instances.SNil sCompare (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) Data.Singletons.Prelude.Instances.SNil) sCompare SZero (SSucc _) = SLT sCompare (SSucc _) SZero = SGT instance SEq Nat => SEq Nat where (%==) SZero SZero = STrue (%==) SZero (SSucc _) = SFalse (%==) (SSucc _) SZero = SFalse (%==) (SSucc a) (SSucc b) = ((%==) a) b instance SDecide Nat => SDecide Nat where (%~) SZero SZero = Proved Refl (%~) SZero (SSucc _) = Disproved (\ x -> case x of) (%~) (SSucc _) SZero = Disproved (\ x -> case x of) (%~) (SSucc a) (SSucc b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) deriving instance Data.Singletons.ShowSing.ShowSing Nat => Show (Sing (z :: Nat)) instance SingI Zero where sing = SZero instance SingI n => SingI (Succ (n :: Nat)) where sing = SSucc sing instance SingI (SuccSym0 :: (~>) Nat Nat) where sing = (singFun1 @SuccSym0) SSucc instance SingI (TyCon1 Succ :: (~>) Nat Nat) where sing = (singFun1 @(TyCon1 Succ)) SSucc singletons-2.5.1/tests/compile-and-dump/Singletons/Nat.hs0000755000000000000000000000047307346545000021604 0ustar0000000000000000module Singletons.Nat where import Data.Singletons.TH $(singletons [d| data Nat where Zero :: Nat Succ :: Nat -> Nat deriving (Eq, Show, Read, Ord) plus :: Nat -> Nat -> Nat plus Zero m = m plus (Succ n) m = Succ (plus n m) pred :: Nat -> Nat pred Zero = Zero pred (Succ n) = n |]) singletons-2.5.1/tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template0000755000000000000000000000000007346545000026745 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/NatSymbolReflexive.hs0000755000000000000000000000041507346545000024640 0ustar0000000000000000module NatSymbolReflexive where import Data.Singletons.Prelude import Data.Type.Equality ((:~:)(..)) import GHC.TypeLits test1 :: forall (a :: Nat). Sing a -> (a == a) :~: True test1 _ = Refl test2 :: forall (a :: Symbol). Sing a -> (a == a) :~: True test2 _ = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/Operators.ghc86.template0000755000000000000000000001400207346545000025150 0ustar0000000000000000Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations singletons [d| child :: Foo -> Foo child FLeaf = FLeaf child (a :+: _) = a (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) data Foo where FLeaf :: Foo (:+:) :: Foo -> Foo -> Foo |] ======> data Foo where FLeaf :: Foo (:+:) :: Foo -> Foo -> Foo child :: Foo -> Foo child FLeaf = FLeaf child (a :+: _) = a (+) :: Nat -> Nat -> Nat (+) Zero m = m (+) (Succ n) m = Succ (n + m) type FLeafSym0 = FLeaf type (:+:@#@$$$) (t0123456789876543210 :: Foo) (t0123456789876543210 :: Foo) = (:+:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:+:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::+:@#@$$###)) ()) data (:+:@#@$$) (t0123456789876543210 :: Foo) :: (~>) Foo Foo where (::+:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:+:@#@$$) t0123456789876543210) arg) ((:+:@#@$$$) t0123456789876543210 arg) => (:+:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:+:@#@$$) t0123456789876543210) t0123456789876543210 = (:+:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (:+:@#@$) where suppressUnusedWarnings = snd (((,) (::+:@#@$###)) ()) data (:+:@#@$) :: (~>) Foo ((~>) Foo Foo) where (::+:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) => (:+:@#@$) t0123456789876543210 type instance Apply (:+:@#@$) t0123456789876543210 = (:+:@#@$$) t0123456789876543210 type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:+@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => (+@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (+@#@$) where suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) data (+@#@$) :: (~>) Nat ((~>) Nat Nat) where (:+@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => (+@#@$) a0123456789876543210 type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 type ChildSym1 (a0123456789876543210 :: Foo) = Child a0123456789876543210 instance SuppressUnusedWarnings ChildSym0 where suppressUnusedWarnings = snd (((,) ChildSym0KindInference) ()) data ChildSym0 :: (~>) Foo Foo where ChildSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) => ChildSym0 a0123456789876543210 type instance Apply ChildSym0 a0123456789876543210 = Child a0123456789876543210 type family (+) (a :: Nat) (a :: Nat) :: Nat where (+) 'Zero m = m (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) type family Child (a :: Foo) :: Foo where Child FLeaf = FLeafSym0 Child ((:+:) a _) = a (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) sChild :: forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo) (%+) SZero (sM :: Sing m) = sM (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) sChild SFLeaf = SFLeaf sChild ((:%+:) (sA :: Sing a) _) = sA instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @(+@#@$)) (%+) instance SingI d => SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d)) instance SingI (ChildSym0 :: (~>) Foo Foo) where sing = (singFun1 @ChildSym0) sChild data instance Sing :: Foo -> GHC.Types.Type where SFLeaf :: Sing FLeaf (:%+:) :: forall (n :: Foo) (n :: Foo). (Sing (n :: Foo)) -> (Sing (n :: Foo)) -> Sing ((:+:) n n) type SFoo = (Sing :: Foo -> GHC.Types.Type) instance SingKind Foo where type Demote Foo = Foo fromSing SFLeaf = FLeaf fromSing ((:%+:) b b) = ((:+:) (fromSing b)) (fromSing b) toSing FLeaf = SomeSing SFLeaf toSing ((:+:) (b :: Demote Foo) (b :: Demote Foo)) = case ((,) (toSing b :: SomeSing Foo)) (toSing b :: SomeSing Foo) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%+:) c) c) } instance SingI FLeaf where sing = SFLeaf instance (SingI n, SingI n) => SingI ((:+:) (n :: Foo) (n :: Foo)) where sing = ((:%+:) sing) sing instance SingI ((:+:@#@$) :: (~>) Foo ((~>) Foo Foo)) where sing = (singFun2 @(:+:@#@$)) (:%+:) instance SingI (TyCon2 (:+:) :: (~>) Foo ((~>) Foo Foo)) where sing = (singFun2 @(TyCon2 (:+:))) (:%+:) instance SingI d => SingI ((:+:@#@$$) (d :: Foo) :: (~>) Foo Foo) where sing = (singFun1 @((:+:@#@$$) (d :: Foo))) ((:%+:) (sing @d)) instance SingI d => SingI (TyCon1 ((:+:) (d :: Foo)) :: (~>) Foo Foo) where sing = (singFun1 @(TyCon1 ((:+:) (d :: Foo)))) ((:%+:) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Operators.hs0000755000000000000000000000057407346545000023042 0ustar0000000000000000module Singletons.Operators where import Data.Singletons import Data.Singletons.TH import Singletons.Nat import Data.Singletons.SuppressUnusedWarnings $(singletons [d| data Foo where FLeaf :: Foo (:+:) :: Foo -> Foo -> Foo child :: Foo -> Foo child FLeaf = FLeaf child (a :+: _) = a (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template0000755000000000000000000024312607346545000025421 0ustar0000000000000000Singletons/OrdDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Nat = Zero | Succ Nat deriving (Eq, Ord) data Foo a b c d = A a b c d | B a b c d | C a b c d | D a b c d | E a b c d | F a b c d deriving (Eq, Ord) |] ======> data Nat = Zero | Succ Nat deriving (Eq, Ord) data Foo a b c d = A a b c d | B a b c d | C a b c d | D a b c d | E a b c d | F a b c d deriving (Eq, Ord) type ZeroSym0 = Zero type SuccSym1 (t0123456789876543210 :: Nat) = Succ t0123456789876543210 instance SuppressUnusedWarnings SuccSym0 where suppressUnusedWarnings = snd (((,) SuccSym0KindInference) ()) data SuccSym0 :: (~>) Nat Nat where SuccSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) => SuccSym0 t0123456789876543210 type instance Apply SuccSym0 t0123456789876543210 = Succ t0123456789876543210 type ASym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ASym3KindInference) ()) data ASym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where ASym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ASym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = A t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ASym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ASym2KindInference) ()) data ASym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where ASym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ASym2 t0123456789876543210 t0123456789876543210) arg) (ASym3 t0123456789876543210 t0123456789876543210 arg) => ASym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ASym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ASym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ASym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ASym1KindInference) ()) data ASym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where ASym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ASym1 t0123456789876543210) arg) (ASym2 t0123456789876543210 arg) => ASym1 t0123456789876543210 t0123456789876543210 type instance Apply (ASym1 t0123456789876543210) t0123456789876543210 = ASym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ASym0 where suppressUnusedWarnings = snd (((,) ASym0KindInference) ()) data ASym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where ASym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply ASym0 arg) (ASym1 arg) => ASym0 t0123456789876543210 type instance Apply ASym0 t0123456789876543210 = ASym1 t0123456789876543210 type BSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BSym3KindInference) ()) data BSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where BSym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (BSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = B t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BSym2KindInference) ()) data BSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where BSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BSym2 t0123456789876543210 t0123456789876543210) arg) (BSym3 t0123456789876543210 t0123456789876543210 arg) => BSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (BSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = BSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) BSym1KindInference) ()) data BSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where BSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BSym1 t0123456789876543210) arg) (BSym2 t0123456789876543210 arg) => BSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BSym1 t0123456789876543210) t0123456789876543210 = BSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings BSym0 where suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) data BSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where BSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply BSym0 arg) (BSym1 arg) => BSym0 t0123456789876543210 type instance Apply BSym0 t0123456789876543210 = BSym1 t0123456789876543210 type CSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) CSym3KindInference) ()) data CSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where CSym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (CSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = C t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (CSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) CSym2KindInference) ()) data CSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where CSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (CSym2 t0123456789876543210 t0123456789876543210) arg) (CSym3 t0123456789876543210 t0123456789876543210 arg) => CSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (CSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = CSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (CSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) CSym1KindInference) ()) data CSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where CSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (CSym1 t0123456789876543210) arg) (CSym2 t0123456789876543210 arg) => CSym1 t0123456789876543210 t0123456789876543210 type instance Apply (CSym1 t0123456789876543210) t0123456789876543210 = CSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings CSym0 where suppressUnusedWarnings = snd (((,) CSym0KindInference) ()) data CSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where CSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply CSym0 arg) (CSym1 arg) => CSym0 t0123456789876543210 type instance Apply CSym0 t0123456789876543210 = CSym1 t0123456789876543210 type DSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) DSym3KindInference) ()) data DSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where DSym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (DSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = D t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (DSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) DSym2KindInference) ()) data DSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where DSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (DSym2 t0123456789876543210 t0123456789876543210) arg) (DSym3 t0123456789876543210 t0123456789876543210 arg) => DSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (DSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = DSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (DSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) DSym1KindInference) ()) data DSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where DSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (DSym1 t0123456789876543210) arg) (DSym2 t0123456789876543210 arg) => DSym1 t0123456789876543210 t0123456789876543210 type instance Apply (DSym1 t0123456789876543210) t0123456789876543210 = DSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings DSym0 where suppressUnusedWarnings = snd (((,) DSym0KindInference) ()) data DSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where DSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply DSym0 arg) (DSym1 arg) => DSym0 t0123456789876543210 type instance Apply DSym0 t0123456789876543210 = DSym1 t0123456789876543210 type ESym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ESym3KindInference) ()) data ESym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where ESym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (ESym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = E t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ESym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ESym2KindInference) ()) data ESym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where ESym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ESym2 t0123456789876543210 t0123456789876543210) arg) (ESym3 t0123456789876543210 t0123456789876543210 arg) => ESym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (ESym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = ESym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (ESym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) ESym1KindInference) ()) data ESym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where ESym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (ESym1 t0123456789876543210) arg) (ESym2 t0123456789876543210 arg) => ESym1 t0123456789876543210 t0123456789876543210 type instance Apply (ESym1 t0123456789876543210) t0123456789876543210 = ESym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ESym0 where suppressUnusedWarnings = snd (((,) ESym0KindInference) ()) data ESym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where ESym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply ESym0 arg) (ESym1 arg) => ESym0 t0123456789876543210 type instance Apply ESym0 t0123456789876543210 = ESym1 t0123456789876543210 type FSym4 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) (t0123456789876543210 :: d0123456789876543210) = F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FSym3KindInference) ()) data FSym3 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) (t0123456789876543210 :: c0123456789876543210) :: forall d0123456789876543210. (~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) where FSym3KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) arg) (FSym4 t0123456789876543210 t0123456789876543210 t0123456789876543210 arg) => FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210) t0123456789876543210 = F t0123456789876543210 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FSym2 t0123456789876543210 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FSym2KindInference) ()) data FSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210 d0123456789876543210. (~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)) where FSym2KindInference :: forall t0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (FSym2 t0123456789876543210 t0123456789876543210) arg) (FSym3 t0123456789876543210 t0123456789876543210 arg) => FSym2 t0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (FSym2 t0123456789876543210 t0123456789876543210) t0123456789876543210 = FSym3 t0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FSym1KindInference) ()) data FSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))) where FSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (FSym1 t0123456789876543210) arg) (FSym2 t0123456789876543210 arg) => FSym1 t0123456789876543210 t0123456789876543210 type instance Apply (FSym1 t0123456789876543210) t0123456789876543210 = FSym2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 ((~>) d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)))) where FSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 t0123456789876543210 type instance Apply FSym0 t0123456789876543210 = FSym1 t0123456789876543210 type family Compare_0123456789876543210 (a :: Nat) (a :: Nat) :: Ordering where Compare_0123456789876543210 Zero Zero = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Succ a_0123456789876543210) (Succ b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 Zero (Succ _) = LTSym0 Compare_0123456789876543210 (Succ _) Zero = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Nat Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Nat ((~>) Nat Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Nat where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Compare_0123456789876543210 (a :: Foo a b c d) (a :: Foo a b c d) :: Ordering where Compare_0123456789876543210 (A a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (A b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (B a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (B b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (C a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (C b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (D a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (D b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (E a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (E b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (F a_0123456789876543210 a_0123456789876543210 a_0123456789876543210 a_0123456789876543210) (F b_0123456789876543210 b_0123456789876543210 b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])))) Compare_0123456789876543210 (A _ _ _ _) (B _ _ _ _) = LTSym0 Compare_0123456789876543210 (A _ _ _ _) (C _ _ _ _) = LTSym0 Compare_0123456789876543210 (A _ _ _ _) (D _ _ _ _) = LTSym0 Compare_0123456789876543210 (A _ _ _ _) (E _ _ _ _) = LTSym0 Compare_0123456789876543210 (A _ _ _ _) (F _ _ _ _) = LTSym0 Compare_0123456789876543210 (B _ _ _ _) (A _ _ _ _) = GTSym0 Compare_0123456789876543210 (B _ _ _ _) (C _ _ _ _) = LTSym0 Compare_0123456789876543210 (B _ _ _ _) (D _ _ _ _) = LTSym0 Compare_0123456789876543210 (B _ _ _ _) (E _ _ _ _) = LTSym0 Compare_0123456789876543210 (B _ _ _ _) (F _ _ _ _) = LTSym0 Compare_0123456789876543210 (C _ _ _ _) (A _ _ _ _) = GTSym0 Compare_0123456789876543210 (C _ _ _ _) (B _ _ _ _) = GTSym0 Compare_0123456789876543210 (C _ _ _ _) (D _ _ _ _) = LTSym0 Compare_0123456789876543210 (C _ _ _ _) (E _ _ _ _) = LTSym0 Compare_0123456789876543210 (C _ _ _ _) (F _ _ _ _) = LTSym0 Compare_0123456789876543210 (D _ _ _ _) (A _ _ _ _) = GTSym0 Compare_0123456789876543210 (D _ _ _ _) (B _ _ _ _) = GTSym0 Compare_0123456789876543210 (D _ _ _ _) (C _ _ _ _) = GTSym0 Compare_0123456789876543210 (D _ _ _ _) (E _ _ _ _) = LTSym0 Compare_0123456789876543210 (D _ _ _ _) (F _ _ _ _) = LTSym0 Compare_0123456789876543210 (E _ _ _ _) (A _ _ _ _) = GTSym0 Compare_0123456789876543210 (E _ _ _ _) (B _ _ _ _) = GTSym0 Compare_0123456789876543210 (E _ _ _ _) (C _ _ _ _) = GTSym0 Compare_0123456789876543210 (E _ _ _ _) (D _ _ _ _) = GTSym0 Compare_0123456789876543210 (E _ _ _ _) (F _ _ _ _) = LTSym0 Compare_0123456789876543210 (F _ _ _ _) (A _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (B _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (C _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (D _ _ _ _) = GTSym0 Compare_0123456789876543210 (F _ _ _ _) (E _ _ _ _) = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) :: (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210. (~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) ((~>) (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd (Foo a b c d) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Nat) (b :: Nat) :: Bool where Equals_0123456789876543210 Zero Zero = TrueSym0 Equals_0123456789876543210 (Succ a) (Succ b) = (==) a b Equals_0123456789876543210 (_ :: Nat) (_ :: Nat) = FalseSym0 instance PEq Nat where type (==) a b = Equals_0123456789876543210 a b type family Equals_0123456789876543210 (a :: Foo a b c d) (b :: Foo a b c d) :: Bool where Equals_0123456789876543210 (A a a a a) (A b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (B a a a a) (B b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (C a a a a) (C b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (D a a a a) (D b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (E a a a a) (E b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (F a a a a) (F b b b b) = (&&) ((==) a b) ((&&) ((==) a b) ((&&) ((==) a b) ((==) a b))) Equals_0123456789876543210 (_ :: Foo a b c d) (_ :: Foo a b c d) = FalseSym0 instance PEq (Foo a b c d) where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: Nat -> GHC.Types.Type where SZero :: Sing Zero SSucc :: forall (n :: Nat). (Sing (n :: Nat)) -> Sing (Succ n) type SNat = (Sing :: Nat -> GHC.Types.Type) instance SingKind Nat where type Demote Nat = Nat fromSing SZero = Zero fromSing (SSucc b) = Succ (fromSing b) toSing Zero = SomeSing SZero toSing (Succ (b :: Demote Nat)) = case toSing b :: SomeSing Nat of { SomeSing c -> SomeSing (SSucc c) } data instance Sing :: Foo a b c d -> GHC.Types.Type where SA :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (A n n n n) SB :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (B n n n n) SC :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (C n n n n) SD :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (D n n n n) SE :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (E n n n n) SF :: forall a b c d (n :: a) (n :: b) (n :: c) (n :: d). (Sing (n :: a)) -> (Sing (n :: b)) -> (Sing (n :: c)) -> (Sing (n :: d)) -> Sing (F n n n n) type SFoo = (Sing :: Foo a b c d -> GHC.Types.Type) instance (SingKind a, SingKind b, SingKind c, SingKind d) => SingKind (Foo a b c d) where type Demote (Foo a b c d) = Foo (Demote a) (Demote b) (Demote c) (Demote d) fromSing (SA b b b b) = (((A (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SB b b b b) = (((B (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SC b b b b) = (((C (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SD b b b b) = (((D (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SE b b b b) = (((E (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) fromSing (SF b b b b) = (((F (fromSing b)) (fromSing b)) (fromSing b)) (fromSing b) toSing (A (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SA c) c) c) c) } toSing (B (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SB c) c) c) c) } toSing (C (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SC c) c) c) c) } toSing (D (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SD c) c) c) c) } toSing (E (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SE c) c) c) c) } toSing (F (b :: Demote a) (b :: Demote b) (b :: Demote c) (b :: Demote d)) = case ((((,,,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)) (toSing b :: SomeSing c)) (toSing b :: SomeSing d) of { (,,,) (SomeSing c) (SomeSing c) (SomeSing c) (SomeSing c) -> SomeSing ((((SF c) c) c) c) } instance SOrd Nat => SOrd Nat where sCompare :: forall (t1 :: Nat) (t2 :: Nat). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Nat ((~>) Nat Ordering) -> GHC.Types.Type) t1) t2) sCompare SZero SZero = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare (SSucc (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SSucc (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil) sCompare SZero (SSucc _) = SLT sCompare (SSucc _) SZero = SGT instance (SOrd a, SOrd b, SOrd c, SOrd d) => SOrd (Foo a b c d) where sCompare :: forall (t1 :: Foo a b c d) (t2 :: Foo a b c d). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun (Foo a b c d) ((~>) (Foo a b c d) Ordering) -> GHC.Types.Type) t1) t2) sCompare (SA (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SA (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SB (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SB (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SC (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SC (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SD (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SD (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SE (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SE (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SF (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SF (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)))) sCompare (SA _ _ _ _) (SB _ _ _ _) = SLT sCompare (SA _ _ _ _) (SC _ _ _ _) = SLT sCompare (SA _ _ _ _) (SD _ _ _ _) = SLT sCompare (SA _ _ _ _) (SE _ _ _ _) = SLT sCompare (SA _ _ _ _) (SF _ _ _ _) = SLT sCompare (SB _ _ _ _) (SA _ _ _ _) = SGT sCompare (SB _ _ _ _) (SC _ _ _ _) = SLT sCompare (SB _ _ _ _) (SD _ _ _ _) = SLT sCompare (SB _ _ _ _) (SE _ _ _ _) = SLT sCompare (SB _ _ _ _) (SF _ _ _ _) = SLT sCompare (SC _ _ _ _) (SA _ _ _ _) = SGT sCompare (SC _ _ _ _) (SB _ _ _ _) = SGT sCompare (SC _ _ _ _) (SD _ _ _ _) = SLT sCompare (SC _ _ _ _) (SE _ _ _ _) = SLT sCompare (SC _ _ _ _) (SF _ _ _ _) = SLT sCompare (SD _ _ _ _) (SA _ _ _ _) = SGT sCompare (SD _ _ _ _) (SB _ _ _ _) = SGT sCompare (SD _ _ _ _) (SC _ _ _ _) = SGT sCompare (SD _ _ _ _) (SE _ _ _ _) = SLT sCompare (SD _ _ _ _) (SF _ _ _ _) = SLT sCompare (SE _ _ _ _) (SA _ _ _ _) = SGT sCompare (SE _ _ _ _) (SB _ _ _ _) = SGT sCompare (SE _ _ _ _) (SC _ _ _ _) = SGT sCompare (SE _ _ _ _) (SD _ _ _ _) = SGT sCompare (SE _ _ _ _) (SF _ _ _ _) = SLT sCompare (SF _ _ _ _) (SA _ _ _ _) = SGT sCompare (SF _ _ _ _) (SB _ _ _ _) = SGT sCompare (SF _ _ _ _) (SC _ _ _ _) = SGT sCompare (SF _ _ _ _) (SD _ _ _ _) = SGT sCompare (SF _ _ _ _) (SE _ _ _ _) = SGT instance SEq Nat => SEq Nat where (%==) SZero SZero = STrue (%==) SZero (SSucc _) = SFalse (%==) (SSucc _) SZero = SFalse (%==) (SSucc a) (SSucc b) = ((%==) a) b instance SDecide Nat => SDecide Nat where (%~) SZero SZero = Proved Refl (%~) SZero (SSucc _) = Disproved (\ x -> case x of) (%~) (SSucc _) SZero = Disproved (\ x -> case x of) (%~) (SSucc a) (SSucc b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance (SEq a, SEq b, SEq c, SEq d) => SEq (Foo a b c d) where (%==) (SA a a a a) (SA b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) (%==) (SA _ _ _ _) (SB _ _ _ _) = SFalse (%==) (SA _ _ _ _) (SC _ _ _ _) = SFalse (%==) (SA _ _ _ _) (SD _ _ _ _) = SFalse (%==) (SA _ _ _ _) (SE _ _ _ _) = SFalse (%==) (SA _ _ _ _) (SF _ _ _ _) = SFalse (%==) (SB _ _ _ _) (SA _ _ _ _) = SFalse (%==) (SB a a a a) (SB b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) (%==) (SB _ _ _ _) (SC _ _ _ _) = SFalse (%==) (SB _ _ _ _) (SD _ _ _ _) = SFalse (%==) (SB _ _ _ _) (SE _ _ _ _) = SFalse (%==) (SB _ _ _ _) (SF _ _ _ _) = SFalse (%==) (SC _ _ _ _) (SA _ _ _ _) = SFalse (%==) (SC _ _ _ _) (SB _ _ _ _) = SFalse (%==) (SC a a a a) (SC b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) (%==) (SC _ _ _ _) (SD _ _ _ _) = SFalse (%==) (SC _ _ _ _) (SE _ _ _ _) = SFalse (%==) (SC _ _ _ _) (SF _ _ _ _) = SFalse (%==) (SD _ _ _ _) (SA _ _ _ _) = SFalse (%==) (SD _ _ _ _) (SB _ _ _ _) = SFalse (%==) (SD _ _ _ _) (SC _ _ _ _) = SFalse (%==) (SD a a a a) (SD b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) (%==) (SD _ _ _ _) (SE _ _ _ _) = SFalse (%==) (SD _ _ _ _) (SF _ _ _ _) = SFalse (%==) (SE _ _ _ _) (SA _ _ _ _) = SFalse (%==) (SE _ _ _ _) (SB _ _ _ _) = SFalse (%==) (SE _ _ _ _) (SC _ _ _ _) = SFalse (%==) (SE _ _ _ _) (SD _ _ _ _) = SFalse (%==) (SE a a a a) (SE b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) (%==) (SE _ _ _ _) (SF _ _ _ _) = SFalse (%==) (SF _ _ _ _) (SA _ _ _ _) = SFalse (%==) (SF _ _ _ _) (SB _ _ _ _) = SFalse (%==) (SF _ _ _ _) (SC _ _ _ _) = SFalse (%==) (SF _ _ _ _) (SD _ _ _ _) = SFalse (%==) (SF _ _ _ _) (SE _ _ _ _) = SFalse (%==) (SF a a a a) (SF b b b b) = ((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%&&) (((%==) a) b)) (((%==) a) b))) instance (SDecide a, SDecide b, SDecide c, SDecide d) => SDecide (Foo a b c d) where (%~) (SA a a a a) (SA b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SA _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) (%~) (SA _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) (%~) (SA _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) (%~) (SA _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) (%~) (SA _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) (%~) (SB _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) (%~) (SB a a a a) (SB b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SB _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) (%~) (SB _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) (%~) (SB _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) (%~) (SB _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) (%~) (SC _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) (%~) (SC _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) (%~) (SC a a a a) (SC b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SC _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) (%~) (SC _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) (%~) (SC _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) (%~) (SD _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) (%~) (SD _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) (%~) (SD _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) (%~) (SD a a a a) (SD b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SD _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) (%~) (SD _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) (%~) (SE _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) (%~) (SE _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) (%~) (SE _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) (%~) (SE _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) (%~) (SE a a a a) (SE b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SE _ _ _ _) (SF _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF _ _ _ _) (SA _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF _ _ _ _) (SB _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF _ _ _ _) (SC _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF _ _ _ _) (SD _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF _ _ _ _) (SE _ _ _ _) = Disproved (\ x -> case x of) (%~) (SF a a a a) (SF b b b b) = case ((((,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b)) (((%~) a) b) of (,,,) (Proved Refl) (Proved Refl) (Proved Refl) (Proved Refl) -> Proved Refl (,,,) (Disproved contra) _ _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ (Disproved contra) _ _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,,,) _ _ _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SingI Zero where sing = SZero instance SingI n => SingI (Succ (n :: Nat)) where sing = SSucc sing instance SingI (SuccSym0 :: (~>) Nat Nat) where sing = (singFun1 @SuccSym0) SSucc instance SingI (TyCon1 Succ :: (~>) Nat Nat) where sing = (singFun1 @(TyCon1 Succ)) SSucc instance (SingI n, SingI n, SingI n, SingI n) => SingI (A (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SA sing) sing) sing) sing instance SingI (ASym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @ASym0) SA instance SingI (TyCon4 A :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 A)) SA instance SingI d => SingI (ASym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(ASym1 (d :: a))) (SA (sing @d)) instance SingI d => SingI (TyCon3 (A (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (A (d :: a)))) (SA (sing @d)) instance (SingI d, SingI d) => SingI (ASym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(ASym2 (d :: a) (d :: b))) ((SA (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (A (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (A (d :: a) (d :: b)))) ((SA (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (ASym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(ASym3 (d :: a) (d :: b) (d :: c))) (((SA (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (A (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (A (d :: a) (d :: b) (d :: c)))) (((SA (sing @d)) (sing @d)) (sing @d)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (B (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SB sing) sing) sing) sing instance SingI (BSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @BSym0) SB instance SingI (TyCon4 B :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 B)) SB instance SingI d => SingI (BSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(BSym1 (d :: a))) (SB (sing @d)) instance SingI d => SingI (TyCon3 (B (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (B (d :: a)))) (SB (sing @d)) instance (SingI d, SingI d) => SingI (BSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(BSym2 (d :: a) (d :: b))) ((SB (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (B (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (B (d :: a) (d :: b)))) ((SB (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (BSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(BSym3 (d :: a) (d :: b) (d :: c))) (((SB (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (B (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (B (d :: a) (d :: b) (d :: c)))) (((SB (sing @d)) (sing @d)) (sing @d)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (C (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SC sing) sing) sing) sing instance SingI (CSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @CSym0) SC instance SingI (TyCon4 C :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 C)) SC instance SingI d => SingI (CSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(CSym1 (d :: a))) (SC (sing @d)) instance SingI d => SingI (TyCon3 (C (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (C (d :: a)))) (SC (sing @d)) instance (SingI d, SingI d) => SingI (CSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(CSym2 (d :: a) (d :: b))) ((SC (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (C (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (C (d :: a) (d :: b)))) ((SC (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (CSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(CSym3 (d :: a) (d :: b) (d :: c))) (((SC (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (C (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (C (d :: a) (d :: b) (d :: c)))) (((SC (sing @d)) (sing @d)) (sing @d)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (D (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SD sing) sing) sing) sing instance SingI (DSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @DSym0) SD instance SingI (TyCon4 D :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 D)) SD instance SingI d => SingI (DSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(DSym1 (d :: a))) (SD (sing @d)) instance SingI d => SingI (TyCon3 (D (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (D (d :: a)))) (SD (sing @d)) instance (SingI d, SingI d) => SingI (DSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(DSym2 (d :: a) (d :: b))) ((SD (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (D (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (D (d :: a) (d :: b)))) ((SD (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (DSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(DSym3 (d :: a) (d :: b) (d :: c))) (((SD (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (D (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (D (d :: a) (d :: b) (d :: c)))) (((SD (sing @d)) (sing @d)) (sing @d)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (E (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SE sing) sing) sing) sing instance SingI (ESym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @ESym0) SE instance SingI (TyCon4 E :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 E)) SE instance SingI d => SingI (ESym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(ESym1 (d :: a))) (SE (sing @d)) instance SingI d => SingI (TyCon3 (E (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (E (d :: a)))) (SE (sing @d)) instance (SingI d, SingI d) => SingI (ESym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(ESym2 (d :: a) (d :: b))) ((SE (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (E (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (E (d :: a) (d :: b)))) ((SE (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (ESym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(ESym3 (d :: a) (d :: b) (d :: c))) (((SE (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (E (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (E (d :: a) (d :: b) (d :: c)))) (((SE (sing @d)) (sing @d)) (sing @d)) instance (SingI n, SingI n, SingI n, SingI n) => SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where sing = (((SF sing) sing) sing) sing instance SingI (FSym0 :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @FSym0) SF instance SingI (TyCon4 F :: (~>) a ((~>) b ((~>) c ((~>) d (Foo a b c d))))) where sing = (singFun4 @(TyCon4 F)) SF instance SingI d => SingI (FSym1 (d :: a) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(FSym1 (d :: a))) (SF (sing @d)) instance SingI d => SingI (TyCon3 (F (d :: a)) :: (~>) b ((~>) c ((~>) d (Foo a b c d)))) where sing = (singFun3 @(TyCon3 (F (d :: a)))) (SF (sing @d)) instance (SingI d, SingI d) => SingI (FSym2 (d :: a) (d :: b) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(FSym2 (d :: a) (d :: b))) ((SF (sing @d)) (sing @d)) instance (SingI d, SingI d) => SingI (TyCon2 (F (d :: a) (d :: b)) :: (~>) c ((~>) d (Foo a b c d))) where sing = (singFun2 @(TyCon2 (F (d :: a) (d :: b)))) ((SF (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (FSym3 (d :: a) (d :: b) (d :: c) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(FSym3 (d :: a) (d :: b) (d :: c))) (((SF (sing @d)) (sing @d)) (sing @d)) instance (SingI d, SingI d, SingI d) => SingI (TyCon1 (F (d :: a) (d :: b) (d :: c)) :: (~>) d (Foo a b c d)) where sing = (singFun1 @(TyCon1 (F (d :: a) (d :: b) (d :: c)))) (((SF (sing @d)) (sing @d)) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/OrdDeriving.hs0000755000000000000000000000200707346545000023271 0ustar0000000000000000module Singletons.OrdDeriving where import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| data Nat = Zero | Succ Nat deriving (Eq, Ord) data Foo a b c d = A a b c d | B a b c d | C a b c d | D a b c d | E a b c d | F a b c d deriving (Eq,Ord) |]) foo1a :: Proxy (Zero < Succ Zero) foo1a = Proxy foo1b :: Proxy True foo1b = foo1a foo2a :: Proxy (Succ (Succ Zero) `Compare` Zero) foo2a = Proxy foo2b :: Proxy GT foo2b = foo2a foo3a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 4) foo3a = Proxy foo3b :: Proxy EQ foo3b = foo3a foo4a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 5) foo4a = Proxy foo4b :: Proxy LT foo4b = foo4a foo5a :: Proxy (A 1 2 3 4 `Compare` A 1 2 3 3) foo5a = Proxy foo5b :: Proxy GT foo5b = foo5a foo6a :: Proxy (A 1 2 3 4 `Compare` B 1 2 3 4) foo6a = Proxy foo6b :: Proxy LT foo6b = foo6a foo7a :: Proxy (B 1 2 3 4 `Compare` A 1 2 3 4) foo7a = Proxy foo7b :: Proxy GT foo7b = foo7a singletons-2.5.1/tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template0000755000000000000000000000267007346545000026640 0ustar0000000000000000Singletons/OverloadedStrings.hs:(0,0)-(0,0): Splicing declarations singletons [d| symId :: Symbol -> Symbol symId x = x foo :: Symbol foo = symId "foo" |] ======> symId :: Symbol -> Symbol symId x = x foo :: Symbol foo = symId "foo" type SymIdSym1 (a0123456789876543210 :: Symbol) = SymId a0123456789876543210 instance SuppressUnusedWarnings SymIdSym0 where suppressUnusedWarnings = snd (((,) SymIdSym0KindInference) ()) data SymIdSym0 :: (~>) Symbol Symbol where SymIdSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) => SymIdSym0 a0123456789876543210 type instance Apply SymIdSym0 a0123456789876543210 = SymId a0123456789876543210 type FooSym0 = Foo type family SymId (a :: Symbol) :: Symbol where SymId x = x type family Foo :: Symbol where Foo = Apply SymIdSym0 (Data.Singletons.Prelude.IsString.FromString "foo") sSymId :: forall (t :: Symbol). Sing t -> Sing (Apply SymIdSym0 t :: Symbol) sFoo :: Sing (FooSym0 :: Symbol) sSymId (sX :: Sing x) = sX sFoo = (applySing ((singFun1 @SymIdSym0) sSymId)) (Data.Singletons.Prelude.IsString.sFromString (sing :: Sing "foo")) instance SingI (SymIdSym0 :: (~>) Symbol Symbol) where sing = (singFun1 @SymIdSym0) sSymId singletons-2.5.1/tests/compile-and-dump/Singletons/OverloadedStrings.hs0000755000000000000000000000036207346545000024515 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module OverloadedStrings where import Data.Singletons.TH import Data.Singletons.TypeLits $(singletons [d| symId :: Symbol -> Symbol symId x = x foo :: Symbol foo = symId "foo" |]) singletons-2.5.1/tests/compile-and-dump/Singletons/PatternMatching.ghc86.template0000755000000000000000000010776207346545000026302 0ustar0000000000000000Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations singletons [d| pr = Pair (Succ Zero) ([Zero]) complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] data Pair a b = Pair a b deriving Show |] ======> data Pair a b = Pair a b deriving Show pr = (Pair (Succ Zero)) [Zero] complex = (Pair ((Pair (Just Zero)) Zero)) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] type PairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (PairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) PairSym1KindInference) ()) data PairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) where PairSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (PairSym1 t0123456789876543210) arg) (PairSym2 t0123456789876543210 arg) => PairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (PairSym1 t0123456789876543210) t0123456789876543210 = Pair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings PairSym0 where suppressUnusedWarnings = snd (((,) PairSym0KindInference) ()) data PairSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) where PairSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) => PairSym0 t0123456789876543210 type instance Apply PairSym0 t0123456789876543210 = PairSym1 t0123456789876543210 type AListSym0 = AList type TupleSym0 = Tuple type ComplexSym0 = Complex type PrSym0 = Pr type family AList where AList = Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 (Apply SuccSym0 ZeroSym0))) '[])) type family Tuple where Tuple = Apply (Apply (Apply Tuple3Sym0 FalseSym0) (Apply JustSym0 ZeroSym0)) TrueSym0 type family Complex where Complex = Apply (Apply PairSym0 (Apply (Apply PairSym0 (Apply JustSym0 ZeroSym0)) ZeroSym0)) FalseSym0 type family Pr where Pr = Apply (Apply PairSym0 (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) ZeroSym0) '[]) type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Pair a b) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (Pair arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Pair ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Pair a0123456789876543210 b0123456789876543210) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210 b0123456789876543210. (~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) GHC.Types.Nat ((~>) (Pair a0123456789876543210 b0123456789876543210) ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (Pair a b) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a sAList :: Sing AListSym0 sTuple :: Sing TupleSym0 sComplex :: Sing ComplexSym0 sPr :: Sing PrSym0 sAList = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) SNil)) sTuple = (applySing ((applySing ((applySing ((singFun3 @Tuple3Sym0) STuple3)) SFalse)) ((applySing ((singFun1 @JustSym0) SJust)) SZero))) STrue sComplex = (applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((singFun1 @JustSym0) SJust)) SZero))) SZero))) SFalse sPr = (applySing ((applySing ((singFun2 @PairSym0) SPair)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) SNil) data instance Sing :: Pair a b -> GHC.Types.Type where SPair :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Pair n n) type SPair = (Sing :: Pair a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Pair a b) where type Demote (Pair a b) = Pair (Demote a) (Demote b) fromSing (SPair b b) = (Pair (fromSing b)) (fromSing b) toSing (Pair (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SPair c) c) } instance (SShow a, SShow b) => SShow (Pair a b) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Pair a b) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Pair a b) ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SPair (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Pair ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 deriving instance (Data.Singletons.ShowSing.ShowSing a, Data.Singletons.ShowSing.ShowSing b) => Show (Sing (z :: Pair a b)) instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where sing = (SPair sing) sing instance SingI (PairSym0 :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @PairSym0) SPair instance SingI (TyCon2 Pair :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @(TyCon2 Pair)) SPair instance SingI d => SingI (PairSym1 (d :: a) :: (~>) b (Pair a b)) where sing = (singFun1 @(PairSym1 (d :: a))) (SPair (sing @d)) instance SingI d => SingI (TyCon1 (Pair (d :: a)) :: (~>) b (Pair a b)) where sing = (singFun1 @(TyCon1 (Pair (d :: a)))) (SPair (sing @d)) Singletons/PatternMatching.hs:(0,0)-(0,0): Splicing declarations singletons [d| Pair sz lz = pr Pair (Pair jz zz) fls = complex (tf, tjz, tt) = tuple [_, lsz, (Succ blimy)] = aList lsz :: Nat fls :: Bool foo1 :: (a, b) -> a foo1 (x, y) = (\ _ -> x) y foo2 :: (# a, b #) -> a foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } silly :: a -> () silly x = case x of { _ -> () } |] ======> Pair sz lz = pr Pair (Pair jz zz) fls = complex (tf, tjz, tt) = tuple [_, lsz, Succ blimy] = aList lsz :: Nat fls :: Bool foo1 :: (a, b) -> a foo1 (x, y) = (\ _ -> x) y foo2 :: (# a, b #) -> a foo2 t@(# x, y #) = case t of { (# a, b #) -> (\ _ -> a) b } silly :: a -> () silly x = case x of { _ -> () } type family Case_0123456789876543210 x t where Case_0123456789876543210 x _ = Tuple0Sym0 type Let0123456789876543210TSym2 x0123456789876543210 y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210TSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210TSym1KindInference) ()) data Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 where Let0123456789876543210TSym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Let0123456789876543210TSym1 x0123456789876543210) arg) (Let0123456789876543210TSym2 x0123456789876543210 arg) => Let0123456789876543210TSym1 x0123456789876543210 y0123456789876543210 type instance Apply (Let0123456789876543210TSym1 x0123456789876543210) y0123456789876543210 = Let0123456789876543210T x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210TSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210TSym0KindInference) ()) data Let0123456789876543210TSym0 x0123456789876543210 where Let0123456789876543210TSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) => Let0123456789876543210TSym0 x0123456789876543210 type instance Apply Let0123456789876543210TSym0 x0123456789876543210 = Let0123456789876543210TSym1 x0123456789876543210 type family Let0123456789876543210T x y where Let0123456789876543210T x y = Apply (Apply Tuple2Sym0 x) y type family Case_0123456789876543210 x y a b arg_0123456789876543210 t where Case_0123456789876543210 x y a b arg_0123456789876543210 _ = a type family Lambda_0123456789876543210 x y a b t where Lambda_0123456789876543210 x y a b arg_0123456789876543210 = Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 a0123456789876543210 arg) => Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 y0123456789876543210 x0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym4 a0123456789876543210 y0123456789876543210 x0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 a0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y t where Case_0123456789876543210 x y '(a, b) = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b) b type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[_, y_0123456789876543210, 'Succ _] = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[_, _, 'Succ y_0123456789876543210] = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '(y_0123456789876543210, _, _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '(_, y_0123456789876543210, _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '(_, _, y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair ( 'Pair y_0123456789876543210 _) _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair ( 'Pair _ y_0123456789876543210) _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair ( 'Pair _ _) y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair y_0123456789876543210 _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Pair _ y_0123456789876543210) = y_0123456789876543210 type SillySym1 (a0123456789876543210 :: a0123456789876543210) = Silly a0123456789876543210 instance SuppressUnusedWarnings SillySym0 where suppressUnusedWarnings = snd (((,) SillySym0KindInference) ()) data SillySym0 :: forall a0123456789876543210. (~>) a0123456789876543210 () where SillySym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) => SillySym0 a0123456789876543210 type instance Apply SillySym0 a0123456789876543210 = Silly a0123456789876543210 type Foo2Sym1 (a0123456789876543210 :: (a0123456789876543210, b0123456789876543210)) = Foo2 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (a0123456789876543210, b0123456789876543210) a0123456789876543210 where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 type Foo1Sym1 (a0123456789876543210 :: (a0123456789876543210, b0123456789876543210)) = Foo1 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (a0123456789876543210, b0123456789876543210) a0123456789876543210 where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 type LszSym0 = Lsz type BlimySym0 = Blimy type TfSym0 = Tf type TjzSym0 = Tjz type TtSym0 = Tt type JzSym0 = Jz type ZzSym0 = Zz type FlsSym0 = Fls type SzSym0 = Sz type LzSym0 = Lz type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type family Silly (a :: a) :: () where Silly x = Case_0123456789876543210 x x type family Foo2 (a :: (a, b)) :: a where Foo2 '(x, y) = Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) type family Foo1 (a :: (a, b)) :: a where Foo1 '(x, y) = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type family Lsz :: Nat where Lsz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Blimy where Blimy = Case_0123456789876543210 X_0123456789876543210Sym0 type family Tf where Tf = Case_0123456789876543210 X_0123456789876543210Sym0 type family Tjz where Tjz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Tt where Tt = Case_0123456789876543210 X_0123456789876543210Sym0 type family Jz where Jz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Zz where Zz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Fls :: Bool where Fls = Case_0123456789876543210 X_0123456789876543210Sym0 type family Sz where Sz = Case_0123456789876543210 X_0123456789876543210Sym0 type family Lz where Lz = Case_0123456789876543210 X_0123456789876543210Sym0 type family X_0123456789876543210 where X_0123456789876543210 = PrSym0 type family X_0123456789876543210 where X_0123456789876543210 = ComplexSym0 type family X_0123456789876543210 where X_0123456789876543210 = TupleSym0 type family X_0123456789876543210 where X_0123456789876543210 = AListSym0 sSilly :: forall a (t :: a). Sing t -> Sing (Apply SillySym0 t :: ()) sFoo2 :: forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a) sFoo1 :: forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo1Sym0 t :: a) sLsz :: Sing (LszSym0 :: Nat) sBlimy :: Sing BlimySym0 sTf :: Sing TfSym0 sTjz :: Sing TjzSym0 sTt :: Sing TtSym0 sJz :: Sing JzSym0 sZz :: Sing ZzSym0 sFls :: Sing (FlsSym0 :: Bool) sSz :: Sing SzSym0 sLz :: Sing LzSym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sSilly (sX :: Sing x) = (case sX of { _ -> STuple0 }) :: Sing (Case_0123456789876543210 x x :: ()) sFoo2 (STuple2 (sX :: Sing x) (sY :: Sing y)) = let sT :: Sing (Let0123456789876543210TSym2 x y) sT = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY in (case sT of { STuple2 (sA :: Sing a) (sB :: Sing b) -> (applySing ((singFun1 @(Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) a) b)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sA }) :: Sing (Case_0123456789876543210 x y a b arg_0123456789876543210 arg_0123456789876543210) }))) sB }) :: Sing (Case_0123456789876543210 x y (Let0123456789876543210TSym2 x y) :: a) sFoo1 (STuple2 (sX :: Sing x) (sY :: Sing y)) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) sY sLsz = (case sX_0123456789876543210 of { SCons _ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) (SCons (SSucc _) SNil)) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Nat) sBlimy = (case sX_0123456789876543210 of { SCons _ (SCons _ (SCons (SSucc (sY_0123456789876543210 :: Sing y_0123456789876543210)) SNil)) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sTf = (case sX_0123456789876543210 of { STuple3 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sTjz = (case sX_0123456789876543210 of { STuple3 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sTt = (case sX_0123456789876543210 of { STuple3 _ _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sJz = (case sX_0123456789876543210 of { SPair (SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sZz = (case sX_0123456789876543210 of { SPair (SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210)) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sFls = (case sX_0123456789876543210 of { SPair (SPair _ _) (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) sSz = (case sX_0123456789876543210 of { SPair (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sLz = (case sX_0123456789876543210 of { SPair _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0) sX_0123456789876543210 = sPr sX_0123456789876543210 = sComplex sX_0123456789876543210 = sTuple sX_0123456789876543210 = sAList instance SingI (SillySym0 :: (~>) a ()) where sing = (singFun1 @SillySym0) sSilly instance SingI (Foo2Sym0 :: (~>) (a, b) a) where sing = (singFun1 @Foo2Sym0) sFoo2 instance SingI (Foo1Sym0 :: (~>) (a, b) a) where sing = (singFun1 @Foo1Sym0) sFoo1 singletons-2.5.1/tests/compile-and-dump/Singletons/PatternMatching.hs0000755000000000000000000000212507346545000024146 0ustar0000000000000000{-# OPTIONS_GHC -Wno-unused-matches #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.PatternMatching where import Data.Singletons.Prelude import Data.Singletons.Prelude.Show import Data.Singletons.TH import Singletons.Nat $(singletons [d| data Pair a b = Pair a b deriving Show pr = Pair (Succ Zero) ([Zero]) complex = Pair (Pair (Just Zero) Zero) False tuple = (False, Just Zero, True) aList = [Zero, Succ Zero, Succ (Succ Zero)] |]) $(singletons [d| Pair sz lz = pr Pair (Pair jz zz) fls = complex (tf, tjz, tt) = tuple [_, lsz, (Succ blimy)] = aList lsz :: Nat fls :: Bool foo1 :: (a, b) -> a foo1 (x, y) = (\_ -> x) y foo2 :: (# a, b #) -> a foo2 t@(# x, y #) = case t of (# a, b #) -> (\_ -> a) b silly :: a -> () silly x = case x of _ -> () |]) test1 :: Proxy (Foo1 '(Int, Char)) -> Proxy Int test1 = id test2 :: Proxy (Foo2 '(Int, Char)) -> Proxy Int test2 = id test3 :: Proxy Lsz -> Proxy (Succ Zero) test3 = id test4 :: Proxy Blimy -> Proxy (Succ Zero) test4 = id test5 :: Proxy Fls -> Proxy False test5 = id singletons-2.5.1/tests/compile-and-dump/Singletons/PolyKinds.ghc86.template0000755000000000000000000000245207346545000025114 0ustar0000000000000000Singletons/PolyKinds.hs:(0,0)-(0,0): Splicing declarations singletons [d| class Cls (a :: k) where fff :: Proxy (a :: k) -> () |] ======> class Cls (a :: k) where fff :: Proxy (a :: k) -> () type FffSym1 (arg0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) = Fff arg0123456789876543210 instance SuppressUnusedWarnings FffSym0 where suppressUnusedWarnings = snd (((,) FffSym0KindInference) ()) data FffSym0 :: forall k0123456789876543210 (a0123456789876543210 :: k0123456789876543210). (~>) (Proxy (a0123456789876543210 :: k0123456789876543210)) () where FffSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) => FffSym0 arg0123456789876543210 type instance Apply FffSym0 arg0123456789876543210 = Fff arg0123456789876543210 class PCls (a :: k) where type Fff (arg :: Proxy (a :: k)) :: () class SCls (a :: k) where sFff :: forall (t :: Proxy (a :: k)). Sing t -> Sing (Apply FffSym0 t :: ()) instance SCls a => SingI (FffSym0 :: (~>) (Proxy (a :: k)) ()) where sing = (singFun1 @FffSym0) sFff singletons-2.5.1/tests/compile-and-dump/Singletons/PolyKinds.hs0000755000000000000000000000022007346545000022764 0ustar0000000000000000module Singletons.PolyKinds where import Data.Singletons.TH $(singletons [d| class Cls (a :: k) where fff :: Proxy (a :: k) -> () |]) singletons-2.5.1/tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.template0000755000000000000000000000072107346545000025552 0ustar0000000000000000Singletons/PolyKindsApp.hs:(0,0)-(0,0): Splicing declarations singletons [d| class Cls (a :: k -> Type) where fff :: (a :: k -> Type) (b :: k) |] ======> class Cls (a :: k -> Type) where fff :: (a :: k -> Type) (b :: k) type FffSym0 = Fff class PCls (a :: k -> Type) where type Fff :: (a :: k -> Type) (b :: k) class SCls (a :: k -> Type) where sFff :: forall b. Sing (FffSym0 :: (a :: k -> Type) (b :: k)) singletons-2.5.1/tests/compile-and-dump/Singletons/PolyKindsApp.hs0000755000000000000000000000035107346545000023432 0ustar0000000000000000module Singletons.PolyKindsApp where import Data.Kind (Type) import Data.Singletons.TH $(singletons [d| class Cls (a :: k -> Type) where fff :: (a :: k -> Type) (b :: k) -- instance Cls Proxy where -- fff = Proxy |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Records.ghc86.template0000755000000000000000000001123007346545000024573 0ustar0000000000000000Singletons/Records.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Record a = MkRecord {field1 :: a, field2 :: Bool} |] ======> data Record a = MkRecord {field1 :: a, field2 :: Bool} type Field1Sym1 (a0123456789876543210 :: Record a0123456789876543210) = Field1 a0123456789876543210 instance SuppressUnusedWarnings Field1Sym0 where suppressUnusedWarnings = snd (((,) Field1Sym0KindInference) ()) data Field1Sym0 :: forall a0123456789876543210. (~>) (Record a0123456789876543210) a0123456789876543210 where Field1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) => Field1Sym0 a0123456789876543210 type instance Apply Field1Sym0 a0123456789876543210 = Field1 a0123456789876543210 type Field2Sym1 (a0123456789876543210 :: Record a0123456789876543210) = Field2 a0123456789876543210 instance SuppressUnusedWarnings Field2Sym0 where suppressUnusedWarnings = snd (((,) Field2Sym0KindInference) ()) data Field2Sym0 :: forall a0123456789876543210. (~>) (Record a0123456789876543210) Bool where Field2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) => Field2Sym0 a0123456789876543210 type instance Apply Field2Sym0 a0123456789876543210 = Field2 a0123456789876543210 type family Field1 (a :: Record a) :: a where Field1 (MkRecord field _) = field type family Field2 (a :: Record a) :: Bool where Field2 (MkRecord _ field) = field type MkRecordSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: Bool) = MkRecord t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkRecordSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkRecordSym1KindInference) ()) data MkRecordSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) Bool (Record a0123456789876543210) where MkRecordSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkRecordSym1 t0123456789876543210) arg) (MkRecordSym2 t0123456789876543210 arg) => MkRecordSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkRecordSym1 t0123456789876543210) t0123456789876543210 = MkRecord t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkRecordSym0 where suppressUnusedWarnings = snd (((,) MkRecordSym0KindInference) ()) data MkRecordSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) Bool (Record a0123456789876543210)) where MkRecordSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) => MkRecordSym0 t0123456789876543210 type instance Apply MkRecordSym0 t0123456789876543210 = MkRecordSym1 t0123456789876543210 data instance Sing :: Record a -> GHC.Types.Type where SMkRecord :: forall a (n :: a) (n :: Bool). {sField1 :: (Sing (n :: a)), sField2 :: (Sing (n :: Bool))} -> Sing (MkRecord n n) type SRecord = (Sing :: Record a -> GHC.Types.Type) instance SingKind a => SingKind (Record a) where type Demote (Record a) = Record (Demote a) fromSing (SMkRecord b b) = (MkRecord (fromSing b)) (fromSing b) toSing (MkRecord (b :: Demote a) (b :: Demote Bool)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing Bool) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkRecord c) c) } instance (SingI n, SingI n) => SingI (MkRecord (n :: a) (n :: Bool)) where sing = (SMkRecord sing) sing instance SingI (MkRecordSym0 :: (~>) a ((~>) Bool (Record a))) where sing = (singFun2 @MkRecordSym0) SMkRecord instance SingI (TyCon2 MkRecord :: (~>) a ((~>) Bool (Record a))) where sing = (singFun2 @(TyCon2 MkRecord)) SMkRecord instance SingI d => SingI (MkRecordSym1 (d :: a) :: (~>) Bool (Record a)) where sing = (singFun1 @(MkRecordSym1 (d :: a))) (SMkRecord (sing @d)) instance SingI d => SingI (TyCon1 (MkRecord (d :: a)) :: (~>) Bool (Record a)) where sing = (singFun1 @(TyCon1 (MkRecord (d :: a)))) (SMkRecord (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Records.hs0000755000000000000000000000111307346545000022453 0ustar0000000000000000module Singletons.Records where import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Data.Singletons.Prelude $(singletons [d| data Record a = MkRecord { field1 :: a , field2 :: Bool } |]) -- This fails - see #66 -- $(singletons [d| -- neg :: Record a -> Record a -- neg rec@(MkRecord { field1 = _, field2 = b } ) = rec {field2 = not b} -- |]) foo1a :: Proxy (Field2 (MkRecord 5 True)) foo1a = Proxy foo1b :: Proxy True foo1b = foo1a foo2a :: Proxy (Field1 (MkRecord 5 True)) foo2a = Proxy foo2b :: Proxy 5 foo2b = foo2a singletons-2.5.1/tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template0000755000000000000000000001303307346545000025270 0ustar0000000000000000Singletons/ReturnFunc.hs:(0,0)-(0,0): Splicing declarations singletons [d| returnFunc :: Nat -> Nat -> Nat returnFunc _ = Succ id :: a -> a id x = x idFoo :: c -> a -> a idFoo _ = id |] ======> returnFunc :: Nat -> Nat -> Nat returnFunc _ = Succ id :: a -> a id x = x idFoo :: c -> a -> a idFoo _ = id type IdSym1 (a0123456789876543210 :: a0123456789876543210) = Id a0123456789876543210 instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings = snd (((,) IdSym0KindInference) ()) data IdSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where IdSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => IdSym0 a0123456789876543210 type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 type IdFooSym2 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: a0123456789876543210) = IdFoo a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (IdFooSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) IdFooSym1KindInference) ()) data IdFooSym1 (a0123456789876543210 :: c0123456789876543210) :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where IdFooSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (IdFooSym1 a0123456789876543210) arg) (IdFooSym2 a0123456789876543210 arg) => IdFooSym1 a0123456789876543210 a0123456789876543210 type instance Apply (IdFooSym1 a0123456789876543210) a0123456789876543210 = IdFoo a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings IdFooSym0 where suppressUnusedWarnings = snd (((,) IdFooSym0KindInference) ()) data IdFooSym0 :: forall a0123456789876543210 c0123456789876543210. (~>) c0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) where IdFooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) => IdFooSym0 a0123456789876543210 type instance Apply IdFooSym0 a0123456789876543210 = IdFooSym1 a0123456789876543210 type ReturnFuncSym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = ReturnFunc a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ReturnFuncSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ReturnFuncSym1KindInference) ()) data ReturnFuncSym1 (a0123456789876543210 :: Nat) :: (~>) Nat Nat where ReturnFuncSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ReturnFuncSym1 a0123456789876543210) arg) (ReturnFuncSym2 a0123456789876543210 arg) => ReturnFuncSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ReturnFuncSym1 a0123456789876543210) a0123456789876543210 = ReturnFunc a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ReturnFuncSym0 where suppressUnusedWarnings = snd (((,) ReturnFuncSym0KindInference) ()) data ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat) where ReturnFuncSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) => ReturnFuncSym0 a0123456789876543210 type instance Apply ReturnFuncSym0 a0123456789876543210 = ReturnFuncSym1 a0123456789876543210 type family Id (a :: a) :: a where Id x = x type family IdFoo (a :: c) (a :: a) :: a where IdFoo _ a_0123456789876543210 = Apply IdSym0 a_0123456789876543210 type family ReturnFunc (a :: Nat) (a :: Nat) :: Nat where ReturnFunc _ a_0123456789876543210 = Apply SuccSym0 a_0123456789876543210 sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) sIdFoo :: forall c a (t :: c) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply IdFooSym0 t) t :: a) sReturnFunc :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ReturnFuncSym0 t) t :: Nat) sId (sX :: Sing x) = sX sIdFoo _ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @IdSym0) sId)) sA_0123456789876543210 sReturnFunc _ (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @SuccSym0) SSucc)) sA_0123456789876543210 instance SingI (IdSym0 :: (~>) a a) where sing = (singFun1 @IdSym0) sId instance SingI (IdFooSym0 :: (~>) c ((~>) a a)) where sing = (singFun2 @IdFooSym0) sIdFoo instance SingI d => SingI (IdFooSym1 (d :: c) :: (~>) a a) where sing = (singFun1 @(IdFooSym1 (d :: c))) (sIdFoo (sing @d)) instance SingI (ReturnFuncSym0 :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @ReturnFuncSym0) sReturnFunc instance SingI d => SingI (ReturnFuncSym1 (d :: Nat) :: (~>) Nat Nat) where sing = (singFun1 @(ReturnFuncSym1 (d :: Nat))) (sReturnFunc (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/ReturnFunc.hs0000755000000000000000000000124207346545000023150 0ustar0000000000000000module Singletons.ReturnFunc where import Data.Singletons import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Singletons.Nat -- tests the "num args" feature of promoteDec. The idea is that when clauses of -- a function have less patterns than required by the type signature the -- promoted type family should have this fact reflected in its return kind, -- which should be turned into a series of nested TyFuns (type level functions) $(singletons [d| returnFunc :: Nat -> Nat -> Nat returnFunc _ = Succ -- promotion of two functions below also depends on "num args" id :: a -> a id x = x idFoo :: c -> a -> a idFoo _ = id |]) singletons-2.5.1/tests/compile-and-dump/Singletons/Sections.ghc86.template0000755000000000000000000001460307346545000024770 0ustar0000000000000000Singletons/Sections.hs:(0,0)-(0,0): Splicing declarations singletons [d| (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) foo1 :: [Nat] foo1 = map ((Succ Zero) +) [Zero, Succ Zero] foo2 :: [Nat] foo2 = map (+ (Succ Zero)) [Zero, Succ Zero] foo3 :: [Nat] foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |] ======> (+) :: Nat -> Nat -> Nat (+) Zero m = m (+) (Succ n) m = Succ (n + m) foo1 :: [Nat] foo1 = (map (Succ Zero +)) [Zero, Succ Zero] foo2 :: [Nat] foo2 = (map (+ Succ Zero)) [Zero, Succ Zero] foo3 :: [Nat] foo3 = ((zipWith (+)) [Succ Zero, Succ Zero]) [Zero, Succ Zero] type family Lambda_0123456789876543210 t where Lambda_0123456789876543210 lhs_0123456789876543210 = Apply (Apply (+@#@$) lhs_0123456789876543210) (Apply SuccSym0 ZeroSym0) type Lambda_0123456789876543210Sym1 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 t0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 t0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 type (+@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((+@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:+@#@$$###)) ()) data (+@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:+@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((+@#@$$) a0123456789876543210) arg) ((+@#@$$$) a0123456789876543210 arg) => (+@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((+@#@$$) a0123456789876543210) a0123456789876543210 = (+) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (+@#@$) where suppressUnusedWarnings = snd (((,) (:+@#@$###)) ()) data (+@#@$) :: (~>) Nat ((~>) Nat Nat) where (:+@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) => (+@#@$) a0123456789876543210 type instance Apply (+@#@$) a0123456789876543210 = (+@#@$$) a0123456789876543210 type Foo1Sym0 = Foo1 type Foo2Sym0 = Foo2 type Foo3Sym0 = Foo3 type family (+) (a :: Nat) (a :: Nat) :: Nat where (+) 'Zero m = m (+) ( 'Succ n) m = Apply SuccSym0 (Apply (Apply (+@#@$) n) m) type family Foo1 :: [Nat] where Foo1 = Apply (Apply MapSym0 (Apply (+@#@$) (Apply SuccSym0 ZeroSym0))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) type family Foo2 :: [Nat] where Foo2 = Apply (Apply MapSym0 Lambda_0123456789876543210Sym0) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) type family Foo3 :: [Nat] where Foo3 = Apply (Apply (Apply ZipWithSym0 (+@#@$)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[]))) (Apply (Apply (:@#@$) ZeroSym0) (Apply (Apply (:@#@$) (Apply SuccSym0 ZeroSym0)) '[])) (%+) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply (+@#@$) t) t :: Nat) sFoo1 :: Sing (Foo1Sym0 :: [Nat]) sFoo2 :: Sing (Foo2Sym0 :: [Nat]) sFoo3 :: Sing (Foo3Sym0 :: [Nat]) (%+) SZero (sM :: Sing m) = sM (%+) (SSucc (sN :: Sing n)) (sM :: Sing m) = (applySing ((singFun1 @SuccSym0) SSucc)) ((applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sN)) sM) sFoo1 = (applySing ((applySing ((singFun2 @MapSym0) sMap)) ((applySing ((singFun2 @(+@#@$)) (%+))) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)) sFoo2 = (applySing ((applySing ((singFun2 @MapSym0) sMap)) ((singFun1 @Lambda_0123456789876543210Sym0) (\ sLhs_0123456789876543210 -> case sLhs_0123456789876543210 of { (_ :: Sing lhs_0123456789876543210) -> (applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sLhs_0123456789876543210)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero) })))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)) sFoo3 = (applySing ((applySing ((applySing ((singFun3 @ZipWithSym0) sZipWith)) ((singFun2 @(+@#@$)) (%+)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SZero)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @SuccSym0) SSucc)) SZero))) SNil)) instance SingI ((+@#@$) :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @(+@#@$)) (%+) instance SingI d => SingI ((+@#@$$) (d :: Nat) :: (~>) Nat Nat) where sing = (singFun1 @((+@#@$$) (d :: Nat))) ((%+) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Sections.hs0000755000000000000000000000140407346545000022644 0ustar0000000000000000module Singletons.Sections where import Data.Singletons import Data.Singletons.Prelude.List import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH import Singletons.Nat $(singletons [d| (+) :: Nat -> Nat -> Nat Zero + m = m (Succ n) + m = Succ (n + m) foo1 :: [Nat] foo1 = map ((Succ Zero)+) [Zero, Succ Zero] foo2 :: [Nat] foo2 = map (+(Succ Zero)) [Zero, Succ Zero] foo3 :: [Nat] foo3 = zipWith (+) [Succ Zero, Succ Zero] [Zero, Succ Zero] |]) foo1a :: Proxy Foo1 foo1a = Proxy foo1b :: Proxy [Succ Zero, Succ (Succ Zero)] foo1b = foo1a foo2a :: Proxy Foo2 foo2a = Proxy foo2b :: Proxy [Succ Zero, Succ (Succ Zero)] foo2b = foo2a foo3a :: Proxy Foo3 foo3a = Proxy foo3b :: Proxy [Succ Zero, Succ (Succ Zero)] foo3b = foo3a singletons-2.5.1/tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template0000755000000000000000000011625607346545000025620 0ustar0000000000000000Singletons/ShowDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixl 5 `MkFoo2b`, :*:, :&: data Foo1 = MkFoo1 deriving Show data Foo2 a = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a deriving Show data Foo3 = MkFoo3 {getFoo3a :: Bool, *** :: Bool} deriving Show |] ======> data Foo1 = MkFoo1 deriving Show infixl 5 `MkFoo2b` infixl 5 :*: infixl 5 :&: data Foo2 a = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a deriving Show data Foo3 = MkFoo3 {getFoo3a :: Bool, *** :: Bool} deriving Show type GetFoo3aSym1 (a0123456789876543210 :: Foo3) = GetFoo3a a0123456789876543210 instance SuppressUnusedWarnings GetFoo3aSym0 where suppressUnusedWarnings = snd (((,) GetFoo3aSym0KindInference) ()) data GetFoo3aSym0 :: (~>) Foo3 Bool where GetFoo3aSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) => GetFoo3aSym0 a0123456789876543210 type instance Apply GetFoo3aSym0 a0123456789876543210 = GetFoo3a a0123456789876543210 type (***@#@$$) (a0123456789876543210 :: Foo3) = (***) a0123456789876543210 instance SuppressUnusedWarnings (***@#@$) where suppressUnusedWarnings = snd (((,) (:***@#@$###)) ()) data (***@#@$) :: (~>) Foo3 Bool where (:***@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) => (***@#@$) a0123456789876543210 type instance Apply (***@#@$) a0123456789876543210 = (***) a0123456789876543210 type family GetFoo3a (a :: Foo3) :: Bool where GetFoo3a (MkFoo3 field _) = field type family (***) (a :: Foo3) :: Bool where (***) (MkFoo3 _ field) = field type MkFoo1Sym0 = MkFoo1 type MkFoo2aSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = MkFoo2a t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkFoo2aSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo2aSym1KindInference) ()) data MkFoo2aSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) where MkFoo2aSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkFoo2aSym1 t0123456789876543210) arg) (MkFoo2aSym2 t0123456789876543210 arg) => MkFoo2aSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo2aSym1 t0123456789876543210) t0123456789876543210 = MkFoo2a t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkFoo2aSym0 where suppressUnusedWarnings = snd (((,) MkFoo2aSym0KindInference) ()) data MkFoo2aSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where MkFoo2aSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) => MkFoo2aSym0 t0123456789876543210 type instance Apply MkFoo2aSym0 t0123456789876543210 = MkFoo2aSym1 t0123456789876543210 type MkFoo2bSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = MkFoo2b t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkFoo2bSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo2bSym1KindInference) ()) data MkFoo2bSym1 (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) where MkFoo2bSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkFoo2bSym1 t0123456789876543210) arg) (MkFoo2bSym2 t0123456789876543210 arg) => MkFoo2bSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo2bSym1 t0123456789876543210) t0123456789876543210 = MkFoo2b t0123456789876543210 t0123456789876543210 infixl 5 `MkFoo2bSym1` instance SuppressUnusedWarnings MkFoo2bSym0 where suppressUnusedWarnings = snd (((,) MkFoo2bSym0KindInference) ()) data MkFoo2bSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where MkFoo2bSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) => MkFoo2bSym0 t0123456789876543210 type instance Apply MkFoo2bSym0 t0123456789876543210 = MkFoo2bSym1 t0123456789876543210 infixl 5 `MkFoo2bSym0` type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = (:*:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) where (::*:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 infixl 5 :*:@#@$$ instance SuppressUnusedWarnings (:*:@#@$) where suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) data (:*:@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where (::*:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => (:*:@#@$) t0123456789876543210 type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 infixl 5 :*:@#@$ type (:&:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: a0123456789876543210) = (:&:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:&:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::&:@#@$$###)) ()) data (:&:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 (Foo2 a0123456789876543210) where (::&:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:&:@#@$$) t0123456789876543210) arg) ((:&:@#@$$$) t0123456789876543210 arg) => (:&:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:&:@#@$$) t0123456789876543210) t0123456789876543210 = (:&:) t0123456789876543210 t0123456789876543210 infixl 5 :&:@#@$$ instance SuppressUnusedWarnings (:&:@#@$) where suppressUnusedWarnings = snd (((,) (::&:@#@$###)) ()) data (:&:@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 (Foo2 a0123456789876543210)) where (::&:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) => (:&:@#@$) t0123456789876543210 type instance Apply (:&:@#@$) t0123456789876543210 = (:&:@#@$$) t0123456789876543210 infixl 5 :&:@#@$ type MkFoo3Sym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = MkFoo3 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkFoo3Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFoo3Sym1KindInference) ()) data MkFoo3Sym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo3 where MkFoo3Sym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkFoo3Sym1 t0123456789876543210) arg) (MkFoo3Sym2 t0123456789876543210 arg) => MkFoo3Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFoo3Sym1 t0123456789876543210) t0123456789876543210 = MkFoo3 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkFoo3Sym0 where suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) data MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3) where MkFoo3Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => MkFoo3Sym0 t0123456789876543210 type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3Sym1 t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo1) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ MkFoo1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "MkFoo1") a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo1) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo1 ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Foo1 where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo2 a) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2a arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo2a ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo2b argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " `MkFoo2b` ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(:*:) ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 ((:&:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 5))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :&: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 6)) argR_0123456789876543210)))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo2 a0123456789876543210) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. (~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) GHC.Types.Nat ((~>) (Foo2 a0123456789876543210) ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (Foo2 a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Foo3) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 (MkFoo3 arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "MkFoo3 ")) (Apply (Apply (.@#@$) (Apply ShowCharSym0 "{")) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "getFoo3a = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowCommaSpaceSym0) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "(***) = ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 0)) arg_0123456789876543210)) (Apply ShowCharSym0 "}"))))))))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Foo3) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Foo3 ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Foo3 where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a infixl 5 `SMkFoo2b` infixl 5 :%*: infixl 5 :%&: data instance Sing :: Foo1 -> GHC.Types.Type where SMkFoo1 :: Sing MkFoo1 type SFoo1 = (Sing :: Foo1 -> GHC.Types.Type) instance SingKind Foo1 where type Demote Foo1 = Foo1 fromSing SMkFoo1 = MkFoo1 toSing MkFoo1 = SomeSing SMkFoo1 data instance Sing :: Foo2 a -> GHC.Types.Type where SMkFoo2a :: forall a (n :: a) (n :: a). (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n) SMkFoo2b :: forall a (n :: a) (n :: a). (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n) (:%*:) :: forall a (n :: a) (n :: a). (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n) (:%&:) :: forall a (n :: a) (n :: a). (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:&:) n n) type SFoo2 = (Sing :: Foo2 a -> GHC.Types.Type) instance SingKind a => SingKind (Foo2 a) where type Demote (Foo2 a) = Foo2 (Demote a) fromSing (SMkFoo2a b b) = (MkFoo2a (fromSing b)) (fromSing b) fromSing (SMkFoo2b b b) = (MkFoo2b (fromSing b)) (fromSing b) fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) fromSing ((:%&:) b b) = ((:&:) (fromSing b)) (fromSing b) toSing (MkFoo2a (b :: Demote a) (b :: Demote a)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2a c) c) } toSing (MkFoo2b (b :: Demote a) (b :: Demote a)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo2b c) c) } toSing ((:*:) (b :: Demote a) (b :: Demote a)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } toSing ((:&:) (b :: Demote a) (b :: Demote a)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&:) c) c) } data instance Sing :: Foo3 -> GHC.Types.Type where SMkFoo3 :: forall (n :: Bool) (n :: Bool). {sGetFoo3a :: (Sing (n :: Bool)), %*** :: (Sing (n :: Bool))} -> Sing (MkFoo3 n n) type SFoo3 = (Sing :: Foo3 -> GHC.Types.Type) instance SingKind Foo3 where type Demote Foo3 = Foo3 fromSing (SMkFoo3 b b) = (MkFoo3 (fromSing b)) (fromSing b) toSing (MkFoo3 (b :: Demote Bool) (b :: Demote Bool)) = case ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkFoo3 c) c) } instance SShow Foo1 where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Foo1) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo1 ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ SMkFoo1 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "MkFoo1"))) sA_0123456789876543210 instance SShow a => SShow (Foo2 a) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Foo2 a) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Foo2 a) ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SMkFoo2a (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "MkFoo2a ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SMkFoo2b (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 5))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 6)))) sArgL_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing " `MkFoo2b` ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 6)))) sArgR_0123456789876543210))))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) ((:%*:) (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "(:*:) ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) ((:%&:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 5))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 6)))) sArgL_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing " :&: ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 6)))) sArgR_0123456789876543210))))) sA_0123456789876543210 instance SShow Bool => SShow Foo3 where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Foo3) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Foo3 ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SMkFoo3 (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "MkFoo3 ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowCharSym0) sShowChar)) (sing :: Sing "{")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "getFoo3a = ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 0)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowCommaSpaceSym0) sShowCommaSpace))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "(***) = ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 0)))) sArg_0123456789876543210))) ((applySing ((singFun2 @ShowCharSym0) sShowChar)) (sing :: Sing "}"))))))))))) sA_0123456789876543210 deriving instance Show (Sing (z :: Foo1)) deriving instance Data.Singletons.ShowSing.ShowSing a => Show (Sing (z :: Foo2 a)) deriving instance Data.Singletons.ShowSing.ShowSing Bool => Show (Sing (z :: Foo3)) instance SingI MkFoo1 where sing = SMkFoo1 instance (SingI n, SingI n) => SingI (MkFoo2a (n :: a) (n :: a)) where sing = (SMkFoo2a sing) sing instance SingI (MkFoo2aSym0 :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @MkFoo2aSym0) SMkFoo2a instance SingI (TyCon2 MkFoo2a :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(TyCon2 MkFoo2a)) SMkFoo2a instance SingI d => SingI (MkFoo2aSym1 (d :: a) :: (~>) a (Foo2 a)) where sing = (singFun1 @(MkFoo2aSym1 (d :: a))) (SMkFoo2a (sing @d)) instance SingI d => SingI (TyCon1 (MkFoo2a (d :: a)) :: (~>) a (Foo2 a)) where sing = (singFun1 @(TyCon1 (MkFoo2a (d :: a)))) (SMkFoo2a (sing @d)) instance (SingI n, SingI n) => SingI (MkFoo2b (n :: a) (n :: a)) where sing = (SMkFoo2b sing) sing instance SingI (MkFoo2bSym0 :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @MkFoo2bSym0) SMkFoo2b instance SingI (TyCon2 MkFoo2b :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(TyCon2 MkFoo2b)) SMkFoo2b instance SingI d => SingI (MkFoo2bSym1 (d :: a) :: (~>) a (Foo2 a)) where sing = (singFun1 @(MkFoo2bSym1 (d :: a))) (SMkFoo2b (sing @d)) instance SingI d => SingI (TyCon1 (MkFoo2b (d :: a)) :: (~>) a (Foo2 a)) where sing = (singFun1 @(TyCon1 (MkFoo2b (d :: a)))) (SMkFoo2b (sing @d)) instance (SingI n, SingI n) => SingI ((:*:) (n :: a) (n :: a)) where sing = ((:%*:) sing) sing instance SingI ((:*:@#@$) :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(:*:@#@$)) (:%*:) instance SingI (TyCon2 (:*:) :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(TyCon2 (:*:))) (:%*:) instance SingI d => SingI ((:*:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) instance SingI d => SingI (TyCon1 ((:*:) (d :: a)) :: (~>) a (Foo2 a)) where sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) instance (SingI n, SingI n) => SingI ((:&:) (n :: a) (n :: a)) where sing = ((:%&:) sing) sing instance SingI ((:&:@#@$) :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(:&:@#@$)) (:%&:) instance SingI (TyCon2 (:&:) :: (~>) a ((~>) a (Foo2 a))) where sing = (singFun2 @(TyCon2 (:&:))) (:%&:) instance SingI d => SingI ((:&:@#@$$) (d :: a) :: (~>) a (Foo2 a)) where sing = (singFun1 @((:&:@#@$$) (d :: a))) ((:%&:) (sing @d)) instance SingI d => SingI (TyCon1 ((:&:) (d :: a)) :: (~>) a (Foo2 a)) where sing = (singFun1 @(TyCon1 ((:&:) (d :: a)))) ((:%&:) (sing @d)) instance (SingI n, SingI n) => SingI (MkFoo3 (n :: Bool) (n :: Bool)) where sing = (SMkFoo3 sing) sing instance SingI (MkFoo3Sym0 :: (~>) Bool ((~>) Bool Foo3)) where sing = (singFun2 @MkFoo3Sym0) SMkFoo3 instance SingI (TyCon2 MkFoo3 :: (~>) Bool ((~>) Bool Foo3)) where sing = (singFun2 @(TyCon2 MkFoo3)) SMkFoo3 instance SingI d => SingI (MkFoo3Sym1 (d :: Bool) :: (~>) Bool Foo3) where sing = (singFun1 @(MkFoo3Sym1 (d :: Bool))) (SMkFoo3 (sing @d)) instance SingI d => SingI (TyCon1 (MkFoo3 (d :: Bool)) :: (~>) Bool Foo3) where sing = (singFun1 @(TyCon1 (MkFoo3 (d :: Bool)))) (SMkFoo3 (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/ShowDeriving.hs0000755000000000000000000000174007346545000023470 0ustar0000000000000000module Singletons.ShowDeriving where import Data.Type.Equality import Data.Singletons.Prelude import Data.Singletons.Prelude.Show import Data.Singletons.TH $(singletons [d| data Foo1 = MkFoo1 deriving Show infixl 5 `MkFoo2b`, :*:, :&: data Foo2 a = MkFoo2a a a | a `MkFoo2b` a | (:*:) a a | a :&: a deriving Show data Foo3 = MkFoo3 { getFoo3a :: Bool, (***) :: Bool } deriving Show |]) foo1 :: "MkFoo1" :~: Show_ MkFoo1 foo1 = Refl foo2a :: "(MkFoo2a LT GT)" :~: ShowsPrec 11 (MkFoo2a LT GT) "" foo2a = Refl foo2b :: "True `MkFoo2b` False" :~: Show_ (True `MkFoo2b` False) foo2b = Refl foo2c :: "(:*:) () ()" :~: Show_ ('() :*: '()) foo2c = Refl foo2d' :: "False :&: True" :~: ShowsPrec 5 (False :&: True) "" foo2d' = Refl foo2d'' :: "(False :&: True)" :~: ShowsPrec 6 (False :&: True) "" foo2d'' = Refl foo3 :: "MkFoo3 {getFoo3a = True, (***) = False}" :~: Show_ (MkFoo3 True False) foo3 = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template0000755000000000000000000006751707346545000026775 0ustar0000000000000000Singletons/StandaloneDeriving.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixl 6 :*: data T a b = a :*: b data S = S1 | S2 deriving instance Enum S deriving instance Bounded S deriving instance Show S deriving instance Ord S deriving instance Eq S deriving instance Show a => Show (T a ()) deriving instance Ord a => Ord (T a ()) deriving instance Eq a => Eq (T a ()) |] ======> infixl 6 :*: data T a b = a :*: b data S = S1 | S2 deriving instance Eq a => Eq (T a ()) deriving instance Ord a => Ord (T a ()) deriving instance Show a => Show (T a ()) deriving instance Eq S deriving instance Ord S deriving instance Show S deriving instance Bounded S deriving instance Enum S type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = (:*:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210) where (::*:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 infixl 6 :*:@#@$$ instance SuppressUnusedWarnings (:*:@#@$) where suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (T a0123456789876543210 b0123456789876543210)) where (::*:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => (:*:@#@$) t0123456789876543210 type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 infixl 6 :*:@#@$ type S1Sym0 = S1 type S2Sym0 = S2 type family Compare_0123456789876543210 (a :: T a ()) (a :: T a ()) :: Ordering where Compare_0123456789876543210 ((:*:) a_0123456789876543210 a_0123456789876543210) ((:*:) b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: T a0123456789876543210 ()) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) (T a0123456789876543210 ()) Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) (T a0123456789876543210 ()) ((~>) (T a0123456789876543210 ()) Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd (T a ()) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T a ()) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 p_0123456789876543210 ((:*:) argL_0123456789876543210 argR_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 6))) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argL_0123456789876543210)) (Apply (Apply (.@#@$) (Apply ShowStringSym0 " :*: ")) (Apply (Apply ShowsPrecSym0 (FromInteger 7)) argR_0123456789876543210)))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T a0123456789876543210 ()) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. (~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) GHC.Types.Nat ((~>) (T a0123456789876543210 ()) ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (T a ()) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Compare_0123456789876543210 (a :: S) (a :: S) :: Ordering where Compare_0123456789876543210 S1 S1 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 S2 S2 = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 S1 S2 = LTSym0 Compare_0123456789876543210 S2 S1 = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: S) (a0123456789876543210 :: S) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: S) :: (~>) S Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) S ((~>) S Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd S where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: S) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ S1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S1") a_0123456789876543210 ShowsPrec_0123456789876543210 _ S2 a_0123456789876543210 = Apply (Apply ShowStringSym0 "S2") a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: S) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) S ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow S where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family MinBound_0123456789876543210 :: S where MinBound_0123456789876543210 = S1Sym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: S where MaxBound_0123456789876543210 = S2Sym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded S where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = S2Sym0 Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = S1Sym0 Case_0123456789876543210 n 'False = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: S where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0)) type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat S where ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where FromEnum_0123456789876543210 S1 = FromInteger 0 FromEnum_0123456789876543210 S2 = FromInteger 1 type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: S) = FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) data FromEnum_0123456789876543210Sym0 :: (~>) S GHC.Types.Nat where FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 instance PEnum S where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a type family Equals_0123456789876543210 (a :: T a ()) (b :: T a ()) :: Bool where Equals_0123456789876543210 ((:*:) a a) ((:*:) b b) = (&&) ((==) a b) ((==) a b) Equals_0123456789876543210 (_ :: T a ()) (_ :: T a ()) = FalseSym0 instance PEq (T a ()) where type (==) a b = Equals_0123456789876543210 a b type family Equals_0123456789876543210 (a :: S) (b :: S) :: Bool where Equals_0123456789876543210 S1 S1 = TrueSym0 Equals_0123456789876543210 S2 S2 = TrueSym0 Equals_0123456789876543210 (_ :: S) (_ :: S) = FalseSym0 instance PEq S where type (==) a b = Equals_0123456789876543210 a b infixl 6 :%*: data instance Sing :: T a b -> GHC.Types.Type where (:%*:) :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) type ST = (Sing :: T a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (T a b) where type Demote (T a b) = T (Demote a) (Demote b) fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) toSing ((:*:) (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } data instance Sing :: S -> GHC.Types.Type where SS1 :: Sing S1 SS2 :: Sing S2 type SS = (Sing :: S -> GHC.Types.Type) instance SingKind S where type Demote S = S fromSing SS1 = S1 fromSing SS2 = S2 toSing S1 = SomeSing SS1 toSing S2 = SomeSing SS2 instance SOrd a => SOrd (T a ()) where sCompare :: forall (t1 :: T a ()) (t2 :: T a ()). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun (T a ()) ((~>) (T a ()) Ordering) -> GHC.Types.Type) t1) t2) sCompare ((:%*:) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) ((:%*:) (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)) instance SShow a => SShow (T a ()) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: T a ()) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (T a ()) ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) ((:%*:) (sArgL_0123456789876543210 :: Sing argL_0123456789876543210) (sArgR_0123456789876543210 :: Sing argR_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 6))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 7)))) sArgL_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing " :*: ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 7)))) sArgR_0123456789876543210))))) sA_0123456789876543210 instance SOrd S where sCompare :: forall (t1 :: S) (t2 :: S). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun S ((~>) S Ordering) -> GHC.Types.Type) t1) t2) sCompare SS1 SS1 = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare SS2 SS2 = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare SS1 SS2 = SLT sCompare SS2 SS1 = SGT instance SShow S where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: S) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) S ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ SS1 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "S1"))) sA_0123456789876543210 sShowsPrec _ SS2 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "S2"))) sA_0123456789876543210 instance SBounded S where sMinBound :: Sing (MinBoundSym0 :: S) sMaxBound :: Sing (MaxBoundSym0 :: S) sMinBound = SS1 sMaxBound = SS2 instance SEnum S where sToEnum :: forall (t :: GHC.Types.Nat). Sing t -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat S -> GHC.Types.Type) t) sFromEnum :: forall (t :: S). Sing t -> Sing (Apply (FromEnumSym0 :: TyFun S GHC.Types.Nat -> GHC.Types.Type) t) sToEnum (sN :: Sing n) = (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (sFromInteger (sing :: Sing 0)) of STrue -> SS1 SFalse -> (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (sFromInteger (sing :: Sing 1)) of STrue -> SS2 SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 1)))) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (FromInteger 0))) sFromEnum SS1 = sFromInteger (sing :: Sing 0) sFromEnum SS2 = sFromInteger (sing :: Sing 1) instance SEq a => SEq (T a ()) where (%==) ((:%*:) a a) ((:%*:) b b) = ((%&&) (((%==) a) b)) (((%==) a) b) instance SDecide a => SDecide (T a ()) where (%~) ((:%*:) a a) ((:%*:) b b) = case ((,) (((%~) a) b)) (((%~) a) b) of (,) (Proved Refl) (Proved Refl) -> Proved Refl (,) (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,) _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SEq S where (%==) SS1 SS1 = STrue (%==) SS1 SS2 = SFalse (%==) SS2 SS1 = SFalse (%==) SS2 SS2 = STrue instance SDecide S where (%~) SS1 SS1 = Proved Refl (%~) SS1 SS2 = Disproved (\ x -> case x of) (%~) SS2 SS1 = Disproved (\ x -> case x of) (%~) SS2 SS2 = Proved Refl deriving instance Data.Singletons.ShowSing.ShowSing a => Show (Sing (z :: T a ())) deriving instance Show (Sing (z :: S)) instance (SingI n, SingI n) => SingI ((:*:) (n :: a) (n :: b)) where sing = ((:%*:) sing) sing instance SingI ((:*:@#@$) :: (~>) a ((~>) b (T a b))) where sing = (singFun2 @(:*:@#@$)) (:%*:) instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b (T a b))) where sing = (singFun2 @(TyCon2 (:*:))) (:%*:) instance SingI d => SingI ((:*:@#@$$) (d :: a) :: (~>) b (T a b)) where sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) instance SingI d => SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b (T a b)) where sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) instance SingI S1 where sing = SS1 instance SingI S2 where sing = SS2 singletons-2.5.1/tests/compile-and-dump/Singletons/StandaloneDeriving.hs0000755000000000000000000000122507346545000024636 0ustar0000000000000000module Singletons.StandaloneDeriving where import Data.Singletons.Prelude import Data.Singletons.Prelude.Show import Data.Singletons.TH $(singletons [d| infixl 6 :*: data T a b = a :*: b data S = S1 | S2 deriving instance Eq a => Eq (T a ()) deriving instance Ord a => Ord (T a ()) deriving instance Show a => Show (T a ()) deriving instance Eq S deriving instance Ord S deriving instance Show S deriving instance Bounded S deriving instance Enum S |]) -- Ensure that the fixity is discovered test1 :: "() :*: ()" :~: ShowsPrec 6 ('() :*: '()) "" test1 = Refl test2 :: "(() :*: ())" :~: ShowsPrec 7 ('() :*: '()) "" test2 = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/Star.ghc86.template0000755000000000000000000005735207346545000024122 0ustar0000000000000000Singletons/Star.hs:0:0:: Splicing declarations singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec] ======> data Rep :: Type where Singletons.Star.Nat :: Rep Singletons.Star.Int :: Rep Singletons.Star.String :: Rep Singletons.Star.Maybe :: Rep -> Rep Singletons.Star.Vec :: Rep -> Nat -> Rep deriving (Eq, Ord, Read, Show) type NatSym0 = Nat type IntSym0 = Int type StringSym0 = String type MaybeSym1 (t0123456789876543210 :: Type) = Maybe t0123456789876543210 instance SuppressUnusedWarnings MaybeSym0 where suppressUnusedWarnings = snd (((,) MaybeSym0KindInference) ()) data MaybeSym0 :: (~>) Type Type where MaybeSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) => MaybeSym0 t0123456789876543210 type instance Apply MaybeSym0 t0123456789876543210 = Maybe t0123456789876543210 type VecSym2 (t0123456789876543210 :: Type) (t0123456789876543210 :: Nat) = Vec t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (VecSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) VecSym1KindInference) ()) data VecSym1 (t0123456789876543210 :: Type) :: (~>) Nat Type where VecSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (VecSym1 t0123456789876543210) arg) (VecSym2 t0123456789876543210 arg) => VecSym1 t0123456789876543210 t0123456789876543210 type instance Apply (VecSym1 t0123456789876543210) t0123456789876543210 = Vec t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings VecSym0 where suppressUnusedWarnings = snd (((,) VecSym0KindInference) ()) data VecSym0 :: (~>) Type ((~>) Nat Type) where VecSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) => VecSym0 t0123456789876543210 type instance Apply VecSym0 t0123456789876543210 = VecSym1 t0123456789876543210 type family Equals_0123456789876543210 (a :: Type) (b :: Type) :: Bool where Equals_0123456789876543210 Nat Nat = TrueSym0 Equals_0123456789876543210 Int Int = TrueSym0 Equals_0123456789876543210 String String = TrueSym0 Equals_0123456789876543210 (Maybe a) (Maybe b) = (==) a b Equals_0123456789876543210 (Vec a a) (Vec b b) = (&&) ((==) a b) ((==) a b) Equals_0123456789876543210 (_ :: Type) (_ :: Type) = FalseSym0 instance PEq Type where type (==) a b = Equals_0123456789876543210 a b type family Compare_0123456789876543210 (a :: Type) (a :: Type) :: Ordering where Compare_0123456789876543210 Nat Nat = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 Int Int = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 String String = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 (Maybe a_0123456789876543210) (Maybe b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) Compare_0123456789876543210 (Vec a_0123456789876543210 a_0123456789876543210) (Vec b_0123456789876543210 b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[])) Compare_0123456789876543210 Nat Int = LTSym0 Compare_0123456789876543210 Nat String = LTSym0 Compare_0123456789876543210 Nat (Maybe _) = LTSym0 Compare_0123456789876543210 Nat (Vec _ _) = LTSym0 Compare_0123456789876543210 Int Nat = GTSym0 Compare_0123456789876543210 Int String = LTSym0 Compare_0123456789876543210 Int (Maybe _) = LTSym0 Compare_0123456789876543210 Int (Vec _ _) = LTSym0 Compare_0123456789876543210 String Nat = GTSym0 Compare_0123456789876543210 String Int = GTSym0 Compare_0123456789876543210 String (Maybe _) = LTSym0 Compare_0123456789876543210 String (Vec _ _) = LTSym0 Compare_0123456789876543210 (Maybe _) Nat = GTSym0 Compare_0123456789876543210 (Maybe _) Int = GTSym0 Compare_0123456789876543210 (Maybe _) String = GTSym0 Compare_0123456789876543210 (Maybe _) (Vec _ _) = LTSym0 Compare_0123456789876543210 (Vec _ _) Nat = GTSym0 Compare_0123456789876543210 (Vec _ _) Int = GTSym0 Compare_0123456789876543210 (Vec _ _) String = GTSym0 Compare_0123456789876543210 (Vec _ _) (Maybe _) = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Type) (a0123456789876543210 :: Type) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Type) :: (~>) Type Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Type ((~>) Type Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Type where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Type) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ Nat a_0123456789876543210 = Apply (Apply ShowStringSym0 "Nat") a_0123456789876543210 ShowsPrec_0123456789876543210 _ Int a_0123456789876543210 = Apply (Apply ShowStringSym0 "Int") a_0123456789876543210 ShowsPrec_0123456789876543210 _ String a_0123456789876543210 = Apply (Apply ShowStringSym0 "String") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Maybe arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Maybe ")) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Vec arg_0123456789876543210 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Vec ")) (Apply (Apply (.@#@$) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210)) (Apply (Apply (.@#@$) ShowSpaceSym0) (Apply (Apply ShowsPrecSym0 (FromInteger 11)) arg_0123456789876543210))))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Type) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) Type ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Type where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data instance Sing :: Type -> Type where SNat :: Sing Nat SInt :: Sing Int SString :: Sing String SMaybe :: forall (n :: Type). (Sing (n :: Type)) -> Sing (Maybe n) SVec :: forall (n :: Type) (n :: Nat). (Sing (n :: Type)) -> (Sing (n :: Nat)) -> Sing (Vec n n) type SRep = (Sing :: Type -> Type) instance SingKind Type where type Demote Type = Rep fromSing SNat = Singletons.Star.Nat fromSing SInt = Singletons.Star.Int fromSing SString = Singletons.Star.String fromSing (SMaybe b) = Singletons.Star.Maybe (fromSing b) fromSing (SVec b b) = (Singletons.Star.Vec (fromSing b)) (fromSing b) toSing Singletons.Star.Nat = SomeSing SNat toSing Singletons.Star.Int = SomeSing SInt toSing Singletons.Star.String = SomeSing SString toSing (Singletons.Star.Maybe (b :: Demote Type)) = case toSing b :: SomeSing Type of { SomeSing c -> SomeSing (SMaybe c) } toSing (Singletons.Star.Vec (b :: Demote Type) (b :: Demote Nat)) = case ((,) (toSing b :: SomeSing Type)) (toSing b :: SomeSing Nat) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SVec c) c) } instance (SEq Type, SEq Nat) => SEq Type where (%==) SNat SNat = STrue (%==) SNat SInt = SFalse (%==) SNat SString = SFalse (%==) SNat (SMaybe _) = SFalse (%==) SNat (SVec _ _) = SFalse (%==) SInt SNat = SFalse (%==) SInt SInt = STrue (%==) SInt SString = SFalse (%==) SInt (SMaybe _) = SFalse (%==) SInt (SVec _ _) = SFalse (%==) SString SNat = SFalse (%==) SString SInt = SFalse (%==) SString SString = STrue (%==) SString (SMaybe _) = SFalse (%==) SString (SVec _ _) = SFalse (%==) (SMaybe _) SNat = SFalse (%==) (SMaybe _) SInt = SFalse (%==) (SMaybe _) SString = SFalse (%==) (SMaybe a) (SMaybe b) = ((%==) a) b (%==) (SMaybe _) (SVec _ _) = SFalse (%==) (SVec _ _) SNat = SFalse (%==) (SVec _ _) SInt = SFalse (%==) (SVec _ _) SString = SFalse (%==) (SVec _ _) (SMaybe _) = SFalse (%==) (SVec a a) (SVec b b) = ((%&&) (((%==) a) b)) (((%==) a) b) instance (SDecide Type, SDecide Nat) => SDecide Type where (%~) SNat SNat = Proved Refl (%~) SNat SInt = Disproved (\ x -> case x of) (%~) SNat SString = Disproved (\ x -> case x of) (%~) SNat (SMaybe _) = Disproved (\ x -> case x of) (%~) SNat (SVec _ _) = Disproved (\ x -> case x of) (%~) SInt SNat = Disproved (\ x -> case x of) (%~) SInt SInt = Proved Refl (%~) SInt SString = Disproved (\ x -> case x of) (%~) SInt (SMaybe _) = Disproved (\ x -> case x of) (%~) SInt (SVec _ _) = Disproved (\ x -> case x of) (%~) SString SNat = Disproved (\ x -> case x of) (%~) SString SInt = Disproved (\ x -> case x of) (%~) SString SString = Proved Refl (%~) SString (SMaybe _) = Disproved (\ x -> case x of) (%~) SString (SVec _ _) = Disproved (\ x -> case x of) (%~) (SMaybe _) SNat = Disproved (\ x -> case x of) (%~) (SMaybe _) SInt = Disproved (\ x -> case x of) (%~) (SMaybe _) SString = Disproved (\ x -> case x of) (%~) (SMaybe a) (SMaybe b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (%~) (SMaybe _) (SVec _ _) = Disproved (\ x -> case x of) (%~) (SVec _ _) SNat = Disproved (\ x -> case x of) (%~) (SVec _ _) SInt = Disproved (\ x -> case x of) (%~) (SVec _ _) SString = Disproved (\ x -> case x of) (%~) (SVec _ _) (SMaybe _) = Disproved (\ x -> case x of) (%~) (SVec a a) (SVec b b) = case ((,) (((%~) a) b)) (((%~) a) b) of (,) (Proved Refl) (Proved Refl) -> Proved Refl (,) (Disproved contra) _ -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) (,) _ (Disproved contra) -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance (SOrd Type, SOrd Nat) => SOrd Type where sCompare :: forall (t1 :: Type) (t2 :: Type). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Type ((~>) Type Ordering) -> Type) t1) t2) sCompare SNat SNat = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare SInt SInt = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare SString SString = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) SNil sCompare (SMaybe (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SMaybe (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil) sCompare (SVec (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SVec (sB_0123456789876543210 :: Sing b_0123456789876543210) (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) SNil)) sCompare SNat SInt = SLT sCompare SNat SString = SLT sCompare SNat (SMaybe _) = SLT sCompare SNat (SVec _ _) = SLT sCompare SInt SNat = SGT sCompare SInt SString = SLT sCompare SInt (SMaybe _) = SLT sCompare SInt (SVec _ _) = SLT sCompare SString SNat = SGT sCompare SString SInt = SGT sCompare SString (SMaybe _) = SLT sCompare SString (SVec _ _) = SLT sCompare (SMaybe _) SNat = SGT sCompare (SMaybe _) SInt = SGT sCompare (SMaybe _) SString = SGT sCompare (SMaybe _) (SVec _ _) = SLT sCompare (SVec _ _) SNat = SGT sCompare (SVec _ _) SInt = SGT sCompare (SVec _ _) SString = SGT sCompare (SVec _ _) (SMaybe _) = SGT instance (SShow Type, SShow Nat) => SShow Type where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Type) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) Type ((~>) Symbol Symbol)) -> Type) t1) t2) t3) sShowsPrec _ SNat (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Nat"))) sA_0123456789876543210 sShowsPrec _ SInt (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Int"))) sA_0123456789876543210 sShowsPrec _ SString (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "String"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SMaybe (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Maybe ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SVec (sArg_0123456789876543210 :: Sing arg_0123456789876543210) (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Vec ")))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @ShowSpaceSym0) sShowSpace))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))))) sA_0123456789876543210 instance SingI Nat where sing = SNat instance SingI Int where sing = SInt instance SingI String where sing = SString instance SingI n => SingI (Maybe (n :: Type)) where sing = SMaybe sing instance SingI (MaybeSym0 :: (~>) Type Type) where sing = (singFun1 @MaybeSym0) SMaybe instance SingI (TyCon1 Maybe :: (~>) Type Type) where sing = (singFun1 @(TyCon1 Maybe)) SMaybe instance (SingI n, SingI n) => SingI (Vec (n :: Type) (n :: Nat)) where sing = (SVec sing) sing instance SingI (VecSym0 :: (~>) Type ((~>) Nat Type)) where sing = (singFun2 @VecSym0) SVec instance SingI (TyCon2 Vec :: (~>) Type ((~>) Nat Type)) where sing = (singFun2 @(TyCon2 Vec)) SVec instance SingI d => SingI (VecSym1 (d :: Type) :: (~>) Nat Type) where sing = (singFun1 @(VecSym1 (d :: Type))) (SVec (sing @d)) instance SingI d => SingI (TyCon1 (Vec (d :: Type)) :: (~>) Nat Type) where sing = (singFun1 @(TyCon1 (Vec (d :: Type)))) (SVec (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/Star.hs0000755000000000000000000000051407346545000021767 0ustar0000000000000000module Singletons.Star where import Data.Singletons.Prelude import Data.Singletons.Decide import Data.Singletons.CustomStar import Singletons.Nat import Data.Kind (Type) data Vec :: Type -> Nat -> Type where VNil :: Vec a Zero VCons :: a -> Vec a n -> Vec a (Succ n) $(singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec]) singletons-2.5.1/tests/compile-and-dump/Singletons/T124.ghc86.template0000755000000000000000000000231207346545000023625 0ustar0000000000000000Singletons/T124.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: Bool -> () foo True = () foo False = () |] ======> foo :: Bool -> () foo True = () foo False = () type FooSym1 (a0123456789876543210 :: Bool) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool () where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Foo (a :: Bool) :: () where Foo 'True = Tuple0Sym0 Foo 'False = Tuple0Sym0 sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: ()) sFoo STrue = STuple0 sFoo SFalse = STuple0 instance SingI (FooSym0 :: (~>) Bool ()) where sing = (singFun1 @FooSym0) sFoo Singletons/T124.hs:0:0:: Splicing expression sCases ''Bool [| b |] [| STuple0 |] ======> case b of SFalse -> STuple0 STrue -> STuple0 singletons-2.5.1/tests/compile-and-dump/Singletons/T124.hs0000755000000000000000000000036607346545000021515 0ustar0000000000000000module Singletons.T124 where import Data.Singletons.TH import Data.Singletons.Prelude $(singletons [d| foo :: Bool -> () foo True = () foo False = () |]) bar :: SBool b -> STuple0 (Foo b) bar b = $(sCases ''Bool [| b |] [| STuple0 |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T136.ghc86.template0000755000000000000000000002423307346545000023636 0ustar0000000000000000Singletons/T136.hs:(0,0)-(0,0): Splicing declarations singletons [d| instance Enum BiNat where succ [] = [True] succ (False : as) = True : as succ (True : as) = False : succ as pred [] = error "pred 0" pred (False : as) = True : pred as pred (True : as) = False : as toEnum i | i < 0 = error "negative toEnum" | i == 0 = [] | otherwise = succ (toEnum (pred i)) fromEnum [] = 0 fromEnum (False : as) = 2 * fromEnum as fromEnum (True : as) = 1 + 2 * fromEnum as |] ======> instance Enum BiNat where succ [] = [True] succ (False : as) = (True : as) succ (True : as) = (False : succ as) pred [] = error "pred 0" pred (False : as) = (True : pred as) pred (True : as) = (False : as) toEnum i | (i < 0) = error "negative toEnum" | (i == 0) = [] | otherwise = succ (toEnum (pred i)) fromEnum [] = 0 fromEnum (False : as) = (2 * fromEnum as) fromEnum (True : as) = (1 + (2 * fromEnum as)) type family Succ_0123456789876543210 (a :: [Bool]) :: [Bool] where Succ_0123456789876543210 '[] = Apply (Apply (:@#@$) TrueSym0) '[] Succ_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) as Succ_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) (Apply SuccSym0 as) type Succ_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = Succ_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Succ_0123456789876543210Sym0KindInference) ()) data Succ_0123456789876543210Sym0 :: (~>) [Bool] [Bool] where Succ_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) => Succ_0123456789876543210Sym0 a0123456789876543210 type instance Apply Succ_0123456789876543210Sym0 a0123456789876543210 = Succ_0123456789876543210 a0123456789876543210 type family Pred_0123456789876543210 (a :: [Bool]) :: [Bool] where Pred_0123456789876543210 '[] = Apply ErrorSym0 "pred 0" Pred_0123456789876543210 ( '(:) 'False as) = Apply (Apply (:@#@$) TrueSym0) (Apply PredSym0 as) Pred_0123456789876543210 ( '(:) 'True as) = Apply (Apply (:@#@$) FalseSym0) as type Pred_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = Pred_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Pred_0123456789876543210Sym0KindInference) ()) data Pred_0123456789876543210Sym0 :: (~>) [Bool] [Bool] where Pred_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) => Pred_0123456789876543210Sym0 a0123456789876543210 type instance Apply Pred_0123456789876543210Sym0 a0123456789876543210 = Pred_0123456789876543210 a0123456789876543210 type family Case_0123456789876543210 i arg_0123456789876543210 t where Case_0123456789876543210 i arg_0123456789876543210 'True = '[] Case_0123456789876543210 i arg_0123456789876543210 'False = Apply SuccSym0 (Apply ToEnumSym0 (Apply PredSym0 i)) type family Case_0123456789876543210 i arg_0123456789876543210 t where Case_0123456789876543210 i arg_0123456789876543210 'True = Apply ErrorSym0 "negative toEnum" Case_0123456789876543210 i arg_0123456789876543210 'False = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)) type family Case_0123456789876543210 arg_0123456789876543210 t where Case_0123456789876543210 arg_0123456789876543210 i = Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0)) type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: [Bool] where ToEnum_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210 type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat [Bool] where ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: [Bool]) :: GHC.Types.Nat where FromEnum_0123456789876543210 '[] = FromInteger 0 FromEnum_0123456789876543210 ( '(:) 'False as) = Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as) FromEnum_0123456789876543210 ( '(:) 'True as) = Apply (Apply (+@#@$) (FromInteger 1)) (Apply (Apply (*@#@$) (FromInteger 2)) (Apply FromEnumSym0 as)) type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: [Bool]) = FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) data FromEnum_0123456789876543210Sym0 :: (~>) [Bool] GHC.Types.Nat where FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 instance PEnum [Bool] where type Succ a = Apply Succ_0123456789876543210Sym0 a type Pred a = Apply Pred_0123456789876543210Sym0 a type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a instance SEnum [Bool] where sSucc :: forall (t :: [Bool]). Sing t -> Sing (Apply (SuccSym0 :: TyFun [Bool] [Bool] -> GHC.Types.Type) t) sPred :: forall (t :: [Bool]). Sing t -> Sing (Apply (PredSym0 :: TyFun [Bool] [Bool] -> GHC.Types.Type) t) sToEnum :: forall (t :: GHC.Types.Nat). Sing t -> Sing (Apply (ToEnumSym0 :: TyFun GHC.Types.Nat [Bool] -> GHC.Types.Type) t) sFromEnum :: forall (t :: [Bool]). Sing t -> Sing (Apply (FromEnumSym0 :: TyFun [Bool] GHC.Types.Nat -> GHC.Types.Type) t) sSucc SNil = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) SNil sSucc (SCons SFalse (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) sAs sSucc (SCons STrue (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) ((applySing ((singFun1 @SuccSym0) sSucc)) sAs) sPred SNil = sError (sing :: Sing "pred 0") sPred (SCons SFalse (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) STrue)) ((applySing ((singFun1 @PredSym0) sPred)) sAs) sPred (SCons STrue (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) SFalse)) sAs sToEnum (sArg_0123456789876543210 :: Sing arg_0123456789876543210) = (case sArg_0123456789876543210 of { (sI :: Sing i) -> (case (applySing ((applySing ((singFun2 @(<@#@$)) (%<))) sI)) (sFromInteger (sing :: Sing 0)) of STrue -> sError (sing :: Sing "negative toEnum") SFalse -> (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sI)) (sFromInteger (sing :: Sing 0)) of STrue -> SNil SFalse -> (applySing ((singFun1 @SuccSym0) sSucc)) ((applySing ((singFun1 @ToEnumSym0) sToEnum)) ((applySing ((singFun1 @PredSym0) sPred)) sI))) :: Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (==@#@$) i) (FromInteger 0)))) :: Sing (Case_0123456789876543210 i arg_0123456789876543210 (Apply (Apply (<@#@$) i) (FromInteger 0))) }) :: Sing (Case_0123456789876543210 arg_0123456789876543210 arg_0123456789876543210) sFromEnum SNil = sFromInteger (sing :: Sing 0) sFromEnum (SCons SFalse (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(*@#@$)) (%*))) (sFromInteger (sing :: Sing 2)))) ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs) sFromEnum (SCons STrue (sAs :: Sing as)) = (applySing ((applySing ((singFun2 @(+@#@$)) (%+))) (sFromInteger (sing :: Sing 1)))) ((applySing ((applySing ((singFun2 @(*@#@$)) (%*))) (sFromInteger (sing :: Sing 2)))) ((applySing ((singFun1 @FromEnumSym0) sFromEnum)) sAs)) singletons-2.5.1/tests/compile-and-dump/Singletons/T136.hs0000755000000000000000000000166507346545000021523 0ustar0000000000000000{-# LANGUAGE GADTs, DataKinds, PolyKinds, TypeFamilies, KindSignatures #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE InstanceSigs, DefaultSignatures #-} module Binary where import Data.Singletons.TH import Data.Singletons.Prelude import Data.Singletons.Prelude.Enum import Data.Singletons.Prelude.Num type Bit = Bool type BiNat = [Bit] $(singletons [d| instance Enum BiNat where succ [] = [True] succ (False:as) = True : as succ (True:as) = False : succ as pred [] = error "pred 0" pred (False:as) = True : pred as pred (True:as) = False : as toEnum i | i < 0 = error "negative toEnum" | i == 0 = [] | otherwise = succ (toEnum (pred i)) fromEnum [] = 0 fromEnum (False:as) = 2 * fromEnum as fromEnum (True:as) = 1 + 2 * fromEnum as |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T136b.ghc86.template0000755000000000000000000000511707346545000024000 0ustar0000000000000000Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations singletons [d| class C a where meth :: a -> a |] ======> class C a where meth :: a -> a type MethSym1 (arg0123456789876543210 :: a0123456789876543210) = Meth arg0123456789876543210 instance SuppressUnusedWarnings MethSym0 where suppressUnusedWarnings = snd (((,) MethSym0KindInference) ()) data MethSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where MethSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) => MethSym0 arg0123456789876543210 type instance Apply MethSym0 arg0123456789876543210 = Meth arg0123456789876543210 class PC (a :: GHC.Types.Type) where type Meth (arg :: a) :: a class SC a where sMeth :: forall (t :: a). Sing t -> Sing (Apply MethSym0 t :: a) instance SC a => SingI (MethSym0 :: (~>) a a) where sing = (singFun1 @MethSym0) sMeth Singletons/T136b.hs:(0,0)-(0,0): Splicing declarations singletons [d| instance C Bool where meth = not |] ======> instance C Bool where meth = not type family Meth_0123456789876543210 (a :: Bool) :: Bool where Meth_0123456789876543210 a_0123456789876543210 = Apply NotSym0 a_0123456789876543210 type Meth_0123456789876543210Sym1 (a0123456789876543210 :: Bool) = Meth_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Meth_0123456789876543210Sym0KindInference) ()) data Meth_0123456789876543210Sym0 :: (~>) Bool Bool where Meth_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) => Meth_0123456789876543210Sym0 a0123456789876543210 type instance Apply Meth_0123456789876543210Sym0 a0123456789876543210 = Meth_0123456789876543210 a0123456789876543210 instance PC Bool where type Meth a = Apply Meth_0123456789876543210Sym0 a instance SC Bool where sMeth :: forall (t :: Bool). Sing t -> Sing (Apply (MethSym0 :: TyFun Bool Bool -> GHC.Types.Type) t) sMeth (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @NotSym0) sNot)) sA_0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Singletons/T136b.hs0000755000000000000000000000031607346545000021655 0ustar0000000000000000module T136b where import Data.Singletons.TH import Data.Singletons.Prelude.Bool $(singletons [d| class C a where meth :: a -> a |]) $(singletons [d| instance C Bool where meth = not |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T145.ghc86.template0000755000000000000000000000444307346545000023637 0ustar0000000000000000Singletons/T145.hs:(0,0)-(0,0): Splicing declarations singletons [d| class Column (f :: Type -> Type) where col :: f a -> a -> Bool |] ======> class Column (f :: Type -> Type) where col :: f a -> a -> Bool type ColSym2 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = Col arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (ColSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) ColSym1KindInference) ()) data ColSym1 (arg0123456789876543210 :: f0123456789876543210 a0123456789876543210) :: (~>) a0123456789876543210 Bool where ColSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (ColSym1 arg0123456789876543210) arg) (ColSym2 arg0123456789876543210 arg) => ColSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (ColSym1 arg0123456789876543210) arg0123456789876543210 = Col arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ColSym0 where suppressUnusedWarnings = snd (((,) ColSym0KindInference) ()) data ColSym0 :: forall a0123456789876543210 f0123456789876543210. (~>) (f0123456789876543210 a0123456789876543210) ((~>) a0123456789876543210 Bool) where ColSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) => ColSym0 arg0123456789876543210 type instance Apply ColSym0 arg0123456789876543210 = ColSym1 arg0123456789876543210 class PColumn (f :: Type -> Type) where type Col (arg :: f a) (arg :: a) :: Bool class SColumn (f :: Type -> Type) where sCol :: forall a (t :: f a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool) instance SColumn f => SingI (ColSym0 :: (~>) (f a) ((~>) a Bool)) where sing = (singFun2 @ColSym0) sCol instance (SColumn f, SingI d) => SingI (ColSym1 (d :: f a) :: (~>) a Bool) where sing = (singFun1 @(ColSym1 (d :: f a))) (sCol (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T145.hs0000755000000000000000000000025507346545000021515 0ustar0000000000000000module Singletons.T145 where import Data.Singletons.TH import Data.Kind (Type) $(singletons [d| class Column (f :: Type -> Type) where col :: f a -> a -> Bool |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T153.ghc86.template0000755000000000000000000000000007346545000023617 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/T153.hs0000755000000000000000000000046507346545000021517 0ustar0000000000000000{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeApplications, RankNTypes #-} module Singletons.T153 where import Data.Singletons import Data.Singletons.Prelude foo :: Int foo = withSomeSing @(Maybe Bool) (Just True) $ \case SJust STrue -> 0 SJust SFalse -> 1 SNothing -> 2 singletons-2.5.1/tests/compile-and-dump/Singletons/T157.ghc86.template0000755000000000000000000000000007346545000023623 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/T157.hs0000755000000000000000000000016607346545000021521 0ustar0000000000000000module T157 where import Data.Singletons.Prelude foo :: SList '["a", "b", "c"] foo = sing `SCons` sing `SCons` sing singletons-2.5.1/tests/compile-and-dump/Singletons/T159.ghc86.template0000755000000000000000000002606407346545000023647 0ustar0000000000000000Singletons/T159.hs:0:0:: Splicing declarations genSingletons [''T0, ''T1] ======> type ASym0 = 'A type BSym0 = 'B type CSym0 = 'C type DSym0 = 'D type ESym0 = 'E type FSym0 = 'F data instance Sing :: T0 -> GHC.Types.Type where SA :: Sing 'A SB :: Sing 'B SC :: Sing 'C SD :: Sing 'D SE :: Sing 'E SF :: Sing 'F type ST0 = (Sing :: T0 -> GHC.Types.Type) instance SingKind T0 where type Demote T0 = T0 fromSing SA = A fromSing SB = B fromSing SC = C fromSing SD = D fromSing SE = E fromSing SF = F toSing A = SomeSing SA toSing B = SomeSing SB toSing C = SomeSing SC toSing D = SomeSing SD toSing E = SomeSing SE toSing F = SomeSing SF instance SingI 'A where sing = SA instance SingI 'B where sing = SB instance SingI 'C where sing = SC instance SingI 'D where sing = SD instance SingI 'E where sing = SE instance SingI 'F where sing = SF type N1Sym0 = 'N1 type C1Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = 'C1 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (C1Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) C1Sym1KindInference) ()) data C1Sym1 (t0123456789876543210 :: T0) :: (~>) T1 T1 where C1Sym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (C1Sym1 t0123456789876543210) arg) (C1Sym2 t0123456789876543210 arg) => C1Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (C1Sym1 t0123456789876543210) t0123456789876543210 = 'C1 t0123456789876543210 t0123456789876543210 infixr 5 `C1Sym1` instance SuppressUnusedWarnings C1Sym0 where suppressUnusedWarnings = snd (((,) C1Sym0KindInference) ()) data C1Sym0 :: (~>) T0 ((~>) T1 T1) where C1Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) => C1Sym0 t0123456789876543210 type instance Apply C1Sym0 t0123456789876543210 = C1Sym1 t0123456789876543210 infixr 5 `C1Sym0` type (:&&@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T1) = '(:&&) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:&&@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::&&@#@$$###)) ()) data (:&&@#@$$) (t0123456789876543210 :: T0) :: (~>) T1 T1 where (::&&@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:&&@#@$$) t0123456789876543210) arg) ((:&&@#@$$$) t0123456789876543210 arg) => (:&&@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:&&@#@$$) t0123456789876543210) t0123456789876543210 = '(:&&) t0123456789876543210 t0123456789876543210 infixr 5 :&&@#@$$ instance SuppressUnusedWarnings (:&&@#@$) where suppressUnusedWarnings = snd (((,) (::&&@#@$###)) ()) data (:&&@#@$) :: (~>) T0 ((~>) T1 T1) where (::&&@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) => (:&&@#@$) t0123456789876543210 type instance Apply (:&&@#@$) t0123456789876543210 = (:&&@#@$$) t0123456789876543210 infixr 5 :&&@#@$ data instance Sing :: T1 -> GHC.Types.Type where SN1 :: Sing 'N1 SC1 :: forall (n :: T0) (n :: T1). (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( 'C1 n n) (:%&&) :: forall (n :: T0) (n :: T1). (Sing (n :: T0)) -> (Sing (n :: T1)) -> Sing ( '(:&&) n n) type ST1 = (Sing :: T1 -> GHC.Types.Type) instance SingKind T1 where type Demote T1 = T1 fromSing SN1 = N1 fromSing (SC1 b b) = (C1 (fromSing b)) (fromSing b) fromSing ((:%&&) b b) = ((:&&) (fromSing b)) (fromSing b) toSing N1 = SomeSing SN1 toSing (C1 (b :: Demote T0) (b :: Demote T1)) = case ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) } toSing ((:&&) (b :: Demote T0) (b :: Demote T1)) = case ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%&&) c) c) } infixr 5 `SC1` infixr 5 :%&& instance SingI 'N1 where sing = SN1 instance (SingI n, SingI n) => SingI ( 'C1 (n :: T0) (n :: T1)) where sing = (SC1 sing) sing instance SingI (C1Sym0 :: (~>) T0 ((~>) T1 T1)) where sing = (singFun2 @C1Sym0) SC1 instance SingI (TyCon2 'C1 :: (~>) T0 ((~>) T1 T1)) where sing = (singFun2 @(TyCon2 'C1)) SC1 instance SingI d => SingI (C1Sym1 (d :: T0) :: (~>) T1 T1) where sing = (singFun1 @(C1Sym1 (d :: T0))) (SC1 (sing @d)) instance SingI d => SingI (TyCon1 ( 'C1 (d :: T0)) :: (~>) T1 T1) where sing = (singFun1 @(TyCon1 ( 'C1 (d :: T0)))) (SC1 (sing @d)) instance (SingI n, SingI n) => SingI ( '(:&&) (n :: T0) (n :: T1)) where sing = ((:%&&) sing) sing instance SingI ((:&&@#@$) :: (~>) T0 ((~>) T1 T1)) where sing = (singFun2 @(:&&@#@$)) (:%&&) instance SingI (TyCon2 '(:&&) :: (~>) T0 ((~>) T1 T1)) where sing = (singFun2 @(TyCon2 '(:&&))) (:%&&) instance SingI d => SingI ((:&&@#@$$) (d :: T0) :: (~>) T1 T1) where sing = (singFun1 @((:&&@#@$$) (d :: T0))) ((:%&&) (sing @d)) instance SingI d => SingI (TyCon1 ( '(:&&) (d :: T0)) :: (~>) T1 T1) where sing = (singFun1 @(TyCon1 ( '(:&&) (d :: T0)))) ((:%&&) (sing @d)) Singletons/T159.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixr 5 :|| infixr 5 `C2` data T2 = N2 | C2 T0 T2 | T0 :|| T2 |] ======> data T2 = N2 | C2 T0 T2 | T0 :|| T2 infixr 5 `C2` infixr 5 :|| type N2Sym0 = N2 type C2Sym2 (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = C2 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (C2Sym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) C2Sym1KindInference) ()) data C2Sym1 (t0123456789876543210 :: T0) :: (~>) T2 T2 where C2Sym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (C2Sym1 t0123456789876543210) arg) (C2Sym2 t0123456789876543210 arg) => C2Sym1 t0123456789876543210 t0123456789876543210 type instance Apply (C2Sym1 t0123456789876543210) t0123456789876543210 = C2 t0123456789876543210 t0123456789876543210 infixr 5 `C2Sym1` instance SuppressUnusedWarnings C2Sym0 where suppressUnusedWarnings = snd (((,) C2Sym0KindInference) ()) data C2Sym0 :: (~>) T0 ((~>) T2 T2) where C2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) => C2Sym0 t0123456789876543210 type instance Apply C2Sym0 t0123456789876543210 = C2Sym1 t0123456789876543210 infixr 5 `C2Sym0` type (:||@#@$$$) (t0123456789876543210 :: T0) (t0123456789876543210 :: T2) = (:||) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:||@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::||@#@$$###)) ()) data (:||@#@$$) (t0123456789876543210 :: T0) :: (~>) T2 T2 where (::||@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:||@#@$$) t0123456789876543210) arg) ((:||@#@$$$) t0123456789876543210 arg) => (:||@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:||@#@$$) t0123456789876543210) t0123456789876543210 = (:||) t0123456789876543210 t0123456789876543210 infixr 5 :||@#@$$ instance SuppressUnusedWarnings (:||@#@$) where suppressUnusedWarnings = snd (((,) (::||@#@$###)) ()) data (:||@#@$) :: (~>) T0 ((~>) T2 T2) where (::||@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) => (:||@#@$) t0123456789876543210 type instance Apply (:||@#@$) t0123456789876543210 = (:||@#@$$) t0123456789876543210 infixr 5 :||@#@$ infixr 5 `SC2` infixr 5 :%|| data instance Sing :: T2 -> GHC.Types.Type where SN2 :: Sing N2 SC2 :: forall (n :: T0) (n :: T2). (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing (C2 n n) (:%||) :: forall (n :: T0) (n :: T2). (Sing (n :: T0)) -> (Sing (n :: T2)) -> Sing ((:||) n n) type ST2 = (Sing :: T2 -> GHC.Types.Type) instance SingKind T2 where type Demote T2 = T2 fromSing SN2 = N2 fromSing (SC2 b b) = (C2 (fromSing b)) (fromSing b) fromSing ((:%||) b b) = ((:||) (fromSing b)) (fromSing b) toSing N2 = SomeSing SN2 toSing (C2 (b :: Demote T0) (b :: Demote T2)) = case ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) } toSing ((:||) (b :: Demote T0) (b :: Demote T2)) = case ((,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%||) c) c) } instance SingI N2 where sing = SN2 instance (SingI n, SingI n) => SingI (C2 (n :: T0) (n :: T2)) where sing = (SC2 sing) sing instance SingI (C2Sym0 :: (~>) T0 ((~>) T2 T2)) where sing = (singFun2 @C2Sym0) SC2 instance SingI (TyCon2 C2 :: (~>) T0 ((~>) T2 T2)) where sing = (singFun2 @(TyCon2 C2)) SC2 instance SingI d => SingI (C2Sym1 (d :: T0) :: (~>) T2 T2) where sing = (singFun1 @(C2Sym1 (d :: T0))) (SC2 (sing @d)) instance SingI d => SingI (TyCon1 (C2 (d :: T0)) :: (~>) T2 T2) where sing = (singFun1 @(TyCon1 (C2 (d :: T0)))) (SC2 (sing @d)) instance (SingI n, SingI n) => SingI ((:||) (n :: T0) (n :: T2)) where sing = ((:%||) sing) sing instance SingI ((:||@#@$) :: (~>) T0 ((~>) T2 T2)) where sing = (singFun2 @(:||@#@$)) (:%||) instance SingI (TyCon2 (:||) :: (~>) T0 ((~>) T2 T2)) where sing = (singFun2 @(TyCon2 (:||))) (:%||) instance SingI d => SingI ((:||@#@$$) (d :: T0) :: (~>) T2 T2) where sing = (singFun1 @((:||@#@$$) (d :: T0))) ((:%||) (sing @d)) instance SingI d => SingI (TyCon1 ((:||) (d :: T0)) :: (~>) T2 T2) where sing = (singFun1 @(TyCon1 ((:||) (d :: T0)))) ((:%||) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T159.hs0000755000000000000000000000067407346545000021527 0ustar0000000000000000module T159 where import Data.Singletons.TH data T0 = A | B | C | D | E | F deriving (Show) data T1 = N1 | C1 T0 T1 | T0 :&& T1 deriving (Show) infixr 5 `C1` infixr 5 :&& genSingletons [''T0, ''T1] singletons [d| data T2 = N2 | C2 T0 T2 | T0 :|| T2 infixr 5 `C2` infixr 5 :|| |] t1 :: T1 t1 = fromSing $ SA `SC1` SB `SC1` SD :%&& SE :%&& SF `SC1` SN1 t2 :: T2 t2 = fromSing $ SA `SC2` SB `SC2` SD :%|| SE :%|| SF `SC2` SN2 singletons-2.5.1/tests/compile-and-dump/Singletons/T160.ghc86.template0000755000000000000000000001075507346545000023637 0ustar0000000000000000Singletons/T160.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: (Num a, Eq a) => a -> a foo x = if x == 0 then 1 else typeError $ ShowType x |] ======> foo :: (Num a, Eq a) => a -> a foo x = if (x == 0) then 1 else (typeError $ ShowType x) type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = Apply (Apply (==@#@$) x) (FromInteger 0) type family Case_0123456789876543210 x t where Case_0123456789876543210 x 'True = FromInteger 1 Case_0123456789876543210 x 'False = Apply (Apply ($@#@$) TypeErrorSym0) (Apply ShowTypeSym0 x) type FooSym1 (a0123456789876543210 :: a0123456789876543210) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Foo (a :: a) :: a where Foo x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) sFoo :: forall a (t :: a). (SNum a, SEq a) => Sing t -> Sing (Apply FooSym0 t :: a) sFoo (sX :: Sing x) = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) sScrutinee_0123456789876543210 = (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sX)) (sFromInteger (sing :: Sing 0)) in (case sScrutinee_0123456789876543210 of STrue -> sFromInteger (sing :: Sing 1) SFalse -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) :: Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a) instance (SNum a, SEq a) => SingI (FooSym0 :: (~>) a a) where sing = (singFun1 @FooSym0) sFoo Singletons/T160.hs:0:0: error: • t • In the expression: (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX) In a case alternative: SFalse -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX) In the expression: (case sScrutinee_0123456789876543210 of STrue -> sFromInteger (sing :: Sing 1) SFalse -> (applySing ((applySing ((singFun2 @($@#@$)) (%$))) sTypeError)) ((applySing ((singFun1 @ShowTypeSym0) SShowType)) sX)) :: Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: a) | 7 | $(singletons | ^^^^^^^^^^... Singletons/T160.hs:0:0: error: • 1 • In the expression: Refl In an equation for ‘f’: f = Refl | 13 | f = Refl | ^^^^ singletons-2.5.1/tests/compile-and-dump/Singletons/T160.hs0000755000000000000000000000037707346545000021517 0ustar0000000000000000module T160 where import Data.Singletons.Prelude import Data.Singletons.TH import Data.Singletons.TypeError $(singletons [d| foo :: (Num a, Eq a) => a -> a foo x = if x == 0 then 1 else typeError $ ShowType x |]) f :: Foo 1 :~: 42 f = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/T163.ghc86.template0000755000000000000000000000505307346545000023635 0ustar0000000000000000Singletons/T163.hs:0:0:: Splicing declarations singletons [d| data a + b = L a | R b |] ======> data (+) a b = L a | R b type LSym1 (t0123456789876543210 :: a0123456789876543210) = L t0123456789876543210 instance SuppressUnusedWarnings LSym0 where suppressUnusedWarnings = snd (((,) LSym0KindInference) ()) data LSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210) where LSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply LSym0 arg) (LSym1 arg) => LSym0 t0123456789876543210 type instance Apply LSym0 t0123456789876543210 = L t0123456789876543210 type RSym1 (t0123456789876543210 :: b0123456789876543210) = R t0123456789876543210 instance SuppressUnusedWarnings RSym0 where suppressUnusedWarnings = snd (((,) RSym0KindInference) ()) data RSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210) where RSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply RSym0 arg) (RSym1 arg) => RSym0 t0123456789876543210 type instance Apply RSym0 t0123456789876543210 = R t0123456789876543210 data instance Sing :: (+) a b -> GHC.Types.Type where SL :: forall a (n :: a). (Sing (n :: a)) -> Sing (L n) SR :: forall b (n :: b). (Sing (n :: b)) -> Sing (R n) type (%+) = (Sing :: (+) a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind ((+) a b) where type Demote ((+) a b) = (+) (Demote a) (Demote b) fromSing (SL b) = L (fromSing b) fromSing (SR b) = R (fromSing b) toSing (L (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SL c) } toSing (R (b :: Demote b)) = case toSing b :: SomeSing b of { SomeSing c -> SomeSing (SR c) } instance SingI n => SingI (L (n :: a)) where sing = SL sing instance SingI (LSym0 :: (~>) a ((+) a b)) where sing = (singFun1 @LSym0) SL instance SingI (TyCon1 L :: (~>) a ((+) a b)) where sing = (singFun1 @(TyCon1 L)) SL instance SingI n => SingI (R (n :: b)) where sing = SR sing instance SingI (RSym0 :: (~>) b ((+) a b)) where sing = (singFun1 @RSym0) SR instance SingI (TyCon1 R :: (~>) b ((+) a b)) where sing = (singFun1 @(TyCon1 R)) SR singletons-2.5.1/tests/compile-and-dump/Singletons/T163.hs0000755000000000000000000000013207346545000021507 0ustar0000000000000000module T163 where import Data.Singletons.TH $(singletons [d| data a + b = L a | R b |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T166.ghc86.template0000755000000000000000000002166507346545000023647 0ustar0000000000000000Singletons/T166.hs:(0,0)-(0,0): Splicing declarations singletonsOnly [d| class Foo a where foosPrec :: Nat -> a -> [Bool] -> [Bool] foo :: a -> [Bool] foo x s = foosPrec 0 x s |] ======> type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where FoosPrecSym2KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) [Bool] [Bool]) where FoosPrecSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings FoosPrecSym0 where suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) data FoosPrecSym0 :: forall a0123456789876543210. (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) where FoosPrecSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => FoosPrecSym0 arg0123456789876543210 type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 type FooSym1 (arg0123456789876543210 :: a0123456789876543210) = Foo arg0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 [Bool] where FooSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 arg0123456789876543210 type instance Apply FooSym0 arg0123456789876543210 = Foo arg0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x s = Apply (Apply (Apply FoosPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 0)) x) s type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Foo_0123456789876543210 (a :: a) :: [Bool] where Foo_0123456789876543210 x = Apply Lambda_0123456789876543210Sym0 x type Foo_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Foo_0123456789876543210Sym0KindInference) ()) data Foo_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 [Bool] where Foo_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo_0123456789876543210Sym0 arg) (Foo_0123456789876543210Sym1 arg) => Foo_0123456789876543210Sym0 a0123456789876543210 type instance Apply Foo_0123456789876543210Sym0 a0123456789876543210 = Foo_0123456789876543210 a0123456789876543210 class PFoo (a :: GHC.Types.Type) where type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] type Foo (arg :: a) :: [Bool] type Foo a = Apply Foo_0123456789876543210Sym0 a class SFoo a where sFoosPrec :: forall (t :: Nat) (t :: a) (t :: [Bool]). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) sFoo :: forall (t :: a). Sing t -> Sing (Apply FooSym0 t :: [Bool]) default sFoo :: forall (t :: a). (Apply FooSym0 t :: [Bool]) ~ Apply Foo_0123456789876543210Sym0 t => Sing t -> Sing (Apply FooSym0 t :: [Bool]) sFoo (sX :: Sing x) = (singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sS -> case sS of { (_ :: Sing s) -> (applySing ((applySing ((applySing ((singFun3 @FoosPrecSym0) sFoosPrec)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)))) sX)) sS }) instance SFoo a => SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where sing = (singFun3 @FoosPrecSym0) sFoosPrec instance (SFoo a, SingI d) => SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d)) instance (SFoo a, SingI d, SingI d) => SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where sing = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a))) ((sFoosPrec (sing @d)) (sing @d)) instance SFoo a => SingI (FooSym0 :: (~>) a [Bool]) where sing = (singFun1 @FooSym0) sFoo Singletons/T166.hs:0:0: error: • Expecting one more argument to ‘Apply Lambda_0123456789876543210Sym0 x’ Expected kind ‘[Bool]’, but ‘Apply Lambda_0123456789876543210Sym0 x’ has kind ‘TyFun [Bool] [Bool] -> Type’ • In the type ‘Apply Lambda_0123456789876543210Sym0 x’ In the type family declaration for ‘Foo_0123456789876543210’ | 14 | $(singletonsOnly [d| | ^^^^^^^^^^^^^^^^^^... singletons-2.5.1/tests/compile-and-dump/Singletons/T166.hs0000755000000000000000000000076007346545000021521 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module SingletonsBug where import Data.Singletons.TH import GHC.TypeLits $(singletonsOnly [d| class Foo a where foosPrec :: Nat -> a -> [Bool] -> [Bool] foo :: a -> [Bool] foo x s = foosPrec 0 x s |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T167.ghc86.template0000755000000000000000000003170707346545000023646 0ustar0000000000000000Singletons/T167.hs:(0,0)-(0,0): Splicing declarations singletonsOnly [d| class Foo a where foosPrec :: Nat -> a -> DiffList fooList :: a -> DiffList fooList = undefined instance Foo a => Foo [a] where foosPrec _ = fooList |] ======> type FoosPrecSym3 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym2KindInference) ()) data FoosPrecSym2 (arg0123456789876543210 :: Nat) (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where FoosPrecSym2KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg) (FoosPrecSym3 arg0123456789876543210 arg0123456789876543210 arg) => FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym2 arg0123456789876543210 arg0123456789876543210) arg0123456789876543210 = FoosPrec arg0123456789876543210 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (FoosPrecSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrecSym1KindInference) ()) data FoosPrecSym1 (arg0123456789876543210 :: Nat) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) [Bool] [Bool]) where FoosPrecSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (FoosPrecSym1 arg0123456789876543210) arg) (FoosPrecSym2 arg0123456789876543210 arg) => FoosPrecSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (FoosPrecSym1 arg0123456789876543210) arg0123456789876543210 = FoosPrecSym2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings FoosPrecSym0 where suppressUnusedWarnings = snd (((,) FoosPrecSym0KindInference) ()) data FoosPrecSym0 :: forall a0123456789876543210. (~>) Nat ((~>) a0123456789876543210 ((~>) [Bool] [Bool])) where FoosPrecSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) => FoosPrecSym0 arg0123456789876543210 type instance Apply FoosPrecSym0 arg0123456789876543210 = FoosPrecSym1 arg0123456789876543210 type FooListSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: [Bool]) = FooList arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (FooListSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) FooListSym1KindInference) ()) data FooListSym1 (arg0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where FooListSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (FooListSym1 arg0123456789876543210) arg) (FooListSym2 arg0123456789876543210 arg) => FooListSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (FooListSym1 arg0123456789876543210) arg0123456789876543210 = FooList arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings FooListSym0 where suppressUnusedWarnings = snd (((,) FooListSym0KindInference) ()) data FooListSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) [Bool] [Bool]) where FooListSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) => FooListSym0 arg0123456789876543210 type instance Apply FooListSym0 arg0123456789876543210 = FooListSym1 arg0123456789876543210 type family FooList_0123456789876543210 (a :: a) (a :: [Bool]) :: [Bool] where FooList_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply UndefinedSym0 a_0123456789876543210) a_0123456789876543210 type FooList_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: [Bool]) = FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FooList_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FooList_0123456789876543210Sym1KindInference) ()) data FooList_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: (~>) [Bool] [Bool] where FooList_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FooList_0123456789876543210Sym1 a0123456789876543210) arg) (FooList_0123456789876543210Sym2 a0123456789876543210 arg) => FooList_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (FooList_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FooList_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FooList_0123456789876543210Sym0KindInference) ()) data FooList_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) [Bool] [Bool]) where FooList_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) => FooList_0123456789876543210Sym0 a0123456789876543210 type instance Apply FooList_0123456789876543210Sym0 a0123456789876543210 = FooList_0123456789876543210Sym1 a0123456789876543210 class PFoo (a :: GHC.Types.Type) where type FoosPrec (arg :: Nat) (arg :: a) (arg :: [Bool]) :: [Bool] type FooList (arg :: a) (arg :: [Bool]) :: [Bool] type FooList a a = Apply (Apply FooList_0123456789876543210Sym0 a) a type family FoosPrec_0123456789876543210 (a :: Nat) (a :: [a]) (a :: [Bool]) :: [Bool] where FoosPrec_0123456789876543210 _ a_0123456789876543210 a_0123456789876543210 = Apply (Apply FooListSym0 a_0123456789876543210) a_0123456789876543210 type FoosPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [Bool]) = FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrec_0123456789876543210Sym2KindInference) ()) data FoosPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: [a0123456789876543210]) :: (~>) [Bool] [Bool] where FoosPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (FoosPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) FoosPrec_0123456789876543210Sym1KindInference) ()) data FoosPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: forall a0123456789876543210. (~>) [a0123456789876543210] ((~>) [Bool] [Bool]) where FoosPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) arg) (FoosPrec_0123456789876543210Sym2 a0123456789876543210 arg) => FoosPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (FoosPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = FoosPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FoosPrec_0123456789876543210Sym0KindInference) ()) data FoosPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) Nat ((~>) [a0123456789876543210] ((~>) [Bool] [Bool])) where FoosPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) => FoosPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply FoosPrec_0123456789876543210Sym0 a0123456789876543210 = FoosPrec_0123456789876543210Sym1 a0123456789876543210 instance PFoo [a] where type FoosPrec a a a = Apply (Apply (Apply FoosPrec_0123456789876543210Sym0 a) a) a class SFoo a where sFoosPrec :: forall (t :: Nat) (t :: a) (t :: [Bool]). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) sFooList :: forall (t :: a) (t :: [Bool]). Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) default sFooList :: forall (t :: a) (t :: [Bool]). (Apply (Apply FooListSym0 t) t :: [Bool]) ~ Apply (Apply FooList_0123456789876543210Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply FooListSym0 t) t :: [Bool]) sFooList (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (sUndefined sA_0123456789876543210) sA_0123456789876543210 instance SFoo a => SFoo [a] where sFoosPrec :: forall (t :: Nat) (t :: [a]) (t :: [Bool]). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply FoosPrecSym0 t) t) t :: [Bool]) sFoosPrec _ (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @FooListSym0) sFooList)) sA_0123456789876543210)) sA_0123456789876543210 instance SFoo a => SingI (FoosPrecSym0 :: (~>) Nat ((~>) a ((~>) [Bool] [Bool]))) where sing = (singFun3 @FoosPrecSym0) sFoosPrec instance (SFoo a, SingI d) => SingI (FoosPrecSym1 (d :: Nat) :: (~>) a ((~>) [Bool] [Bool])) where sing = (singFun2 @(FoosPrecSym1 (d :: Nat))) (sFoosPrec (sing @d)) instance (SFoo a, SingI d, SingI d) => SingI (FoosPrecSym2 (d :: Nat) (d :: a) :: (~>) [Bool] [Bool]) where sing = (singFun1 @(FoosPrecSym2 (d :: Nat) (d :: a))) ((sFoosPrec (sing @d)) (sing @d)) instance SFoo a => SingI (FooListSym0 :: (~>) a ((~>) [Bool] [Bool])) where sing = (singFun2 @FooListSym0) sFooList instance (SFoo a, SingI d) => SingI (FooListSym1 (d :: a) :: (~>) [Bool] [Bool]) where sing = (singFun1 @(FooListSym1 (d :: a))) (sFooList (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T167.hs0000755000000000000000000000120107346545000021511 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Singletons.T167 where import Data.Singletons.TH import GHC.TypeLits type DiffList = [Bool] -> [Bool] $(singletonsOnly [d| class Foo a where foosPrec :: Nat -> a -> DiffList fooList :: a -> DiffList fooList = undefined instance Foo a => Foo [a] where foosPrec _ = fooList |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T172.ghc86.template0000755000000000000000000000421707346545000023636 0ustar0000000000000000Singletons/T172.hs:(0,0)-(0,0): Splicing declarations singletonsOnly [d| ($>) :: Nat -> Nat -> Nat ($>) = (+) |] ======> type ($>@#@$$$) (a0123456789876543210 :: Nat) (a0123456789876543210 :: Nat) = ($>) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (($>@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$>@#@$$###)) ()) data ($>@#@$$) (a0123456789876543210 :: Nat) :: (~>) Nat Nat where (:$>@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (($>@#@$$) a0123456789876543210) arg) (($>@#@$$$) a0123456789876543210 arg) => ($>@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($>@#@$$) a0123456789876543210) a0123456789876543210 = ($>) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ($>@#@$) where suppressUnusedWarnings = snd (((,) (:$>@#@$###)) ()) data ($>@#@$) :: (~>) Nat ((~>) Nat Nat) where (:$>@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) => ($>@#@$) a0123456789876543210 type instance Apply ($>@#@$) a0123456789876543210 = ($>@#@$$) a0123456789876543210 type family ($>) (a :: Nat) (a :: Nat) :: Nat where ($>) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (+@#@$) a_0123456789876543210) a_0123456789876543210 (%$>) :: forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Apply (Apply ($>@#@$) t) t :: Nat) (%$>) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @(+@#@$)) (%+))) sA_0123456789876543210)) sA_0123456789876543210 instance SingI (($>@#@$) :: (~>) Nat ((~>) Nat Nat)) where sing = (singFun2 @($>@#@$)) (%$>) instance SingI d => SingI (($>@#@$$) (d :: Nat) :: (~>) Nat Nat) where sing = (singFun1 @(($>@#@$$) (d :: Nat))) ((%$>) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T172.hs0000755000000000000000000000067307346545000021521 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module T172 where import Data.Singletons.Prelude import Data.Singletons.TH import Data.Singletons.TypeLits $(singletonsOnly [d| ($>) :: Nat -> Nat -> Nat ($>) = (+) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T175.ghc86.template0000755000000000000000000000256307346545000023643 0ustar0000000000000000Singletons/T175.hs:(0,0)-(0,0): Splicing declarations singletons [d| quux2 :: Bar2 a => a quux2 = baz class Foo a where baz :: a class Foo a => Bar1 a where quux1 :: a quux1 = baz class Foo a => Bar2 a |] ======> class Foo a where baz :: a class Foo a => Bar1 a where quux1 :: a quux1 = baz class Foo a => Bar2 a quux2 :: Bar2 a => a quux2 = baz type Quux2Sym0 = Quux2 type family Quux2 :: a where Quux2 = BazSym0 type BazSym0 = Baz class PFoo (a :: GHC.Types.Type) where type Baz :: a type Quux1Sym0 = Quux1 type family Quux1_0123456789876543210 :: a where Quux1_0123456789876543210 = BazSym0 type Quux1_0123456789876543210Sym0 = Quux1_0123456789876543210 class PFoo a => PBar1 (a :: GHC.Types.Type) where type Quux1 :: a type Quux1 = Quux1_0123456789876543210Sym0 class PFoo a => PBar2 (a :: GHC.Types.Type) sQuux2 :: forall a. SBar2 a => Sing (Quux2Sym0 :: a) sQuux2 = sBaz class SFoo a where sBaz :: Sing (BazSym0 :: a) class SFoo a => SBar1 a where sQuux1 :: Sing (Quux1Sym0 :: a) default sQuux1 :: (Quux1Sym0 :: a) ~ Quux1_0123456789876543210Sym0 => Sing (Quux1Sym0 :: a) sQuux1 = sBaz class SFoo a => SBar2 a singletons-2.5.1/tests/compile-and-dump/Singletons/T175.hs0000755000000000000000000000107107346545000021515 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} module T175 where import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| class Foo a where baz :: a class Foo a => Bar1 a where quux1 :: a quux1 = baz class Foo a => Bar2 a where quux2 :: Bar2 a => a quux2 = baz |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T176.ghc86.template0000755000000000000000000002332207346545000023640 0ustar0000000000000000Singletons/T176.hs:(0,0)-(0,0): Splicing declarations singletons [d| quux1 :: Foo1 a => a -> a quux1 x = x `bar1` \ _ -> baz1 quux2 :: Foo2 a => a -> a quux2 x = x `bar2` baz2 class Foo1 a where bar1 :: a -> (a -> b) -> b baz1 :: a class Foo2 a where bar2 :: a -> b -> b baz2 :: a |] ======> class Foo1 a where bar1 :: a -> (a -> b) -> b baz1 :: a quux1 :: Foo1 a => a -> a quux1 x = (x `bar1` (\ _ -> baz1)) class Foo2 a where bar2 :: a -> b -> b baz2 :: a quux2 :: Foo2 a => a -> a quux2 x = (x `bar2` baz2) type family Case_0123456789876543210 x arg_0123456789876543210 t where Case_0123456789876543210 x arg_0123456789876543210 _ = Baz1Sym0 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type Quux2Sym1 (a0123456789876543210 :: a0123456789876543210) = Quux2 a0123456789876543210 instance SuppressUnusedWarnings Quux2Sym0 where suppressUnusedWarnings = snd (((,) Quux2Sym0KindInference) ()) data Quux2Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Quux2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) => Quux2Sym0 a0123456789876543210 type instance Apply Quux2Sym0 a0123456789876543210 = Quux2 a0123456789876543210 type Quux1Sym1 (a0123456789876543210 :: a0123456789876543210) = Quux1 a0123456789876543210 instance SuppressUnusedWarnings Quux1Sym0 where suppressUnusedWarnings = snd (((,) Quux1Sym0KindInference) ()) data Quux1Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Quux1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) => Quux1Sym0 a0123456789876543210 type instance Apply Quux1Sym0 a0123456789876543210 = Quux1 a0123456789876543210 type family Quux2 (a :: a) :: a where Quux2 x = Apply (Apply Bar2Sym0 x) Baz2Sym0 type family Quux1 (a :: a) :: a where Quux1 x = Apply (Apply Bar1Sym0 x) (Apply Lambda_0123456789876543210Sym0 x) type Bar1Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = Bar1 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (Bar1Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar1Sym1KindInference) ()) data Bar1Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210 where Bar1Sym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (Bar1Sym1 arg0123456789876543210) arg) (Bar1Sym2 arg0123456789876543210 arg) => Bar1Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (Bar1Sym1 arg0123456789876543210) arg0123456789876543210 = Bar1 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings Bar1Sym0 where suppressUnusedWarnings = snd (((,) Bar1Sym0KindInference) ()) data Bar1Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) ((~>) a0123456789876543210 b0123456789876543210) b0123456789876543210) where Bar1Sym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) => Bar1Sym0 arg0123456789876543210 type instance Apply Bar1Sym0 arg0123456789876543210 = Bar1Sym1 arg0123456789876543210 type Baz1Sym0 = Baz1 class PFoo1 (a :: Type) where type Bar1 (arg :: a) (arg :: (~>) a b) :: b type Baz1 :: a type Bar2Sym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = Bar2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (Bar2Sym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar2Sym1KindInference) ()) data Bar2Sym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Bar2Sym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (Bar2Sym1 arg0123456789876543210) arg) (Bar2Sym2 arg0123456789876543210 arg) => Bar2Sym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (Bar2Sym1 arg0123456789876543210) arg0123456789876543210 = Bar2 arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings Bar2Sym0 where suppressUnusedWarnings = snd (((,) Bar2Sym0KindInference) ()) data Bar2Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Bar2Sym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) => Bar2Sym0 arg0123456789876543210 type instance Apply Bar2Sym0 arg0123456789876543210 = Bar2Sym1 arg0123456789876543210 type Baz2Sym0 = Baz2 class PFoo2 (a :: Type) where type Bar2 (arg :: a) (arg :: b) :: b type Baz2 :: a sQuux2 :: forall a (t :: a). SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a) sQuux1 :: forall a (t :: a). SFoo1 a => Sing t -> Sing (Apply Quux1Sym0 t :: a) sQuux2 (sX :: Sing x) = (applySing ((applySing ((singFun2 @Bar2Sym0) sBar2)) sX)) sBaz2 sQuux1 (sX :: Sing x) = (applySing ((applySing ((singFun2 @Bar1Sym0) sBar1)) sX)) ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sBaz1 }) :: Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) })) instance SFoo2 a => SingI (Quux2Sym0 :: (~>) a a) where sing = (singFun1 @Quux2Sym0) sQuux2 instance SFoo1 a => SingI (Quux1Sym0 :: (~>) a a) where sing = (singFun1 @Quux1Sym0) sQuux1 class SFoo1 a where sBar1 :: forall b (t :: a) (t :: (~>) a b). Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b) sBaz1 :: Sing (Baz1Sym0 :: a) class SFoo2 a where sBar2 :: forall b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b) sBaz2 :: Sing (Baz2Sym0 :: a) instance SFoo1 a => SingI (Bar1Sym0 :: (~>) a ((~>) ((~>) a b) b)) where sing = (singFun2 @Bar1Sym0) sBar1 instance (SFoo1 a, SingI d) => SingI (Bar1Sym1 (d :: a) :: (~>) ((~>) a b) b) where sing = (singFun1 @(Bar1Sym1 (d :: a))) (sBar1 (sing @d)) instance SFoo2 a => SingI (Bar2Sym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @Bar2Sym0) sBar2 instance (SFoo2 a, SingI d) => SingI (Bar2Sym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(Bar2Sym1 (d :: a))) (sBar2 (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T176.hs0000755000000000000000000000117407346545000021522 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module T176 where import Data.Kind (Type) import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| class Foo1 a where bar1 :: a -> (a -> b) -> b baz1 :: a quux1 :: Foo1 a => a -> a quux1 x = x `bar1` \_ -> baz1 class Foo2 a where bar2 :: a -> b -> b baz2 :: a quux2 :: Foo2 a => a -> a quux2 x = x `bar2` baz2 |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T178.ghc86.template0000755000000000000000000002621107346545000023642 0ustar0000000000000000Singletons/T178.hs:(0,0)-(0,0): Splicing declarations singletons [d| empty :: U empty = [] data Occ = Str | Opt | Many deriving (Eq, Ord, Show) type U = [(Symbol, Occ)] |] ======> data Occ = Str | Opt | Many deriving (Eq, Ord, Show) type U = [(Symbol, Occ)] empty :: U empty = [] type USym0 = U type StrSym0 = Str type OptSym0 = Opt type ManySym0 = Many type EmptySym0 = Empty type family Empty :: [(Symbol, Occ)] where Empty = '[] type family Compare_0123456789876543210 (a :: Occ) (a :: Occ) :: Ordering where Compare_0123456789876543210 Str Str = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 Opt Opt = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 Many Many = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] Compare_0123456789876543210 Str Opt = LTSym0 Compare_0123456789876543210 Str Many = LTSym0 Compare_0123456789876543210 Opt Str = GTSym0 Compare_0123456789876543210 Opt Many = LTSym0 Compare_0123456789876543210 Many Str = GTSym0 Compare_0123456789876543210 Many Opt = GTSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Occ) (a0123456789876543210 :: Occ) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Occ) :: (~>) Occ Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Occ ((~>) Occ Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Occ where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family ShowsPrec_0123456789876543210 (a :: Nat) (a :: Occ) (a :: Symbol) :: Symbol where ShowsPrec_0123456789876543210 _ Str a_0123456789876543210 = Apply (Apply ShowStringSym0 "Str") a_0123456789876543210 ShowsPrec_0123456789876543210 _ Opt a_0123456789876543210 = Apply (Apply ShowStringSym0 "Opt") a_0123456789876543210 ShowsPrec_0123456789876543210 _ Many a_0123456789876543210 = Apply (Apply ShowStringSym0 "Many") a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) (a0123456789876543210 :: Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: Nat) (a0123456789876543210 :: Occ) :: (~>) Symbol Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: Nat) :: (~>) Occ ((~>) Symbol Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) Nat ((~>) Occ ((~>) Symbol Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow Occ where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: Occ) (b :: Occ) :: Bool where Equals_0123456789876543210 Str Str = TrueSym0 Equals_0123456789876543210 Opt Opt = TrueSym0 Equals_0123456789876543210 Many Many = TrueSym0 Equals_0123456789876543210 (_ :: Occ) (_ :: Occ) = FalseSym0 instance PEq Occ where type (==) a b = Equals_0123456789876543210 a b sEmpty :: Sing (EmptySym0 :: [(Symbol, Occ)]) sEmpty = Data.Singletons.Prelude.Instances.SNil data instance Sing :: Occ -> GHC.Types.Type where SStr :: Sing Str SOpt :: Sing Opt SMany :: Sing Many type SOcc = (Sing :: Occ -> GHC.Types.Type) instance SingKind Occ where type Demote Occ = Occ fromSing SStr = Str fromSing SOpt = Opt fromSing SMany = Many toSing Str = SomeSing SStr toSing Opt = SomeSing SOpt toSing Many = SomeSing SMany instance SOrd Occ where sCompare :: forall (t1 :: Occ) (t2 :: Occ). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Occ ((~>) Occ Ordering) -> GHC.Types.Type) t1) t2) sCompare SStr SStr = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) Data.Singletons.Prelude.Instances.SNil sCompare SOpt SOpt = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) Data.Singletons.Prelude.Instances.SNil sCompare SMany SMany = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) Data.Singletons.Prelude.Instances.SNil sCompare SStr SOpt = SLT sCompare SStr SMany = SLT sCompare SOpt SStr = SGT sCompare SOpt SMany = SLT sCompare SMany SStr = SGT sCompare SMany SOpt = SGT instance SShow Occ where sShowsPrec :: forall (t1 :: Nat) (t2 :: Occ) (t3 :: Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun Nat ((~>) Occ ((~>) Symbol Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ SStr (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Str"))) sA_0123456789876543210 sShowsPrec _ SOpt (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Opt"))) sA_0123456789876543210 sShowsPrec _ SMany (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Many"))) sA_0123456789876543210 instance SEq Occ where (%==) SStr SStr = STrue (%==) SStr SOpt = SFalse (%==) SStr SMany = SFalse (%==) SOpt SStr = SFalse (%==) SOpt SOpt = STrue (%==) SOpt SMany = SFalse (%==) SMany SStr = SFalse (%==) SMany SOpt = SFalse (%==) SMany SMany = STrue instance SDecide Occ where (%~) SStr SStr = Proved Refl (%~) SStr SOpt = Disproved (\ x -> case x of) (%~) SStr SMany = Disproved (\ x -> case x of) (%~) SOpt SStr = Disproved (\ x -> case x of) (%~) SOpt SOpt = Proved Refl (%~) SOpt SMany = Disproved (\ x -> case x of) (%~) SMany SStr = Disproved (\ x -> case x of) (%~) SMany SOpt = Disproved (\ x -> case x of) (%~) SMany SMany = Proved Refl deriving instance Show (Sing (z :: Occ)) instance SingI Str where sing = SStr instance SingI Opt where sing = SOpt instance SingI Many where sing = SMany singletons-2.5.1/tests/compile-and-dump/Singletons/T178.hs0000755000000000000000000000036207346545000021522 0ustar0000000000000000module T178 where import GHC.TypeLits import Data.Singletons.TH $(singletons [d| -- Note: Ord automatically defines "max" data Occ = Str | Opt | Many deriving (Eq, Ord, Show) type U = [(Symbol,Occ)] empty :: U empty = [] |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T183.ghc86.template0000755000000000000000000007562207346545000023650 0ustar0000000000000000Singletons/T183.hs:(0,0)-(0,0): Splicing declarations singletons [d| f1 (x :: Maybe Bool) = (x :: Maybe Bool) f2 (x :: Maybe a) = (x :: Maybe a) f3 (Just a :: Maybe Bool) = "hi" g x = case Just x of { (Just y :: Maybe Bool) -> (y :: Bool) } foo1 :: Maybe a -> a foo1 (Just x :: Maybe a) = (x :: a) foo2, foo3 :: forall a. Maybe a -> a foo2 (Just x :: Maybe a) = (x :: a) foo3 (Just x) = (x :: a) foo4 :: (a, b) -> (b, a) foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a) foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) foo6 (Just x :: Maybe (Maybe a)) = case x :: Maybe a of { (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) } foo7 :: a -> b -> a foo7 (x :: a) (_ :: b) = (x :: a) foo8 :: forall a. Maybe a -> Maybe a foo8 x@(Just (_ :: a) :: Maybe a) = x foo9 :: a -> a foo9 (x :: a) = let g :: a -> b -> a g y _ = y in g x () |] ======> f1 (x :: Maybe Bool) = x :: Maybe Bool f2 (x :: Maybe a) = x :: Maybe a f3 (Just a :: Maybe Bool) = "hi" g x = case Just x of { (Just y :: Maybe Bool) -> y :: Bool } foo1 :: Maybe a -> a foo1 (Just x :: Maybe a) = x :: a foo2 :: forall a. Maybe a -> a foo3 :: forall a. Maybe a -> a foo2 (Just x :: Maybe a) = x :: a foo3 (Just x) = x :: a foo4 :: (a, b) -> (b, a) foo4 = \ (x :: a, y :: b) -> (y :: b, x :: a) foo5 :: Maybe (Maybe a) -> Maybe (Maybe a) foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) foo6 (Just x :: Maybe (Maybe a)) = case x :: Maybe a of { (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) } foo7 :: a -> b -> a foo7 (x :: a) (_ :: b) = x :: a foo8 :: forall a. Maybe a -> Maybe a foo8 x@(Just (_ :: a) :: Maybe a) = x foo9 :: a -> a foo9 (x :: a) = let g :: a -> b -> a g y _ = y in (g x) () type Let0123456789876543210GSym3 x0123456789876543210 (a0123456789876543210 :: a) (a0123456789876543210 :: b0123456789876543210) = Let0123456789876543210G x0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210GSym2KindInference) ()) data Let0123456789876543210GSym2 x0123456789876543210 (a0123456789876543210 :: a) :: forall b0123456789876543210. (~>) b0123456789876543210 a where Let0123456789876543210GSym2KindInference :: forall x0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210) arg) (Let0123456789876543210GSym3 x0123456789876543210 a0123456789876543210 arg) => Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210GSym2 a0123456789876543210 x0123456789876543210) a0123456789876543210 = Let0123456789876543210G a0123456789876543210 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210GSym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210GSym1KindInference) ()) data Let0123456789876543210GSym1 x0123456789876543210 :: forall b0123456789876543210 a. (~>) a ((~>) b0123456789876543210 a) where Let0123456789876543210GSym1KindInference :: forall x0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210GSym1 x0123456789876543210) arg) (Let0123456789876543210GSym2 x0123456789876543210 arg) => Let0123456789876543210GSym1 x0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210GSym1 x0123456789876543210) a0123456789876543210 = Let0123456789876543210GSym2 x0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210GSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210GSym0KindInference) ()) data Let0123456789876543210GSym0 x0123456789876543210 where Let0123456789876543210GSym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210GSym0 arg) (Let0123456789876543210GSym1 arg) => Let0123456789876543210GSym0 x0123456789876543210 type instance Apply Let0123456789876543210GSym0 x0123456789876543210 = Let0123456789876543210GSym1 x0123456789876543210 type family Let0123456789876543210G x (a :: a) (a :: b) :: a where Let0123456789876543210G x y _ = y type Let0123456789876543210XSym1 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210XSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210XSym0KindInference) ()) data Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 where Let0123456789876543210XSym0KindInference :: forall wild_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) => Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210XSym0 wild_01234567898765432100123456789876543210 = Let0123456789876543210X wild_01234567898765432100123456789876543210 type family Let0123456789876543210X wild_0123456789876543210 where Let0123456789876543210X wild_0123456789876543210 = (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a) type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = (x :: Maybe a) type family Case_0123456789876543210 x t where Case_0123456789876543210 x ( 'Just (y :: a) :: Maybe a) = Apply JustSym0 (Apply JustSym0 (y :: a) :: Maybe a) type family Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 '((x :: a), (y :: b)) = Apply (Apply Tuple2Sym0 (y :: b)) (x :: a) type family Lambda_0123456789876543210 a_0123456789876543210 t where Lambda_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 type Let0123456789876543210Scrutinee_0123456789876543210Sym1 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 x0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 x0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 x where Let0123456789876543210Scrutinee_0123456789876543210 x = Apply JustSym0 x type family Case_0123456789876543210 x t where Case_0123456789876543210 x ( 'Just y :: Maybe Bool) = (y :: Bool) type Foo9Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo9 a0123456789876543210 instance SuppressUnusedWarnings Foo9Sym0 where suppressUnusedWarnings = snd (((,) Foo9Sym0KindInference) ()) data Foo9Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo9Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) => Foo9Sym0 a0123456789876543210 type instance Apply Foo9Sym0 a0123456789876543210 = Foo9 a0123456789876543210 type Foo8Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) (Maybe a0123456789876543210) where Foo8Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo7Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => Foo7Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo7Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => Foo7Sym0 a0123456789876543210 type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 type Foo6Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = Foo6 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: forall a0123456789876543210. (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210)) where Foo6Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6 a0123456789876543210 type Foo5Sym1 (a0123456789876543210 :: Maybe (Maybe a0123456789876543210)) = Foo5 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210. (~>) (Maybe (Maybe a0123456789876543210)) (Maybe (Maybe a0123456789876543210)) where Foo5Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5 a0123456789876543210 type Foo4Sym1 (a0123456789876543210 :: (a0123456789876543210, b0123456789876543210)) = Foo4 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (a0123456789876543210, b0123456789876543210) (b0123456789876543210, a0123456789876543210) where Foo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4 a0123456789876543210 type Foo3Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = Foo3 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 type Foo2Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = Foo2 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2 a0123456789876543210 type Foo1Sym1 (a0123456789876543210 :: Maybe a0123456789876543210) = Foo1 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) a0123456789876543210 where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1 a0123456789876543210 type GSym1 a0123456789876543210 = G a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) data GSym0 a0123456789876543210 where GSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 type F3Sym1 a0123456789876543210 = F3 a0123456789876543210 instance SuppressUnusedWarnings F3Sym0 where suppressUnusedWarnings = snd (((,) F3Sym0KindInference) ()) data F3Sym0 a0123456789876543210 where F3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply F3Sym0 arg) (F3Sym1 arg) => F3Sym0 a0123456789876543210 type instance Apply F3Sym0 a0123456789876543210 = F3 a0123456789876543210 type F2Sym1 a0123456789876543210 = F2 a0123456789876543210 instance SuppressUnusedWarnings F2Sym0 where suppressUnusedWarnings = snd (((,) F2Sym0KindInference) ()) data F2Sym0 a0123456789876543210 where F2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply F2Sym0 arg) (F2Sym1 arg) => F2Sym0 a0123456789876543210 type instance Apply F2Sym0 a0123456789876543210 = F2 a0123456789876543210 type F1Sym1 a0123456789876543210 = F1 a0123456789876543210 instance SuppressUnusedWarnings F1Sym0 where suppressUnusedWarnings = snd (((,) F1Sym0KindInference) ()) data F1Sym0 a0123456789876543210 where F1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply F1Sym0 arg) (F1Sym1 arg) => F1Sym0 a0123456789876543210 type instance Apply F1Sym0 a0123456789876543210 = F1 a0123456789876543210 type family Foo9 (a :: a) :: a where Foo9 (x :: a) = Apply (Apply (Let0123456789876543210GSym1 x) x) Tuple0Sym0 type family Foo8 (a :: Maybe a) :: Maybe a where Foo8 ( 'Just (wild_0123456789876543210 :: a) :: Maybe a) = Let0123456789876543210XSym1 wild_0123456789876543210 type family Foo7 (a :: a) (a :: b) :: a where Foo7 (x :: a) (wild_0123456789876543210 :: b) = (x :: a) type family Foo6 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where Foo6 ( 'Just x :: Maybe (Maybe a)) = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) type family Foo5 (a :: Maybe (Maybe a)) :: Maybe (Maybe a) where Foo5 ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a)) type family Foo4 (a :: (a, b)) :: (b, a) where Foo4 a_0123456789876543210 = Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210 type family Foo3 (a :: Maybe a) :: a where Foo3 ( 'Just x) = (x :: a) type family Foo2 (a :: Maybe a) :: a where Foo2 ( 'Just x :: Maybe a) = (x :: a) type family Foo1 (a :: Maybe a) :: a where Foo1 ( 'Just x :: Maybe a) = (x :: a) type family G a where G x = Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) type family F3 a where F3 ( 'Just a :: Maybe Bool) = "hi" type family F2 a where F2 (x :: Maybe a) = (x :: Maybe a) type family F1 a where F1 (x :: Maybe Bool) = (x :: Maybe Bool) sFoo9 :: forall a (t :: a). Sing t -> Sing (Apply Foo9Sym0 t :: a) sFoo8 :: forall a (t :: Maybe a). Sing t -> Sing (Apply Foo8Sym0 t :: Maybe a) sFoo7 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: a) sFoo6 :: forall a (t :: Maybe (Maybe a)). Sing t -> Sing (Apply Foo6Sym0 t :: Maybe (Maybe a)) sFoo5 :: forall a (t :: Maybe (Maybe a)). Sing t -> Sing (Apply Foo5Sym0 t :: Maybe (Maybe a)) sFoo4 :: forall a b (t :: (a, b)). Sing t -> Sing (Apply Foo4Sym0 t :: (b, a)) sFoo3 :: forall a (t :: Maybe a). Sing t -> Sing (Apply Foo3Sym0 t :: a) sFoo2 :: forall a (t :: Maybe a). Sing t -> Sing (Apply Foo2Sym0 t :: a) sFoo1 :: forall a (t :: Maybe a). Sing t -> Sing (Apply Foo1Sym0 t :: a) sG :: forall arg. Sing arg -> Sing (Apply GSym0 arg) sF3 :: forall arg. Sing arg -> Sing (Apply F3Sym0 arg) sF2 :: forall arg. Sing arg -> Sing (Apply F2Sym0 arg) sF1 :: forall arg. Sing arg -> Sing (Apply F1Sym0 arg) sFoo9 (sX :: Sing x) = case sX :: Sing x of { (_ :: Sing (x :: a)) -> let sG :: forall b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply (Let0123456789876543210GSym1 x) t) t :: a) sG (sY :: Sing y) _ = sY in (applySing ((applySing ((singFun2 @(Let0123456789876543210GSym1 x)) sG)) sX)) STuple0 } sFoo8 (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) = case ((,) (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) (SJust (sWild_0123456789876543210 :: Sing wild_0123456789876543210)) of { (,) (_ :: Sing (wild_0123456789876543210 :: a)) (_ :: Sing ( 'Just (wild_0123456789876543210 :: a) :: Maybe a)) -> let sX :: Sing (Let0123456789876543210XSym1 wild_0123456789876543210) sX = (applySing ((singFun1 @JustSym0) SJust)) (sWild_0123456789876543210 :: Sing (wild_0123456789876543210 :: a)) :: Sing (Apply JustSym0 (wild_0123456789876543210 :: a) :: Maybe a) in sX } sFoo7 (sX :: Sing x) (sWild_0123456789876543210 :: Sing wild_0123456789876543210) = case ((,) (sX :: Sing x)) (sWild_0123456789876543210 :: Sing wild_0123456789876543210) of { (,) (_ :: Sing (x :: a)) (_ :: Sing (wild_0123456789876543210 :: b)) -> sX :: Sing (x :: a) } sFoo6 (SJust (sX :: Sing x)) = case SJust (sX :: Sing x) of { (_ :: Sing ( 'Just x :: Maybe (Maybe a))) -> let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) sScrutinee_0123456789876543210 = sX :: Sing (x :: Maybe a) in (case sScrutinee_0123456789876543210 of { SJust (sY :: Sing y) -> case ((,) (sY :: Sing y)) (SJust (sY :: Sing y)) of { (,) (_ :: Sing (y :: a)) (_ :: Sing ( 'Just (y :: a) :: Maybe a)) -> (applySing ((singFun1 @JustSym0) SJust)) ((applySing ((singFun1 @JustSym0) SJust)) (sY :: Sing (y :: a)) :: Sing (Apply JustSym0 (y :: a) :: Maybe a)) } }) :: Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) :: Maybe (Maybe a)) } sFoo5 (SJust (SJust (sX :: Sing x))) = case (((,,) (sX :: Sing x)) (SJust (sX :: Sing x))) (SJust (SJust (sX :: Sing x))) of { (,,) (_ :: Sing (x :: a)) (_ :: Sing ( 'Just (x :: a) :: Maybe a)) (_ :: Sing ( 'Just ( 'Just (x :: a) :: Maybe a) :: Maybe (Maybe a))) -> (applySing ((singFun1 @JustSym0) SJust)) ((applySing ((singFun1 @JustSym0) SJust)) (sX :: Sing (x :: a)) :: Sing (Apply JustSym0 (x :: a) :: Maybe a)) :: Sing (Apply JustSym0 (Apply JustSym0 (x :: a) :: Maybe a) :: Maybe (Maybe a)) } sFoo4 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 a_0123456789876543210)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { STuple2 (sX :: Sing x) (sY :: Sing y) -> case ((,) (sX :: Sing x)) (sY :: Sing y) of { (,) (_ :: Sing (x :: a)) (_ :: Sing (y :: b)) -> (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) (sY :: Sing (y :: b)))) (sX :: Sing (x :: a)) } }) :: Sing (Case_0123456789876543210 arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) sA_0123456789876543210 sFoo3 (SJust (sX :: Sing x)) = sX :: Sing (x :: a) sFoo2 (SJust (sX :: Sing x)) = case SJust (sX :: Sing x) of { (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) } sFoo1 (SJust (sX :: Sing x)) = case SJust (sX :: Sing x) of { (_ :: Sing ( 'Just x :: Maybe a)) -> sX :: Sing (x :: a) } sG (sX :: Sing x) = let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x) sScrutinee_0123456789876543210 = (applySing ((singFun1 @JustSym0) SJust)) sX in (case sScrutinee_0123456789876543210 of { SJust (sY :: Sing y) -> case SJust (sY :: Sing y) of { (_ :: Sing ( 'Just y :: Maybe Bool)) -> sY :: Sing (y :: Bool) } }) :: Sing (Case_0123456789876543210 x (Let0123456789876543210Scrutinee_0123456789876543210Sym1 x)) sF3 (SJust (sA :: Sing a)) = case SJust (sA :: Sing a) of { (_ :: Sing ( 'Just a :: Maybe Bool)) -> sing :: Sing "hi" } sF2 (sX :: Sing x) = case sX :: Sing x of { (_ :: Sing (x :: Maybe a)) -> sX :: Sing (x :: Maybe a) } sF1 (sX :: Sing x) = case sX :: Sing x of { (_ :: Sing (x :: Maybe Bool)) -> sX :: Sing (x :: Maybe Bool) } instance SingI (Foo9Sym0 :: (~>) a a) where sing = (singFun1 @Foo9Sym0) sFoo9 instance SingI (Foo8Sym0 :: (~>) (Maybe a) (Maybe a)) where sing = (singFun1 @Foo8Sym0) sFoo8 instance SingI (Foo7Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo7Sym0) sFoo7 instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d)) instance SingI (Foo6Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where sing = (singFun1 @Foo6Sym0) sFoo6 instance SingI (Foo5Sym0 :: (~>) (Maybe (Maybe a)) (Maybe (Maybe a))) where sing = (singFun1 @Foo5Sym0) sFoo5 instance SingI (Foo4Sym0 :: (~>) (a, b) (b, a)) where sing = (singFun1 @Foo4Sym0) sFoo4 instance SingI (Foo3Sym0 :: (~>) (Maybe a) a) where sing = (singFun1 @Foo3Sym0) sFoo3 instance SingI (Foo2Sym0 :: (~>) (Maybe a) a) where sing = (singFun1 @Foo2Sym0) sFoo2 instance SingI (Foo1Sym0 :: (~>) (Maybe a) a) where sing = (singFun1 @Foo1Sym0) sFoo1 instance SingI GSym0 where sing = (singFun1 @GSym0) sG instance SingI F3Sym0 where sing = (singFun1 @F3Sym0) sF3 instance SingI F2Sym0 where sing = (singFun1 @F2Sym0) sF2 instance SingI F1Sym0 where sing = (singFun1 @F1Sym0) sF1 singletons-2.5.1/tests/compile-and-dump/Singletons/T183.hs0000755000000000000000000000260507346545000021520 0ustar0000000000000000module T183 where import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| ----- -- Examples from #183 ----- f1 (x :: Maybe Bool) = (x :: Maybe Bool) f2 (x :: Maybe a) = (x :: Maybe a) f3 (Just a :: Maybe Bool) = "hi" g x = case Just x of (Just y :: Maybe Bool) -> (y :: Bool) ----- -- Using explicit type signatures ----- -- No explicit forall foo1 :: Maybe a -> a foo1 (Just x :: Maybe a) = (x :: a) -- Explicit forall foo2, foo3 :: forall a. Maybe a -> a foo2 (Just x :: Maybe a) = (x :: a) foo3 (Just x) = (x :: a) ----- -- Multiple pattern signatures ----- foo4 :: (a, b) -> (b, a) foo4 = \(x :: a, y :: b) -> (y :: b, x :: a) foo5, foo6 :: Maybe (Maybe a) -> Maybe (Maybe a) foo5 (Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a)) = Just (Just (x :: a) :: Maybe a) :: Maybe (Maybe a) foo6 (Just x :: Maybe (Maybe a)) = case x :: Maybe a of (Just (y :: a) :: Maybe a) -> Just (Just (y :: a) :: Maybe a) ----- -- Other pattern features ----- foo7 :: a -> b -> a foo7 (x :: a) (_ :: b) = (x :: a) foo8 :: forall a. Maybe a -> Maybe a foo8 x@(Just (_ :: a) :: Maybe a) = x -- foo8 x@(Nothing :: Maybe a) = x -- #296 ----- -- Type variable scoping (vis-à-vis #297) ----- foo9 :: a -> a foo9 (x :: a) = let g :: a -> b -> a g y _ = y in g x () |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T184.ghc86.template0000755000000000000000000012075607346545000023650 0ustar0000000000000000Singletons/T184.hs:(0,0)-(0,0): Splicing declarations singletons [d| boogie :: Maybe a -> Maybe Bool -> Maybe a boogie ma mb = do a <- ma b <- mb guard b return a zip' :: [a] -> [b] -> [(a, b)] zip' xs ys = [(x, y) | x <- xs | y <- ys] cartProd :: [a] -> [b] -> [(a, b)] cartProd xs ys = [(x, y) | x <- xs, y <- ys] trues :: [Bool] -> [Bool] trues xs = [x | x <- xs, x] |] ======> boogie :: Maybe a -> Maybe Bool -> Maybe a boogie ma mb = do a <- ma b <- mb guard b return a zip' :: [a] -> [b] -> [(a, b)] zip' xs ys = [(x, y) | x <- xs | y <- ys] cartProd :: [a] -> [b] -> [(a, b)] cartProd xs ys = [(x, y) | x <- xs, y <- ys] trues :: [Bool] -> [Bool] trues xs = [x | x <- xs, x] type family Lambda_0123456789876543210 xs t where Lambda_0123456789876543210 xs x = Apply (Apply (>>@#@$) (Apply GuardSym0 x)) (Apply ReturnSym0 x) type Lambda_0123456789876543210Sym2 xs0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Lambda_0123456789876543210 xs ys x t where Lambda_0123456789876543210 xs ys x y = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) type Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 arg) => Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 ys0123456789876543210 x0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 ys0123456789876543210 xs0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Lambda_0123456789876543210 xs ys t where Lambda_0123456789876543210 xs ys x = Apply (Apply (>>=@#@$) ys) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x) type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 ys0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Lambda_0123456789876543210 xs ys t where Lambda_0123456789876543210 xs ys x = Apply ReturnSym0 x type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 ys0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Lambda_0123456789876543210 xs ys t where Lambda_0123456789876543210 xs ys y = Apply ReturnSym0 y type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 ys0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Case_0123456789876543210 xs ys arg_0123456789876543210 t where Case_0123456789876543210 xs ys arg_0123456789876543210 '(x, y) = Apply ReturnSym0 (Apply (Apply Tuple2Sym0 x) y) type family Lambda_0123456789876543210 xs ys t where Lambda_0123456789876543210 xs ys arg_0123456789876543210 = Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall xs0123456789876543210 ys0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210) arg) (Lambda_0123456789876543210Sym3 xs0123456789876543210 ys0123456789876543210 arg) => Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 ys0123456789876543210 xs0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 ys0123456789876543210 xs0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 xs0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall xs0123456789876543210 ys0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) arg) (Lambda_0123456789876543210Sym2 xs0123456789876543210 arg) => Lambda_0123456789876543210Sym1 xs0123456789876543210 ys0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 xs0123456789876543210) ys0123456789876543210 = Lambda_0123456789876543210Sym2 xs0123456789876543210 ys0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 xs0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall xs0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 xs0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 xs0123456789876543210 = Lambda_0123456789876543210Sym1 xs0123456789876543210 type family Lambda_0123456789876543210 ma mb a t where Lambda_0123456789876543210 ma mb a b = Apply (Apply (>>@#@$) (Apply GuardSym0 b)) (Apply ReturnSym0 a) type Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210) arg) (Lambda_0123456789876543210Sym4 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 arg) => Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 mb0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 a0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) a0123456789876543210 = Lambda_0123456789876543210Sym3 mb0123456789876543210 ma0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210 mb0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) => Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 ma0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 ma0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 type family Lambda_0123456789876543210 ma mb t where Lambda_0123456789876543210 ma mb a = Apply (Apply (>>=@#@$) mb) (Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a) type Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall ma0123456789876543210 mb0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210) arg) (Lambda_0123456789876543210Sym3 ma0123456789876543210 mb0123456789876543210 arg) => Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 mb0123456789876543210 ma0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 mb0123456789876543210 ma0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 ma0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall ma0123456789876543210 mb0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) arg) (Lambda_0123456789876543210Sym2 ma0123456789876543210 arg) => Lambda_0123456789876543210Sym1 ma0123456789876543210 mb0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 ma0123456789876543210) mb0123456789876543210 = Lambda_0123456789876543210Sym2 ma0123456789876543210 mb0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 ma0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall ma0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 ma0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 ma0123456789876543210 = Lambda_0123456789876543210Sym1 ma0123456789876543210 type TruesSym1 (a0123456789876543210 :: [Bool]) = Trues a0123456789876543210 instance SuppressUnusedWarnings TruesSym0 where suppressUnusedWarnings = snd (((,) TruesSym0KindInference) ()) data TruesSym0 :: (~>) [Bool] [Bool] where TruesSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TruesSym0 arg) (TruesSym1 arg) => TruesSym0 a0123456789876543210 type instance Apply TruesSym0 a0123456789876543210 = Trues a0123456789876543210 type CartProdSym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = CartProd a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (CartProdSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) CartProdSym1KindInference) ()) data CartProdSym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. (~>) [b0123456789876543210] [(a0123456789876543210, b0123456789876543210)] where CartProdSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (CartProdSym1 a0123456789876543210) arg) (CartProdSym2 a0123456789876543210 arg) => CartProdSym1 a0123456789876543210 a0123456789876543210 type instance Apply (CartProdSym1 a0123456789876543210) a0123456789876543210 = CartProd a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings CartProdSym0 where suppressUnusedWarnings = snd (((,) CartProdSym0KindInference) ()) data CartProdSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, b0123456789876543210)]) where CartProdSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply CartProdSym0 arg) (CartProdSym1 arg) => CartProdSym0 a0123456789876543210 type instance Apply CartProdSym0 a0123456789876543210 = CartProdSym1 a0123456789876543210 type Zip'Sym2 (a0123456789876543210 :: [a0123456789876543210]) (a0123456789876543210 :: [b0123456789876543210]) = Zip' a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Zip'Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Zip'Sym1KindInference) ()) data Zip'Sym1 (a0123456789876543210 :: [a0123456789876543210]) :: forall b0123456789876543210. (~>) [b0123456789876543210] [(a0123456789876543210, b0123456789876543210)] where Zip'Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Zip'Sym1 a0123456789876543210) arg) (Zip'Sym2 a0123456789876543210 arg) => Zip'Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Zip'Sym1 a0123456789876543210) a0123456789876543210 = Zip' a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Zip'Sym0 where suppressUnusedWarnings = snd (((,) Zip'Sym0KindInference) ()) data Zip'Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) [a0123456789876543210] ((~>) [b0123456789876543210] [(a0123456789876543210, b0123456789876543210)]) where Zip'Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Zip'Sym0 arg) (Zip'Sym1 arg) => Zip'Sym0 a0123456789876543210 type instance Apply Zip'Sym0 a0123456789876543210 = Zip'Sym1 a0123456789876543210 type BoogieSym2 (a0123456789876543210 :: Maybe a0123456789876543210) (a0123456789876543210 :: Maybe Bool) = Boogie a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (BoogieSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) BoogieSym1KindInference) ()) data BoogieSym1 (a0123456789876543210 :: Maybe a0123456789876543210) :: (~>) (Maybe Bool) (Maybe a0123456789876543210) where BoogieSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (BoogieSym1 a0123456789876543210) arg) (BoogieSym2 a0123456789876543210 arg) => BoogieSym1 a0123456789876543210 a0123456789876543210 type instance Apply (BoogieSym1 a0123456789876543210) a0123456789876543210 = Boogie a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings BoogieSym0 where suppressUnusedWarnings = snd (((,) BoogieSym0KindInference) ()) data BoogieSym0 :: forall a0123456789876543210. (~>) (Maybe a0123456789876543210) ((~>) (Maybe Bool) (Maybe a0123456789876543210)) where BoogieSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BoogieSym0 arg) (BoogieSym1 arg) => BoogieSym0 a0123456789876543210 type instance Apply BoogieSym0 a0123456789876543210 = BoogieSym1 a0123456789876543210 type family Trues (a :: [Bool]) :: [Bool] where Trues xs = Apply (Apply (>>=@#@$) xs) (Apply Lambda_0123456789876543210Sym0 xs) type family CartProd (a :: [a]) (a :: [b]) :: [(a, b)] where CartProd xs ys = Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) type family Zip' (a :: [a]) (a :: [b]) :: [(a, b)] where Zip' xs ys = Apply (Apply (>>=@#@$) (Apply (Apply MzipSym0 (Apply (Apply (>>=@#@$) xs) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys))) (Apply (Apply (>>=@#@$) ys) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)))) (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) type family Boogie (a :: Maybe a) (a :: Maybe Bool) :: Maybe a where Boogie ma mb = Apply (Apply (>>=@#@$) ma) (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) sTrues :: forall (t :: [Bool]). Sing t -> Sing (Apply TruesSym0 t :: [Bool]) sCartProd :: forall a b (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing (Apply (Apply CartProdSym0 t) t :: [(a, b)]) sZip' :: forall a b (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing (Apply (Apply Zip'Sym0 t) t :: [(a, b)]) sBoogie :: forall a (t :: Maybe a) (t :: Maybe Bool). Sing t -> Sing t -> Sing (Apply (Apply BoogieSym0 t) t :: Maybe a) sTrues (sXs :: Sing xs) = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) ((singFun1 @(Apply Lambda_0123456789876543210Sym0 xs)) (\ sX -> case sX of { (_ :: Sing x) -> (applySing ((applySing ((singFun2 @(>>@#@$)) (%>>))) ((applySing ((singFun1 @GuardSym0) sGuard)) sX))) ((applySing ((singFun1 @ReturnSym0) sReturn)) sX) })) sCartProd (sXs :: Sing xs) (sYs :: Sing ys) = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) (\ sX -> case sX of { (_ :: Sing x) -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs)) ((singFun1 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 xs) ys) x)) (\ sY -> case sY of { (_ :: Sing y) -> (applySing ((singFun1 @ReturnSym0) sReturn)) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) })) })) sZip' (sXs :: Sing xs) (sYs :: Sing ys) = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) ((applySing ((applySing ((singFun2 @MzipSym0) sMzip)) ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sXs)) ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) (\ sX -> case sX of { (_ :: Sing x) -> (applySing ((singFun1 @ReturnSym0) sReturn)) sX }))))) ((applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sYs)) ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) (\ sY -> case sY of { (_ :: Sing y) -> (applySing ((singFun1 @ReturnSym0) sReturn)) sY })))))) ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 xs) ys)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { STuple2 (sX :: Sing x) (sY :: Sing y) -> (applySing ((singFun1 @ReturnSym0) sReturn)) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) }) :: Sing (Case_0123456789876543210 xs ys arg_0123456789876543210 arg_0123456789876543210) })) sBoogie (sMa :: Sing ma) (sMb :: Sing mb) = (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMa)) ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 ma) mb)) (\ sA -> case sA of { (_ :: Sing a) -> (applySing ((applySing ((singFun2 @(>>=@#@$)) (%>>=))) sMb)) ((singFun1 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 ma) mb) a)) (\ sB -> case sB of { (_ :: Sing b) -> (applySing ((applySing ((singFun2 @(>>@#@$)) (%>>))) ((applySing ((singFun1 @GuardSym0) sGuard)) sB))) ((applySing ((singFun1 @ReturnSym0) sReturn)) sA) })) })) instance SingI (TruesSym0 :: (~>) [Bool] [Bool]) where sing = (singFun1 @TruesSym0) sTrues instance SingI (CartProdSym0 :: (~>) [a] ((~>) [b] [(a, b)])) where sing = (singFun2 @CartProdSym0) sCartProd instance SingI d => SingI (CartProdSym1 (d :: [a]) :: (~>) [b] [(a, b)]) where sing = (singFun1 @(CartProdSym1 (d :: [a]))) (sCartProd (sing @d)) instance SingI (Zip'Sym0 :: (~>) [a] ((~>) [b] [(a, b)])) where sing = (singFun2 @Zip'Sym0) sZip' instance SingI d => SingI (Zip'Sym1 (d :: [a]) :: (~>) [b] [(a, b)]) where sing = (singFun1 @(Zip'Sym1 (d :: [a]))) (sZip' (sing @d)) instance SingI (BoogieSym0 :: (~>) (Maybe a) ((~>) (Maybe Bool) (Maybe a))) where sing = (singFun2 @BoogieSym0) sBoogie instance SingI d => SingI (BoogieSym1 (d :: Maybe a) :: (~>) (Maybe Bool) (Maybe a)) where sing = (singFun1 @(BoogieSym1 (d :: Maybe a))) (sBoogie (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T184.hs0000755000000000000000000000107107346545000021515 0ustar0000000000000000{-# LANGUAGE ParallelListComp #-} module T184 where import Control.Monad import Data.Singletons.Prelude import Data.Singletons.Prelude.Monad import Data.Singletons.Prelude.Monad.Zip import Data.Singletons.TH $(singletons [d| boogie :: Maybe a -> Maybe Bool -> Maybe a boogie ma mb = do a <- ma b <- mb guard b return a zip' :: [a] -> [b] -> [(a, b)] zip' xs ys = [(x, y) | x <- xs | y <- ys] cartProd :: [a] -> [b] -> [(a, b)] cartProd xs ys = [(x, y) | x <- xs, y <- ys] trues :: [Bool] -> [Bool] trues xs = [x | x <- xs, x] |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T187.ghc86.template0000755000000000000000000000637407346545000023652 0ustar0000000000000000Singletons/T187.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Empty deriving instance Ord Empty deriving instance Eq Empty |] ======> data Empty deriving instance Eq Empty deriving instance Ord Empty type family Compare_0123456789876543210 (a :: Empty) (a :: Empty) :: Ordering where Compare_0123456789876543210 _ _ = EQSym0 type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Empty) (a0123456789876543210 :: Empty) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Empty) :: (~>) Empty Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) Empty ((~>) Empty Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd Empty where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Empty) (b :: Empty) :: Bool where Equals_0123456789876543210 (_ :: Empty) (_ :: Empty) = TrueSym0 instance PEq Empty where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: Empty -> GHC.Types.Type type SEmpty = (Sing :: Empty -> GHC.Types.Type) instance SingKind Empty where type Demote Empty = Empty fromSing x = case x of toSing x = SomeSing (case x of) instance SOrd Empty where sCompare :: forall (t1 :: Empty) (t2 :: Empty). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun Empty ((~>) Empty Ordering) -> GHC.Types.Type) t1) t2) sCompare _ _ = SEQ instance SEq Empty where (%==) _ _ = STrue instance SDecide Empty where (%~) x _ = Proved (case x of) singletons-2.5.1/tests/compile-and-dump/Singletons/T187.hs0000755000000000000000000000026207346545000021521 0ustar0000000000000000module T187 where import Data.Singletons.TH $(singletons[d| data Empty deriving instance Eq Empty deriving instance Ord Empty |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T190.ghc86.template0000755000000000000000000002754707346545000023651 0ustar0000000000000000Singletons/T190.hs:0:0:: Splicing declarations singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |] ======> data T = T deriving (Eq, Ord, Enum, Bounded, Show) type TSym0 = T type family Compare_0123456789876543210 (a :: T) (a :: T) :: Ordering where Compare_0123456789876543210 T T = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) '[] type Compare_0123456789876543210Sym2 (a0123456789876543210 :: T) (a0123456789876543210 :: T) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: T) :: (~>) T Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: (~>) T ((~>) T Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd T where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Case_0123456789876543210 n t where Case_0123456789876543210 n 'True = TSym0 Case_0123456789876543210 n 'False = Apply ErrorSym0 "toEnum: bad argument" type family ToEnum_0123456789876543210 (a :: GHC.Types.Nat) :: T where ToEnum_0123456789876543210 n = Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0)) type ToEnum_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) = ToEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ToEnum_0123456789876543210Sym0KindInference) ()) data ToEnum_0123456789876543210Sym0 :: (~>) GHC.Types.Nat T where ToEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) => ToEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply ToEnum_0123456789876543210Sym0 a0123456789876543210 = ToEnum_0123456789876543210 a0123456789876543210 type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0 type FromEnum_0123456789876543210Sym1 (a0123456789876543210 :: T) = FromEnum_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) FromEnum_0123456789876543210Sym0KindInference) ()) data FromEnum_0123456789876543210Sym0 :: (~>) T GHC.Types.Nat where FromEnum_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) => FromEnum_0123456789876543210Sym0 a0123456789876543210 type instance Apply FromEnum_0123456789876543210Sym0 a0123456789876543210 = FromEnum_0123456789876543210 a0123456789876543210 instance PEnum T where type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a type family MinBound_0123456789876543210 :: T where MinBound_0123456789876543210 = TSym0 type MinBound_0123456789876543210Sym0 = MinBound_0123456789876543210 type family MaxBound_0123456789876543210 :: T where MaxBound_0123456789876543210 = TSym0 type MaxBound_0123456789876543210Sym0 = MaxBound_0123456789876543210 instance PBounded T where type MinBound = MinBound_0123456789876543210Sym0 type MaxBound = MaxBound_0123456789876543210Sym0 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: T) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ T a_0123456789876543210 = Apply (Apply ShowStringSym0 "T") a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: T) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: (~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: (~>) GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow T where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family Equals_0123456789876543210 (a :: T) (b :: T) :: Bool where Equals_0123456789876543210 T T = TrueSym0 Equals_0123456789876543210 (_ :: T) (_ :: T) = FalseSym0 instance PEq T where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: T -> GHC.Types.Type where ST :: Sing T type ST = (Sing :: T -> GHC.Types.Type) instance SingKind T where type Demote T = T fromSing ST = T toSing T = SomeSing ST instance SOrd T where sCompare :: forall (t1 :: T) (t2 :: T). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun T ((~>) T Ordering) -> GHC.Types.Type) t1) t2) sCompare ST ST = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) Data.Singletons.Prelude.Instances.SNil instance SEnum T where sToEnum :: forall (t :: GHC.Types.Nat). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.ToEnumSym0 :: TyFun GHC.Types.Nat T -> GHC.Types.Type) t) sFromEnum :: forall (t :: T). Sing t -> Sing (Apply (Data.Singletons.Prelude.Enum.FromEnumSym0 :: TyFun T GHC.Types.Nat -> GHC.Types.Type) t) sToEnum (sN :: Sing n) = (case (applySing ((applySing ((singFun2 @(==@#@$)) (%==))) sN)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0)) of STrue -> ST SFalse -> sError (sing :: Sing "toEnum: bad argument")) :: Sing (Case_0123456789876543210 n (Apply (Apply (==@#@$) n) (Data.Singletons.Prelude.Num.FromInteger 0))) sFromEnum ST = Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 0) instance SBounded T where sMinBound :: Sing (MinBoundSym0 :: T) sMaxBound :: Sing (MaxBoundSym0 :: T) sMinBound = ST sMaxBound = ST instance SShow T where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: T) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) T ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> GHC.Types.Type) t1) t2) t3) sShowsPrec _ ST (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "T"))) sA_0123456789876543210 instance SEq T where (%==) ST ST = STrue instance SDecide T where (%~) ST ST = Proved Refl deriving instance Show (Sing (z :: T)) instance SingI T where sing = ST singletons-2.5.1/tests/compile-and-dump/Singletons/T190.hs0000755000000000000000000000054007346545000021512 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module T190 where import Data.Singletons.TH $(singletons [d| data T = T deriving (Eq, Ord, Enum, Bounded, Show) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T197.ghc86.template0000755000000000000000000000405007346545000023640 0ustar0000000000000000Singletons/T197.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixl 5 $$: ($$:) :: Bool -> Bool -> Bool _ $$: _ = False |] ======> infixl 5 $$: ($$:) :: Bool -> Bool -> Bool ($$:) _ _ = False type ($$:@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = ($$:) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) data ($$:@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool where (:$$:@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => ($$:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 infixl 5 $$:@#@$$ instance SuppressUnusedWarnings ($$:@#@$) where suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) data ($$:@#@$) :: (~>) Bool ((~>) Bool Bool) where (:$$:@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => ($$:@#@$) a0123456789876543210 type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 infixl 5 $$:@#@$ type family ($$:) (a :: Bool) (a :: Bool) :: Bool where ($$:) _ _ = FalseSym0 infixl 5 %$$: (%$$:) :: forall (t :: Bool) (t :: Bool). Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: Bool) (%$$:) _ _ = SFalse instance SingI (($$:@#@$) :: (~>) Bool ((~>) Bool Bool)) where sing = (singFun2 @($$:@#@$)) (%$$:) instance SingI d => SingI (($$:@#@$$) (d :: Bool) :: (~>) Bool Bool) where sing = (singFun1 @(($$:@#@$$) (d :: Bool))) ((%$$:) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T197.hs0000755000000000000000000000024407346545000021522 0ustar0000000000000000module T197 where import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| infixl 5 $$: ($$:) :: Bool -> Bool -> Bool _ $$: _ = False |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T197b.ghc86.template0000755000000000000000000001437007346545000024010 0ustar0000000000000000Singletons/T197b.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixr 9 `Pair`, `MkPair` data a :*: b = a :*: b data Pair a b = MkPair a b |] ======> data (:*:) a b = a :*: b data Pair a b = MkPair a b infixr 9 `Pair` infixr 9 `MkPair` type (:*:@#@$$$) (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = (:*:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:*:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::*:@#@$$###)) ()) data (:*:@#@$$) (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210) where (::*:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:*:@#@$$) t0123456789876543210) arg) ((:*:@#@$$$) t0123456789876543210 arg) => (:*:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:*:@#@$$) t0123456789876543210) t0123456789876543210 = (:*:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (:*:@#@$) where suppressUnusedWarnings = snd (((,) (::*:@#@$###)) ()) data (:*:@#@$) :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)) where (::*:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) => (:*:@#@$) t0123456789876543210 type instance Apply (:*:@#@$) t0123456789876543210 = (:*:@#@$$) t0123456789876543210 type MkPairSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = MkPair t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkPairSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkPairSym1KindInference) ()) data MkPairSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210) where MkPairSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkPairSym1 t0123456789876543210) arg) (MkPairSym2 t0123456789876543210 arg) => MkPairSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkPairSym1 t0123456789876543210) t0123456789876543210 = MkPair t0123456789876543210 t0123456789876543210 infixr 9 `MkPairSym1` instance SuppressUnusedWarnings MkPairSym0 where suppressUnusedWarnings = snd (((,) MkPairSym0KindInference) ()) data MkPairSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)) where MkPairSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) => MkPairSym0 t0123456789876543210 type instance Apply MkPairSym0 t0123456789876543210 = MkPairSym1 t0123456789876543210 infixr 9 `MkPairSym0` infixr 9 `SPair` infixr 9 `SMkPair` data instance Sing :: (:*:) a b -> GHC.Types.Type where (:%*:) :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing ((:*:) n n) type (%:*:) = (Sing :: (:*:) a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind ((:*:) a b) where type Demote ((:*:) a b) = (:*:) (Demote a) (Demote b) fromSing ((:%*:) b b) = ((:*:) (fromSing b)) (fromSing b) toSing ((:*:) (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%*:) c) c) } data instance Sing :: Pair a b -> GHC.Types.Type where SMkPair :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (MkPair n n) type SPair = (Sing :: Pair a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Pair a b) where type Demote (Pair a b) = Pair (Demote a) (Demote b) fromSing (SMkPair b b) = (MkPair (fromSing b)) (fromSing b) toSing (MkPair (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SMkPair c) c) } instance (SingI n, SingI n) => SingI ((:*:) (n :: a) (n :: b)) where sing = ((:%*:) sing) sing instance SingI ((:*:@#@$) :: (~>) a ((~>) b ((:*:) a b))) where sing = (singFun2 @(:*:@#@$)) (:%*:) instance SingI (TyCon2 (:*:) :: (~>) a ((~>) b ((:*:) a b))) where sing = (singFun2 @(TyCon2 (:*:))) (:%*:) instance SingI d => SingI ((:*:@#@$$) (d :: a) :: (~>) b ((:*:) a b)) where sing = (singFun1 @((:*:@#@$$) (d :: a))) ((:%*:) (sing @d)) instance SingI d => SingI (TyCon1 ((:*:) (d :: a)) :: (~>) b ((:*:) a b)) where sing = (singFun1 @(TyCon1 ((:*:) (d :: a)))) ((:%*:) (sing @d)) instance (SingI n, SingI n) => SingI (MkPair (n :: a) (n :: b)) where sing = (SMkPair sing) sing instance SingI (MkPairSym0 :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @MkPairSym0) SMkPair instance SingI (TyCon2 MkPair :: (~>) a ((~>) b (Pair a b))) where sing = (singFun2 @(TyCon2 MkPair)) SMkPair instance SingI d => SingI (MkPairSym1 (d :: a) :: (~>) b (Pair a b)) where sing = (singFun1 @(MkPairSym1 (d :: a))) (SMkPair (sing @d)) instance SingI d => SingI (TyCon1 (MkPair (d :: a)) :: (~>) b (Pair a b)) where sing = (singFun1 @(TyCon1 (MkPair (d :: a)))) (SMkPair (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T197b.hs0000755000000000000000000000024307346545000021663 0ustar0000000000000000module T197b where import Data.Singletons.TH $(singletons [d| data a :*: b = a :*: b data Pair a b = MkPair a b infixr 9 `Pair`, `MkPair` |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T200.ghc86.template0000755000000000000000000002655707346545000023641 0ustar0000000000000000Singletons/T200.hs:(0,0)-(0,0): Splicing declarations singletons [d| ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage x $$: y = x :$$: y (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage x <>: y = x :<>: y data ErrorMessage = ErrorMessage :$$: ErrorMessage | ErrorMessage :<>: ErrorMessage | EM [Bool] |] ======> data ErrorMessage = ErrorMessage :$$: ErrorMessage | ErrorMessage :<>: ErrorMessage | EM [Bool] ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage ($$:) x y = (x :$$: y) (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage (<>:) x y = (x :<>: y) type (:$$:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = (:$$:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:$$:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::$$:@#@$$###)) ()) data (:$$:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage where (::$$:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:$$:@#@$$) t0123456789876543210) arg) ((:$$:@#@$$$) t0123456789876543210 arg) => (:$$:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:$$:@#@$$) t0123456789876543210) t0123456789876543210 = (:$$:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (:$$:@#@$) where suppressUnusedWarnings = snd (((,) (::$$:@#@$###)) ()) data (:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where (::$$:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) => (:$$:@#@$) t0123456789876543210 type instance Apply (:$$:@#@$) t0123456789876543210 = (:$$:@#@$$) t0123456789876543210 type (:<>:@#@$$$) (t0123456789876543210 :: ErrorMessage) (t0123456789876543210 :: ErrorMessage) = (:<>:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings ((:<>:@#@$$) t0123456789876543210) where suppressUnusedWarnings = snd (((,) (::<>:@#@$$###)) ()) data (:<>:@#@$$) (t0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage where (::<>:@#@$$###) :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply ((:<>:@#@$$) t0123456789876543210) arg) ((:<>:@#@$$$) t0123456789876543210 arg) => (:<>:@#@$$) t0123456789876543210 t0123456789876543210 type instance Apply ((:<>:@#@$$) t0123456789876543210) t0123456789876543210 = (:<>:) t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (:<>:@#@$) where suppressUnusedWarnings = snd (((,) (::<>:@#@$###)) ()) data (:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where (::<>:@#@$###) :: forall t0123456789876543210 arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) => (:<>:@#@$) t0123456789876543210 type instance Apply (:<>:@#@$) t0123456789876543210 = (:<>:@#@$$) t0123456789876543210 type EMSym1 (t0123456789876543210 :: [Bool]) = EM t0123456789876543210 instance SuppressUnusedWarnings EMSym0 where suppressUnusedWarnings = snd (((,) EMSym0KindInference) ()) data EMSym0 :: (~>) [Bool] ErrorMessage where EMSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) => EMSym0 t0123456789876543210 type instance Apply EMSym0 t0123456789876543210 = EM t0123456789876543210 type (<>:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = (<>:) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((<>:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<>:@#@$$###)) ()) data (<>:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage where (:<>:@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((<>:@#@$$) a0123456789876543210) arg) ((<>:@#@$$$) a0123456789876543210 arg) => (<>:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((<>:@#@$$) a0123456789876543210) a0123456789876543210 = (<>:) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (<>:@#@$) where suppressUnusedWarnings = snd (((,) (:<>:@#@$###)) ()) data (<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where (:<>:@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) => (<>:@#@$) a0123456789876543210 type instance Apply (<>:@#@$) a0123456789876543210 = (<>:@#@$$) a0123456789876543210 type ($$:@#@$$$) (a0123456789876543210 :: ErrorMessage) (a0123456789876543210 :: ErrorMessage) = ($$:) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (($$:@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:$$:@#@$$###)) ()) data ($$:@#@$$) (a0123456789876543210 :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage where (:$$:@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (($$:@#@$$) a0123456789876543210) arg) (($$:@#@$$$) a0123456789876543210 arg) => ($$:@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply (($$:@#@$$) a0123456789876543210) a0123456789876543210 = ($$:) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ($$:@#@$) where suppressUnusedWarnings = snd (((,) (:$$:@#@$###)) ()) data ($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage) where (:$$:@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) => ($$:@#@$) a0123456789876543210 type instance Apply ($$:@#@$) a0123456789876543210 = ($$:@#@$$) a0123456789876543210 type family (<>:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where (<>:) x y = Apply (Apply (:<>:@#@$) x) y type family ($$:) (a :: ErrorMessage) (a :: ErrorMessage) :: ErrorMessage where ($$:) x y = Apply (Apply (:$$:@#@$) x) y (%<>:) :: forall (t :: ErrorMessage) (t :: ErrorMessage). Sing t -> Sing t -> Sing (Apply (Apply (<>:@#@$) t) t :: ErrorMessage) (%$$:) :: forall (t :: ErrorMessage) (t :: ErrorMessage). Sing t -> Sing t -> Sing (Apply (Apply ($$:@#@$) t) t :: ErrorMessage) (%<>:) (sX :: Sing x) (sY :: Sing y) = (applySing ((applySing ((singFun2 @(:<>:@#@$)) (:%<>:))) sX)) sY (%$$:) (sX :: Sing x) (sY :: Sing y) = (applySing ((applySing ((singFun2 @(:$$:@#@$)) (:%$$:))) sX)) sY instance SingI ((<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @(<>:@#@$)) (%<>:) instance SingI d => SingI ((<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @((<>:@#@$$) (d :: ErrorMessage))) ((%<>:) (sing @d)) instance SingI (($$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @($$:@#@$)) (%$$:) instance SingI d => SingI (($$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @(($$:@#@$$) (d :: ErrorMessage))) ((%$$:) (sing @d)) data instance Sing :: ErrorMessage -> GHC.Types.Type where (:%$$:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). (Sing (n :: ErrorMessage)) -> (Sing (n :: ErrorMessage)) -> Sing ((:$$:) n n) (:%<>:) :: forall (n :: ErrorMessage) (n :: ErrorMessage). (Sing (n :: ErrorMessage)) -> (Sing (n :: ErrorMessage)) -> Sing ((:<>:) n n) SEM :: forall (n :: [Bool]). (Sing (n :: [Bool])) -> Sing (EM n) type SErrorMessage = (Sing :: ErrorMessage -> GHC.Types.Type) instance SingKind ErrorMessage where type Demote ErrorMessage = ErrorMessage fromSing ((:%$$:) b b) = ((:$$:) (fromSing b)) (fromSing b) fromSing ((:%<>:) b b) = ((:<>:) (fromSing b)) (fromSing b) fromSing (SEM b) = EM (fromSing b) toSing ((:$$:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) = case ((,) (toSing b :: SomeSing ErrorMessage)) (toSing b :: SomeSing ErrorMessage) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%$$:) c) c) } toSing ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage)) = case ((,) (toSing b :: SomeSing ErrorMessage)) (toSing b :: SomeSing ErrorMessage) of { (,) (SomeSing c) (SomeSing c) -> SomeSing (((:%<>:) c) c) } toSing (EM (b :: Demote [Bool])) = case toSing b :: SomeSing [Bool] of { SomeSing c -> SomeSing (SEM c) } instance (SingI n, SingI n) => SingI ((:$$:) (n :: ErrorMessage) (n :: ErrorMessage)) where sing = ((:%$$:) sing) sing instance SingI ((:$$:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @(:$$:@#@$)) (:%$$:) instance SingI (TyCon2 (:$$:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @(TyCon2 (:$$:))) (:%$$:) instance SingI d => SingI ((:$$:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @((:$$:@#@$$) (d :: ErrorMessage))) ((:%$$:) (sing @d)) instance SingI d => SingI (TyCon1 ((:$$:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @(TyCon1 ((:$$:) (d :: ErrorMessage)))) ((:%$$:) (sing @d)) instance (SingI n, SingI n) => SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where sing = ((:%<>:) sing) sing instance SingI ((:<>:@#@$) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @(:<>:@#@$)) (:%<>:) instance SingI (TyCon2 (:<>:) :: (~>) ErrorMessage ((~>) ErrorMessage ErrorMessage)) where sing = (singFun2 @(TyCon2 (:<>:))) (:%<>:) instance SingI d => SingI ((:<>:@#@$$) (d :: ErrorMessage) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @((:<>:@#@$$) (d :: ErrorMessage))) ((:%<>:) (sing @d)) instance SingI d => SingI (TyCon1 ((:<>:) (d :: ErrorMessage)) :: (~>) ErrorMessage ErrorMessage) where sing = (singFun1 @(TyCon1 ((:<>:) (d :: ErrorMessage)))) ((:%<>:) (sing @d)) instance SingI n => SingI (EM (n :: [Bool])) where sing = SEM sing instance SingI (EMSym0 :: (~>) [Bool] ErrorMessage) where sing = (singFun1 @EMSym0) SEM instance SingI (TyCon1 EM :: (~>) [Bool] ErrorMessage) where sing = (singFun1 @(TyCon1 EM)) SEM singletons-2.5.1/tests/compile-and-dump/Singletons/T200.hs0000755000000000000000000000061107346545000021501 0ustar0000000000000000module T200 where import Data.Singletons.TH $(singletons [d| data ErrorMessage = ErrorMessage :$$: ErrorMessage | ErrorMessage :<>: ErrorMessage | EM [Bool] ($$:) :: ErrorMessage -> ErrorMessage -> ErrorMessage x $$: y = x :$$: y (<>:) :: ErrorMessage -> ErrorMessage -> ErrorMessage x <>: y = x :<>: y |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T206.ghc86.template0000755000000000000000000000000007346545000023616 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/T206.hs0000755000000000000000000000012307346545000021505 0ustar0000000000000000module T206 where import Data.Singletons.Prelude x = SCons @Bool @True @'[False] singletons-2.5.1/tests/compile-and-dump/Singletons/T209.ghc86.template0000755000000000000000000001007707346545000023640 0ustar0000000000000000Singletons/T209.hs:(0,0)-(0,0): Splicing declarations singletons [d| m :: a -> b -> Bool -> Bool m _ _ x = x class C a b data Hm = Hm deriving anyclass (C Bool) deriving anyclass instance C a a => C a (Maybe a) |] ======> class C a b m :: a -> b -> Bool -> Bool m _ _ x = x data Hm = Hm deriving anyclass (C Bool) deriving anyclass instance C a a => C a (Maybe a) type HmSym0 = Hm type MSym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: Bool) = M a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (MSym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) MSym2KindInference) ()) data MSym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: (~>) Bool Bool where MSym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (MSym2 a0123456789876543210 a0123456789876543210) arg) (MSym3 a0123456789876543210 a0123456789876543210 arg) => MSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (MSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = M a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (MSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) MSym1KindInference) ()) data MSym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 ((~>) Bool Bool) where MSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (MSym1 a0123456789876543210) arg) (MSym2 a0123456789876543210 arg) => MSym1 a0123456789876543210 a0123456789876543210 type instance Apply (MSym1 a0123456789876543210) a0123456789876543210 = MSym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings MSym0 where suppressUnusedWarnings = snd (((,) MSym0KindInference) ()) data MSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) Bool Bool)) where MSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply MSym0 arg) (MSym1 arg) => MSym0 a0123456789876543210 type instance Apply MSym0 a0123456789876543210 = MSym1 a0123456789876543210 type family M (a :: a) (a :: b) (a :: Bool) :: Bool where M _ _ x = x class PC (a :: GHC.Types.Type) (b :: GHC.Types.Type) instance PC Bool Hm instance PC a (Maybe a) sM :: forall a b (t :: a) (t :: b) (t :: Bool). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply MSym0 t) t) t :: Bool) sM _ _ (sX :: Sing x) = sX instance SingI (MSym0 :: (~>) a ((~>) b ((~>) Bool Bool))) where sing = (singFun3 @MSym0) sM instance SingI d => SingI (MSym1 (d :: a) :: (~>) b ((~>) Bool Bool)) where sing = (singFun2 @(MSym1 (d :: a))) (sM (sing @d)) instance (SingI d, SingI d) => SingI (MSym2 (d :: a) (d :: b) :: (~>) Bool Bool) where sing = (singFun1 @(MSym2 (d :: a) (d :: b))) ((sM (sing @d)) (sing @d)) data instance Sing :: Hm -> GHC.Types.Type where SHm :: Sing Hm type SHm = (Sing :: Hm -> GHC.Types.Type) instance SingKind Hm where type Demote Hm = Hm fromSing SHm = Hm toSing Hm = SomeSing SHm class SC a b instance SC Bool Hm instance SC a a => SC a (Maybe a) instance SingI Hm where sing = SHm singletons-2.5.1/tests/compile-and-dump/Singletons/T209.hs0000755000000000000000000000050307346545000021512 0ustar0000000000000000{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} module T209 where import Data.Singletons.TH $(singletons [d| class C a b where m :: a -> b -> Bool -> Bool m _ _ x = x data Hm = Hm deriving anyclass (C Bool) deriving anyclass instance C a a => C a (Maybe a) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T216.ghc86.template0000755000000000000000000001112207346545000023626 0ustar0000000000000000Singletons/T216.hs:0:0:: Splicing declarations genDefunSymbols [''MyProxy, ''Symmetry] ======> type MyProxySym2 (k0123456789876543210 :: Type) (a0123456789876543210 :: k0123456789876543210) = MyProxy k0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (MyProxySym1 k0123456789876543210) where suppressUnusedWarnings = snd (((,) MyProxySym1KindInference) ()) data MyProxySym1 (k0123456789876543210 :: Type) :: (~>) k0123456789876543210 Type where MyProxySym1KindInference :: forall k0123456789876543210 a0123456789876543210 arg. SameKind (Apply (MyProxySym1 k0123456789876543210) arg) (MyProxySym2 k0123456789876543210 arg) => MyProxySym1 k0123456789876543210 a0123456789876543210 type instance Apply (MyProxySym1 k0123456789876543210) a0123456789876543210 = MyProxy k0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings MyProxySym0 where suppressUnusedWarnings = snd (((,) MyProxySym0KindInference) ()) data MyProxySym0 :: forall (k0123456789876543210 :: Type). (~>) Type ((~>) k0123456789876543210 Type) where MyProxySym0KindInference :: forall k0123456789876543210 arg. SameKind (Apply MyProxySym0 arg) (MyProxySym1 arg) => MyProxySym0 k0123456789876543210 type instance Apply MyProxySym0 k0123456789876543210 = MyProxySym1 k0123456789876543210 type SymmetrySym3 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) (e0123456789876543210 :: (:~:) a0123456789876543210 y0123456789876543210) = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) data SymmetrySym2 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210) :: (~>) ((:~:) a0123456789876543210 y0123456789876543210) Type where SymmetrySym2KindInference :: forall a0123456789876543210 y0123456789876543210 e0123456789876543210 arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) data SymmetrySym1 (a0123456789876543210 :: t0123456789876543210) :: forall (y0123456789876543210 :: t0123456789876543210). (~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type) where SymmetrySym1KindInference :: forall a0123456789876543210 y0123456789876543210 arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => SymmetrySym1 a0123456789876543210 y0123456789876543210 type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings SymmetrySym0 where suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) data SymmetrySym0 :: forall t0123456789876543210 (a0123456789876543210 :: t0123456789876543210) (y0123456789876543210 :: t0123456789876543210). (~>) t0123456789876543210 ((~>) t0123456789876543210 ((~>) ((:~:) a0123456789876543210 y0123456789876543210) Type)) where SymmetrySym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => SymmetrySym0 a0123456789876543210 type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Singletons/T216.hs0000755000000000000000000000042007346545000021506 0ustar0000000000000000module T216 where import Data.Kind import Data.Singletons.TH type family MyProxy k (a :: k) :: Type where MyProxy _ a = Proxy a type family Symmetry (a :: t) (y :: t) (e :: a :~: y) :: Type where Symmetry a y _ = y :~: a $(genDefunSymbols [''MyProxy, ''Symmetry]) singletons-2.5.1/tests/compile-and-dump/Singletons/T226.ghc86.template0000755000000000000000000000027707346545000023640 0ustar0000000000000000Singletons/T226.hs:0:0:: Splicing declarations singletons [d| class a ~> b |] ======> class (~>) a b class (#~>) (a :: GHC.Types.Type) (b :: GHC.Types.Type) class (%~>) a b singletons-2.5.1/tests/compile-and-dump/Singletons/T226.hs0000755000000000000000000000012007346545000021504 0ustar0000000000000000module T226 where import Data.Singletons.TH $(singletons [d| class a ~> b |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T229.ghc86.template0000755000000000000000000000207307346545000023637 0ustar0000000000000000Singletons/T229.hs:(0,0)-(0,0): Splicing declarations singletons [d| ___foo :: Bool -> Bool ___foo _ = True |] ======> ___foo :: Bool -> Bool ___foo _ = True type US___fooSym1 (a0123456789876543210 :: Bool) = US___foo a0123456789876543210 instance SuppressUnusedWarnings US___fooSym0 where suppressUnusedWarnings = snd (((,) US___fooSym0KindInference) ()) data US___fooSym0 :: (~>) Bool Bool where US___fooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) => US___fooSym0 a0123456789876543210 type instance Apply US___fooSym0 a0123456789876543210 = US___foo a0123456789876543210 type family US___foo (a :: Bool) :: Bool where US___foo _ = TrueSym0 ___sfoo :: forall (t :: Bool). Sing t -> Sing (Apply US___fooSym0 t :: Bool) ___sfoo _ = STrue instance SingI (US___fooSym0 :: (~>) Bool Bool) where sing = (singFun1 @US___fooSym0) ___sfoo singletons-2.5.1/tests/compile-and-dump/Singletons/T229.hs0000755000000000000000000000017307346545000021517 0ustar0000000000000000module T229 where import Data.Singletons.TH $(singletons [d| ___foo :: Bool -> Bool ___foo _ = True |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T249.ghc86.template0000755000000000000000000001077107346545000023645 0ustar0000000000000000Singletons/T249.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Foo1 a = MkFoo1 a data Foo2 a where MkFoo2 :: x -> Foo2 x data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |] ======> data Foo1 a = MkFoo1 a data Foo2 a where MkFoo2 :: x -> Foo2 x data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x type MkFoo1Sym1 (t0123456789876543210 :: a0123456789876543210) = MkFoo1 t0123456789876543210 instance SuppressUnusedWarnings MkFoo1Sym0 where suppressUnusedWarnings = snd (((,) MkFoo1Sym0KindInference) ()) data MkFoo1Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 (Foo1 a0123456789876543210) where MkFoo1Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) => MkFoo1Sym0 t0123456789876543210 type instance Apply MkFoo1Sym0 t0123456789876543210 = MkFoo1 t0123456789876543210 type MkFoo2Sym1 (t0123456789876543210 :: x0123456789876543210) = MkFoo2 t0123456789876543210 instance SuppressUnusedWarnings MkFoo2Sym0 where suppressUnusedWarnings = snd (((,) MkFoo2Sym0KindInference) ()) data MkFoo2Sym0 :: forall x0123456789876543210. (~>) x0123456789876543210 (Foo2 x0123456789876543210) where MkFoo2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) => MkFoo2Sym0 t0123456789876543210 type instance Apply MkFoo2Sym0 t0123456789876543210 = MkFoo2 t0123456789876543210 type MkFoo3Sym1 (t0123456789876543210 :: x0123456789876543210) = MkFoo3 t0123456789876543210 instance SuppressUnusedWarnings MkFoo3Sym0 where suppressUnusedWarnings = snd (((,) MkFoo3Sym0KindInference) ()) data MkFoo3Sym0 :: forall x0123456789876543210. (~>) x0123456789876543210 (Foo3 x0123456789876543210) where MkFoo3Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) => MkFoo3Sym0 t0123456789876543210 type instance Apply MkFoo3Sym0 t0123456789876543210 = MkFoo3 t0123456789876543210 data instance Sing :: Foo1 a -> Type where SMkFoo1 :: forall a (n :: a). (Sing (n :: a)) -> Sing (MkFoo1 n) type SFoo1 = (Sing :: Foo1 a -> Type) instance SingKind a => SingKind (Foo1 a) where type Demote (Foo1 a) = Foo1 (Demote a) fromSing (SMkFoo1 b) = MkFoo1 (fromSing b) toSing (MkFoo1 (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SMkFoo1 c) } data instance Sing :: Foo2 a -> Type where SMkFoo2 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo2 n) type SFoo2 = (Sing :: Foo2 a -> Type) instance SingKind a => SingKind (Foo2 a) where type Demote (Foo2 a) = Foo2 (Demote a) fromSing (SMkFoo2 b) = MkFoo2 (fromSing b) toSing (MkFoo2 (b :: Demote x)) = case toSing b :: SomeSing x of { SomeSing c -> SomeSing (SMkFoo2 c) } data instance Sing :: Foo3 a -> Type where SMkFoo3 :: forall x (n :: x). (Sing (n :: x)) -> Sing (MkFoo3 n) type SFoo3 = (Sing :: Foo3 a -> Type) instance SingKind a => SingKind (Foo3 a) where type Demote (Foo3 a) = Foo3 (Demote a) fromSing (SMkFoo3 b) = MkFoo3 (fromSing b) toSing (MkFoo3 (b :: Demote x)) = case toSing b :: SomeSing x of { SomeSing c -> SomeSing (SMkFoo3 c) } instance SingI n => SingI (MkFoo1 (n :: a)) where sing = SMkFoo1 sing instance SingI (MkFoo1Sym0 :: (~>) a (Foo1 a)) where sing = (singFun1 @MkFoo1Sym0) SMkFoo1 instance SingI (TyCon1 MkFoo1 :: (~>) a (Foo1 a)) where sing = (singFun1 @(TyCon1 MkFoo1)) SMkFoo1 instance SingI n => SingI (MkFoo2 (n :: x)) where sing = SMkFoo2 sing instance SingI (MkFoo2Sym0 :: (~>) x (Foo2 x)) where sing = (singFun1 @MkFoo2Sym0) SMkFoo2 instance SingI (TyCon1 MkFoo2 :: (~>) x (Foo2 x)) where sing = (singFun1 @(TyCon1 MkFoo2)) SMkFoo2 instance SingI n => SingI (MkFoo3 (n :: x)) where sing = SMkFoo3 sing instance SingI (MkFoo3Sym0 :: (~>) x (Foo3 x)) where sing = (singFun1 @MkFoo3Sym0) SMkFoo3 instance SingI (TyCon1 MkFoo3 :: (~>) x (Foo3 x)) where sing = (singFun1 @(TyCon1 MkFoo3)) SMkFoo3 singletons-2.5.1/tests/compile-and-dump/Singletons/T249.hs0000755000000000000000000000034707346545000021524 0ustar0000000000000000module T249 where import Data.Kind import Data.Singletons.TH $(singletons [d| data Foo1 a = MkFoo1 a data Foo2 a where MkFoo2 :: x -> Foo2 x data Foo3 a where MkFoo3 :: forall x. x -> Foo3 x |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T271.ghc86.template0000755000000000000000000003067307346545000023643 0ustar0000000000000000Singletons/T271.hs:(0,0)-(0,0): Splicing declarations singletons [d| newtype Constant (a :: Type) (b :: Type) = Constant a deriving (Eq, Ord) data Identity :: Type -> Type where Identity :: a -> Identity a deriving (Eq, Ord) |] ======> newtype Constant (a :: Type) (b :: Type) = Constant a deriving (Eq, Ord) data Identity :: Type -> Type where Identity :: a -> Identity a deriving (Eq, Ord) type ConstantSym1 (t0123456789876543210 :: a0123456789876543210) = Constant t0123456789876543210 instance SuppressUnusedWarnings ConstantSym0 where suppressUnusedWarnings = snd (((,) ConstantSym0KindInference) ()) data ConstantSym0 :: forall (a0123456789876543210 :: Type) (b0123456789876543210 :: Type). (~>) a0123456789876543210 (Constant (a0123456789876543210 :: Type) (b0123456789876543210 :: Type)) where ConstantSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) => ConstantSym0 t0123456789876543210 type instance Apply ConstantSym0 t0123456789876543210 = Constant t0123456789876543210 type IdentitySym1 (t0123456789876543210 :: a0123456789876543210) = Identity t0123456789876543210 instance SuppressUnusedWarnings IdentitySym0 where suppressUnusedWarnings = snd (((,) IdentitySym0KindInference) ()) data IdentitySym0 :: forall a0123456789876543210. (~>) a0123456789876543210 (Identity a0123456789876543210) where IdentitySym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) => IdentitySym0 t0123456789876543210 type instance Apply IdentitySym0 t0123456789876543210 = Identity t0123456789876543210 type family Compare_0123456789876543210 (a :: Constant a b) (a :: Constant a b) :: Ordering where Compare_0123456789876543210 (Constant a_0123456789876543210) (Constant b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Constant a0123456789876543210 b0123456789876543210) :: (~>) (Constant a0123456789876543210 b0123456789876543210) Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (Constant a0123456789876543210 b0123456789876543210) ((~>) (Constant a0123456789876543210 b0123456789876543210) Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd (Constant a b) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Compare_0123456789876543210 (a :: Identity a) (a :: Identity a) :: Ordering where Compare_0123456789876543210 (Identity a_0123456789876543210) (Identity b_0123456789876543210) = Apply (Apply (Apply FoldlSym0 ThenCmpSym0) EQSym0) (Apply (Apply (:@#@$) (Apply (Apply CompareSym0 a_0123456789876543210) b_0123456789876543210)) '[]) type Compare_0123456789876543210Sym2 (a0123456789876543210 :: Identity a0123456789876543210) (a0123456789876543210 :: Identity a0123456789876543210) = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Compare_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym1KindInference) ()) data Compare_0123456789876543210Sym1 (a0123456789876543210 :: Identity a0123456789876543210) :: (~>) (Identity a0123456789876543210) Ordering where Compare_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Compare_0123456789876543210Sym1 a0123456789876543210) arg) (Compare_0123456789876543210Sym2 a0123456789876543210 arg) => Compare_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Compare_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Compare_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Compare_0123456789876543210Sym0KindInference) ()) data Compare_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) (Identity a0123456789876543210) ((~>) (Identity a0123456789876543210) Ordering) where Compare_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) => Compare_0123456789876543210Sym0 a0123456789876543210 type instance Apply Compare_0123456789876543210Sym0 a0123456789876543210 = Compare_0123456789876543210Sym1 a0123456789876543210 instance POrd (Identity a) where type Compare a a = Apply (Apply Compare_0123456789876543210Sym0 a) a type family Equals_0123456789876543210 (a :: Constant a b) (b :: Constant a b) :: Bool where Equals_0123456789876543210 (Constant a) (Constant b) = (==) a b Equals_0123456789876543210 (_ :: Constant a b) (_ :: Constant a b) = FalseSym0 instance PEq (Constant a b) where type (==) a b = Equals_0123456789876543210 a b type family Equals_0123456789876543210 (a :: Identity a) (b :: Identity a) :: Bool where Equals_0123456789876543210 (Identity a) (Identity b) = (==) a b Equals_0123456789876543210 (_ :: Identity a) (_ :: Identity a) = FalseSym0 instance PEq (Identity a) where type (==) a b = Equals_0123456789876543210 a b data instance Sing :: Constant a b -> Type where SConstant :: forall a (n :: a). (Sing (n :: a)) -> Sing (Constant n) type SConstant = (Sing :: Constant a b -> Type) instance (SingKind a, SingKind b) => SingKind (Constant a b) where type Demote (Constant a b) = Constant (Demote a) (Demote b) fromSing (SConstant b) = Constant (fromSing b) toSing (Constant (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SConstant c) } data instance Sing :: Identity a -> Type where SIdentity :: forall a (n :: a). (Sing (n :: a)) -> Sing (Identity n) type SIdentity = (Sing :: Identity a -> Type) instance SingKind a => SingKind (Identity a) where type Demote (Identity a) = Identity (Demote a) fromSing (SIdentity b) = Identity (fromSing b) toSing (Identity (b :: Demote a)) = case toSing b :: SomeSing a of { SomeSing c -> SomeSing (SIdentity c) } instance SOrd a => SOrd (Constant a b) where sCompare :: forall (t1 :: Constant a b) (t2 :: Constant a b). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun (Constant a b) ((~>) (Constant a b) Ordering) -> Type) t1) t2) sCompare (SConstant (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SConstant (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) Data.Singletons.Prelude.Instances.SNil) instance SOrd a => SOrd (Identity a) where sCompare :: forall (t1 :: Identity a) (t2 :: Identity a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (CompareSym0 :: TyFun (Identity a) ((~>) (Identity a) Ordering) -> Type) t1) t2) sCompare (SIdentity (sA_0123456789876543210 :: Sing a_0123456789876543210)) (SIdentity (sB_0123456789876543210 :: Sing b_0123456789876543210)) = (applySing ((applySing ((applySing ((singFun3 @FoldlSym0) sFoldl)) ((singFun2 @ThenCmpSym0) sThenCmp))) SEQ)) ((applySing ((applySing ((singFun2 @(:@#@$)) Data.Singletons.Prelude.Instances.SCons)) ((applySing ((applySing ((singFun2 @CompareSym0) sCompare)) sA_0123456789876543210)) sB_0123456789876543210))) Data.Singletons.Prelude.Instances.SNil) instance SEq a => SEq (Constant a b) where (%==) (SConstant a) (SConstant b) = ((%==) a) b instance SDecide a => SDecide (Constant a b) where (%~) (SConstant a) (SConstant b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SEq a => SEq (Identity a) where (%==) (SIdentity a) (SIdentity b) = ((%==) a) b instance SDecide a => SDecide (Identity a) where (%~) (SIdentity a) (SIdentity b) = case ((%~) a) b of Proved Refl -> Proved Refl Disproved contra -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) instance SingI n => SingI (Constant (n :: a)) where sing = SConstant sing instance SingI (ConstantSym0 :: (~>) a (Constant (a :: Type) (b :: Type))) where sing = (singFun1 @ConstantSym0) SConstant instance SingI (TyCon1 Constant :: (~>) a (Constant (a :: Type) (b :: Type))) where sing = (singFun1 @(TyCon1 Constant)) SConstant instance SingI n => SingI (Identity (n :: a)) where sing = SIdentity sing instance SingI (IdentitySym0 :: (~>) a (Identity a)) where sing = (singFun1 @IdentitySym0) SIdentity instance SingI (TyCon1 Identity :: (~>) a (Identity a)) where sing = (singFun1 @(TyCon1 Identity)) SIdentity singletons-2.5.1/tests/compile-and-dump/Singletons/T271.hs0000755000000000000000000000045007346545000021512 0ustar0000000000000000module T271 where import Data.Kind (Type) import Data.Singletons.TH $(singletons [d| newtype Constant (a :: Type) (b :: Type) = Constant a deriving (Eq, Ord) data Identity :: Type -> Type where Identity :: a -> Identity a deriving (Eq, Ord) |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T287.ghc86.template0000755000000000000000000002124307346545000023643 0ustar0000000000000000Singletons/T287.hs:(0,0)-(0,0): Splicing declarations singletons [d| class S a where (<<>>) :: a -> a -> a instance S b => S (a -> b) where f <<>> g = \ x -> f x <<>> g x |] ======> class S a where (<<>>) :: a -> a -> a instance S b => S (a -> b) where (<<>>) f g = \ x -> (f x <<>> g x) type (<<>>@#@$$$) (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: a0123456789876543210) = (<<>>) arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings ((<<>>@#@$$) arg0123456789876543210) where suppressUnusedWarnings = snd (((,) (:<<>>@#@$$###)) ()) data (<<>>@#@$$) (arg0123456789876543210 :: a0123456789876543210) :: (~>) a0123456789876543210 a0123456789876543210 where (:<<>>@#@$$###) :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply ((<<>>@#@$$) arg0123456789876543210) arg) ((<<>>@#@$$$) arg0123456789876543210 arg) => (<<>>@#@$$) arg0123456789876543210 arg0123456789876543210 type instance Apply ((<<>>@#@$$) arg0123456789876543210) arg0123456789876543210 = (<<>>) arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (<<>>@#@$) where suppressUnusedWarnings = snd (((,) (:<<>>@#@$###)) ()) data (<<>>@#@$) :: forall a0123456789876543210. (~>) a0123456789876543210 ((~>) a0123456789876543210 a0123456789876543210) where (:<<>>@#@$###) :: forall arg0123456789876543210 arg. SameKind (Apply (<<>>@#@$) arg) ((<<>>@#@$$) arg) => (<<>>@#@$) arg0123456789876543210 type instance Apply (<<>>@#@$) arg0123456789876543210 = (<<>>@#@$$) arg0123456789876543210 class PS (a :: GHC.Types.Type) where type (<<>>) (arg :: a) (arg :: a) :: a type family Lambda_0123456789876543210 f g t where Lambda_0123456789876543210 f g x = Apply (Apply (<<>>@#@$) (Apply f x)) (Apply g x) type Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 f0123456789876543210 g0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall f0123456789876543210 g0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210) arg) (Lambda_0123456789876543210Sym3 f0123456789876543210 g0123456789876543210 arg) => Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 g0123456789876543210 f0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 g0123456789876543210 f0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 f0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall f0123456789876543210 g0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) arg) (Lambda_0123456789876543210Sym2 f0123456789876543210 arg) => Lambda_0123456789876543210Sym1 f0123456789876543210 g0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 f0123456789876543210) g0123456789876543210 = Lambda_0123456789876543210Sym2 f0123456789876543210 g0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 f0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall f0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 f0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 f0123456789876543210 = Lambda_0123456789876543210Sym1 f0123456789876543210 type family TFHelper_0123456789876543210 (a :: (~>) a b) (a :: (~>) a b) :: (~>) a b where TFHelper_0123456789876543210 f g = Apply (Apply Lambda_0123456789876543210Sym0 f) g type TFHelper_0123456789876543210Sym2 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (TFHelper_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym1KindInference) ()) data TFHelper_0123456789876543210Sym1 (a0123456789876543210 :: (~>) a0123456789876543210 b0123456789876543210) :: (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210) where TFHelper_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) arg) (TFHelper_0123456789876543210Sym2 a0123456789876543210 arg) => TFHelper_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (TFHelper_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = TFHelper_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) TFHelper_0123456789876543210Sym0KindInference) ()) data TFHelper_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) ((~>) a0123456789876543210 b0123456789876543210) ((~>) a0123456789876543210 b0123456789876543210)) where TFHelper_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) => TFHelper_0123456789876543210Sym0 a0123456789876543210 type instance Apply TFHelper_0123456789876543210Sym0 a0123456789876543210 = TFHelper_0123456789876543210Sym1 a0123456789876543210 instance PS ((~>) a b) where type (<<>>) a a = Apply (Apply TFHelper_0123456789876543210Sym0 a) a class SS a where (%<<>>) :: forall (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: a) instance SS b => SS ((~>) a b) where (%<<>>) :: forall (t :: (~>) a b) (t :: (~>) a b). Sing t -> Sing t -> Sing (Apply (Apply (<<>>@#@$) t) t :: (~>) a b) (%<<>>) (sF :: Sing f) (sG :: Sing g) = (singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 f) g)) (\ sX -> case sX of { (_ :: Sing x) -> (applySing ((applySing ((singFun2 @(<<>>@#@$)) (%<<>>))) ((applySing sF) sX))) ((applySing sG) sX) }) instance SS a => SingI ((<<>>@#@$) :: (~>) a ((~>) a a)) where sing = (singFun2 @(<<>>@#@$)) (%<<>>) instance (SS a, SingI d) => SingI ((<<>>@#@$$) (d :: a) :: (~>) a a) where sing = (singFun1 @((<<>>@#@$$) (d :: a))) ((%<<>>) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T287.hs0000755000000000000000000000026707346545000021527 0ustar0000000000000000module T287 where import Data.Singletons.TH $(singletons [d| class S a where (<<>>) :: a -> a -> a instance S b => S (a -> b) where f <<>> g = \x -> f x <<>> g x |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T29.ghc86.template0000755000000000000000000001167507346545000023565 0ustar0000000000000000Singletons/T29.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: Bool -> Bool foo x = not $ x bar :: Bool -> Bool bar x = not . not . not $ x baz :: Bool -> Bool baz x = not $! x ban :: Bool -> Bool ban x = not . not . not $! x |] ======> foo :: Bool -> Bool foo x = (not $ x) bar :: Bool -> Bool bar x = ((not . (not . not)) $ x) baz :: Bool -> Bool baz x = (not $! x) ban :: Bool -> Bool ban x = ((not . (not . not)) $! x) type BanSym1 (a0123456789876543210 :: Bool) = Ban a0123456789876543210 instance SuppressUnusedWarnings BanSym0 where suppressUnusedWarnings = snd (((,) BanSym0KindInference) ()) data BanSym0 :: (~>) Bool Bool where BanSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) => BanSym0 a0123456789876543210 type instance Apply BanSym0 a0123456789876543210 = Ban a0123456789876543210 type BazSym1 (a0123456789876543210 :: Bool) = Baz a0123456789876543210 instance SuppressUnusedWarnings BazSym0 where suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) data BazSym0 :: (~>) Bool Bool where BazSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => BazSym0 a0123456789876543210 type instance Apply BazSym0 a0123456789876543210 = Baz a0123456789876543210 type BarSym1 (a0123456789876543210 :: Bool) = Bar a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bool Bool where BarSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 type FooSym1 (a0123456789876543210 :: Bool) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool Bool where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Ban (a :: Bool) :: Bool where Ban x = Apply (Apply ($!@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x type family Baz (a :: Bool) :: Bool where Baz x = Apply (Apply ($!@#@$) NotSym0) x type family Bar (a :: Bool) :: Bool where Bar x = Apply (Apply ($@#@$) (Apply (Apply (.@#@$) NotSym0) (Apply (Apply (.@#@$) NotSym0) NotSym0))) x type family Foo (a :: Bool) :: Bool where Foo x = Apply (Apply ($@#@$) NotSym0) x sBan :: forall (t :: Bool). Sing t -> Sing (Apply BanSym0 t :: Bool) sBaz :: forall (t :: Bool). Sing t -> Sing (Apply BazSym0 t :: Bool) sBar :: forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) sBan (sX :: Sing x) = (applySing ((applySing ((singFun2 @($!@#@$)) (%$!))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @NotSym0) sNot))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @NotSym0) sNot))) ((singFun1 @NotSym0) sNot))))) sX sBaz (sX :: Sing x) = (applySing ((applySing ((singFun2 @($!@#@$)) (%$!))) ((singFun1 @NotSym0) sNot))) sX sBar (sX :: Sing x) = (applySing ((applySing ((singFun2 @($@#@$)) (%$))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @NotSym0) sNot))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((singFun1 @NotSym0) sNot))) ((singFun1 @NotSym0) sNot))))) sX sFoo (sX :: Sing x) = (applySing ((applySing ((singFun2 @($@#@$)) (%$))) ((singFun1 @NotSym0) sNot))) sX instance SingI (BanSym0 :: (~>) Bool Bool) where sing = (singFun1 @BanSym0) sBan instance SingI (BazSym0 :: (~>) Bool Bool) where sing = (singFun1 @BazSym0) sBaz instance SingI (BarSym0 :: (~>) Bool Bool) where sing = (singFun1 @BarSym0) sBar instance SingI (FooSym0 :: (~>) Bool Bool) where sing = (singFun1 @FooSym0) sFoo singletons-2.5.1/tests/compile-and-dump/Singletons/T29.hs0000755000000000000000000000130207346545000021430 0ustar0000000000000000module Singletons.T29 where import Data.Singletons.TH import Data.Singletons.Prelude $(singletons [d| foo :: Bool -> Bool foo x = not $ x -- test that $ works with function composition bar :: Bool -> Bool bar x = not . not . not $ x baz :: Bool -> Bool baz x = not $! x -- test that $! works with function composition ban :: Bool -> Bool ban x = not . not . not $! x |]) foo1a :: Proxy (Foo True) foo1a = Proxy foo1b :: Proxy False foo1b = foo1b bar1a :: Proxy (Bar True) bar1a = Proxy bar1b :: Proxy False bar1b = bar1b baz1a :: Proxy (Baz True) baz1a = Proxy baz1b :: Proxy False baz1b = baz1b ban1a :: Proxy (Ban True) ban1a = Proxy ban1b :: Proxy False ban1b = ban1b singletons-2.5.1/tests/compile-and-dump/Singletons/T297.ghc86.template0000755000000000000000000000416207346545000023645 0ustar0000000000000000Singletons/T297.hs:(0,0)-(0,0): Splicing declarations singletons [d| f MyProxy = let x = let z :: MyProxy a z = MyProxy in z in x data MyProxy (a :: Type) = MyProxy |] ======> data MyProxy (a :: Type) = MyProxy f MyProxy = let x = let z :: MyProxy a z = MyProxy in z in x type MyProxySym0 = MyProxy type Let0123456789876543210ZSym0 = Let0123456789876543210Z type family Let0123456789876543210Z :: MyProxy a where Let0123456789876543210Z = MyProxySym0 type Let0123456789876543210XSym0 = Let0123456789876543210X type family Let0123456789876543210X where Let0123456789876543210X = Let0123456789876543210ZSym0 type FSym1 a0123456789876543210 = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 a0123456789876543210 where FSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 type family F a where F MyProxy = Let0123456789876543210XSym0 sF :: forall arg. Sing arg -> Sing (Apply FSym0 arg) sF SMyProxy = let sX :: Sing Let0123456789876543210XSym0 sX = let sZ :: forall a. Sing (Let0123456789876543210ZSym0 :: MyProxy a) sZ = SMyProxy in sZ in sX instance SingI FSym0 where sing = (singFun1 @FSym0) sF data instance Sing :: MyProxy a -> Type where SMyProxy :: Sing MyProxy type SMyProxy = (Sing :: MyProxy a -> Type) instance SingKind a => SingKind (MyProxy a) where type Demote (MyProxy a) = MyProxy (Demote a) fromSing SMyProxy = MyProxy toSing MyProxy = SomeSing SMyProxy instance SingI MyProxy where sing = SMyProxy singletons-2.5.1/tests/compile-and-dump/Singletons/T297.hs0000755000000000000000000000041507346545000021523 0ustar0000000000000000module T297 where import Data.Kind import Data.Singletons.TH $(singletons [d| data MyProxy (a :: Type) = MyProxy f MyProxy = let x = let z :: MyProxy a -- When singled, this `a` should be explicitly quantified z = MyProxy in z in x |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T312.ghc86.template0000755000000000000000000004142407346545000023633 0ustar0000000000000000Singletons/T312.hs:(0,0)-(0,0): Splicing declarations singletons [d| class Foo a where bar :: a -> b -> b bar _ x = x baz :: forall b. a -> b -> b baz = h where h :: forall c. c -> b -> b h _ x = x |] ======> class Foo a where bar :: a -> b -> b baz :: forall b. a -> b -> b bar _ x = x baz = h where h :: forall c. c -> b -> b h _ x = x type BarSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = Bar arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (BarSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) BarSym1KindInference) ()) data BarSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where BarSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (BarSym1 arg0123456789876543210) arg) (BarSym2 arg0123456789876543210 arg) => BarSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (BarSym1 arg0123456789876543210) arg0123456789876543210 = Bar arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where BarSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 arg0123456789876543210 type instance Apply BarSym0 arg0123456789876543210 = BarSym1 arg0123456789876543210 type BazSym2 (arg0123456789876543210 :: a0123456789876543210) (arg0123456789876543210 :: b0123456789876543210) = Baz arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings (BazSym1 arg0123456789876543210) where suppressUnusedWarnings = snd (((,) BazSym1KindInference) ()) data BazSym1 (arg0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where BazSym1KindInference :: forall arg0123456789876543210 arg0123456789876543210 arg. SameKind (Apply (BazSym1 arg0123456789876543210) arg) (BazSym2 arg0123456789876543210 arg) => BazSym1 arg0123456789876543210 arg0123456789876543210 type instance Apply (BazSym1 arg0123456789876543210) arg0123456789876543210 = Baz arg0123456789876543210 arg0123456789876543210 instance SuppressUnusedWarnings BazSym0 where suppressUnusedWarnings = snd (((,) BazSym0KindInference) ()) data BazSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where BazSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) => BazSym0 arg0123456789876543210 type instance Apply BazSym0 arg0123456789876543210 = BazSym1 arg0123456789876543210 type family Bar_0123456789876543210 (a :: a) (a :: b) :: b where Bar_0123456789876543210 _ x = x type Bar_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Bar_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Bar_0123456789876543210Sym1KindInference) ()) data Bar_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Bar_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Bar_0123456789876543210Sym1 a0123456789876543210) arg) (Bar_0123456789876543210Sym2 a0123456789876543210 arg) => Bar_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Bar_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Bar_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Bar_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Bar_0123456789876543210Sym0KindInference) ()) data Bar_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Bar_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Bar_0123456789876543210Sym0 arg) (Bar_0123456789876543210Sym1 arg) => Bar_0123456789876543210Sym0 a0123456789876543210 type instance Apply Bar_0123456789876543210Sym0 a0123456789876543210 = Bar_0123456789876543210Sym1 a0123456789876543210 type Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Let0123456789876543210H a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym3KindInference) ()) data Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 (a0123456789876543210 :: c0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Let0123456789876543210HSym3KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210) arg) (Let0123456789876543210HSym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg) => Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210HSym3 a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210H a0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym2KindInference) ()) data Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 :: forall b0123456789876543210 c0123456789876543210. (~>) c0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Let0123456789876543210HSym2KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 arg. SameKind (Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 type instance Apply (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) a0123456789876543210 = Let0123456789876543210HSym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym1KindInference) ()) data Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Let0123456789876543210HSym1KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) arg) (Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 arg) => Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Let0123456789876543210HSym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Let0123456789876543210HSym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210HSym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210HSym0KindInference) ()) data Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 where Let0123456789876543210HSym0KindInference :: forall a_01234567898765432100123456789876543210 arg. SameKind (Apply Let0123456789876543210HSym0 arg) (Let0123456789876543210HSym1 arg) => Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 type instance Apply Let0123456789876543210HSym0 a_01234567898765432100123456789876543210 = Let0123456789876543210HSym1 a_01234567898765432100123456789876543210 type family Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 (a :: c) (a :: b) :: b where Let0123456789876543210H a_0123456789876543210 a_0123456789876543210 _ x = x type family Baz_0123456789876543210 (a :: a) (a :: b) :: b where Baz_0123456789876543210 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 type Baz_0123456789876543210Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Baz_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Baz_0123456789876543210Sym1KindInference) ()) data Baz_0123456789876543210Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Baz_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Baz_0123456789876543210Sym1 a0123456789876543210) arg) (Baz_0123456789876543210Sym2 a0123456789876543210 arg) => Baz_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Baz_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = Baz_0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Baz_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Baz_0123456789876543210Sym0KindInference) ()) data Baz_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Baz_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Baz_0123456789876543210Sym0 arg) (Baz_0123456789876543210Sym1 arg) => Baz_0123456789876543210Sym0 a0123456789876543210 type instance Apply Baz_0123456789876543210Sym0 a0123456789876543210 = Baz_0123456789876543210Sym1 a0123456789876543210 class PFoo (a :: GHC.Types.Type) where type Bar (arg :: a) (arg :: b) :: b type Baz (arg :: a) (arg :: b) :: b type Bar a a = Apply (Apply Bar_0123456789876543210Sym0 a) a type Baz a a = Apply (Apply Baz_0123456789876543210Sym0 a) a class SFoo a where sBar :: forall b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b) sBaz :: forall b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b) default sBar :: forall b (t :: a) (t :: b). (Apply (Apply BarSym0 t) t :: b) ~ Apply (Apply Bar_0123456789876543210Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply BarSym0 t) t :: b) default sBaz :: forall b (t :: a) (t :: b). (Apply (Apply BazSym0 t) t :: b) ~ Apply (Apply Baz_0123456789876543210Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply BazSym0 t) t :: b) sBar _ (sX :: Sing x) = sX sBaz (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing (let sH :: forall c (t :: c) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply (Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210) t) t :: b) sH _ (sX :: Sing x) = sX in (singFun2 @(Let0123456789876543210HSym2 a_0123456789876543210 a_0123456789876543210)) sH)) sA_0123456789876543210)) sA_0123456789876543210 instance SFoo a => SingI (BarSym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @BarSym0) sBar instance (SFoo a, SingI d) => SingI (BarSym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(BarSym1 (d :: a))) (sBar (sing @d)) instance SFoo a => SingI (BazSym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @BazSym0) sBaz instance (SFoo a, SingI d) => SingI (BazSym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(BazSym1 (d :: a))) (sBaz (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T312.hs0000755000000000000000000000034507346545000021511 0ustar0000000000000000module T312 where import Data.Singletons.TH $(singletons [d| class Foo a where bar :: a -> b -> b bar _ x = x baz :: forall b. a -> b -> b baz = h where h :: forall c. c -> b -> b h _ x = x |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T313.ghc86.template0000755000000000000000000001353607346545000023637 0ustar0000000000000000Singletons/T313.hs:(0,0)-(0,0): Splicing declarations promote [d| type PFoo1 a = Maybe a type family PFoo2 a type family PFoo3 a where PFoo3 a = Maybe a class PC (a :: Type) where type PFoo4 a type PFoo4 a = Maybe a type instance PFoo2 a = Maybe a instance PC a where type PFoo4 a = Maybe a |] ======> type PFoo1 a = Maybe a type family PFoo2 a type instance PFoo2 a = Maybe a type family PFoo3 a where PFoo3 a = Maybe a class PC (a :: Type) where type PFoo4 a type PFoo4 a = Maybe a instance PC a where type PFoo4 a = Maybe a type PFoo1Sym1 a0123456789876543210 = PFoo1 a0123456789876543210 instance SuppressUnusedWarnings PFoo1Sym0 where suppressUnusedWarnings = snd (((,) PFoo1Sym0KindInference) ()) data PFoo1Sym0 a0123456789876543210 where PFoo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PFoo1Sym0 arg) (PFoo1Sym1 arg) => PFoo1Sym0 a0123456789876543210 type instance Apply PFoo1Sym0 a0123456789876543210 = PFoo1 a0123456789876543210 type PFoo3Sym1 a0123456789876543210 = PFoo3 a0123456789876543210 instance SuppressUnusedWarnings PFoo3Sym0 where suppressUnusedWarnings = snd (((,) PFoo3Sym0KindInference) ()) data PFoo3Sym0 a0123456789876543210 where PFoo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PFoo3Sym0 arg) (PFoo3Sym1 arg) => PFoo3Sym0 a0123456789876543210 type instance Apply PFoo3Sym0 a0123456789876543210 = PFoo3 a0123456789876543210 type PFoo2Sym1 (a0123456789876543210 :: Type) = PFoo2 a0123456789876543210 instance SuppressUnusedWarnings PFoo2Sym0 where suppressUnusedWarnings = snd (((,) PFoo2Sym0KindInference) ()) data PFoo2Sym0 :: (~>) Type Type where PFoo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PFoo2Sym0 arg) (PFoo2Sym1 arg) => PFoo2Sym0 a0123456789876543210 type instance Apply PFoo2Sym0 a0123456789876543210 = PFoo2 a0123456789876543210 type PFoo4Sym1 (a0123456789876543210 :: Type) = PFoo4 a0123456789876543210 instance SuppressUnusedWarnings PFoo4Sym0 where suppressUnusedWarnings = snd (((,) PFoo4Sym0KindInference) ()) data PFoo4Sym0 :: (~>) Type Type where PFoo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply PFoo4Sym0 arg) (PFoo4Sym1 arg) => PFoo4Sym0 a0123456789876543210 type instance Apply PFoo4Sym0 a0123456789876543210 = PFoo4 a0123456789876543210 class PPC (a :: Type) instance PPC a Singletons/T313.hs:(0,0)-(0,0): Splicing declarations singletons [d| type SFoo1 a = Maybe a type family SFoo2 a type family SFoo3 a where SFoo3 a = Maybe a class SC (a :: Type) where type SFoo4 a type SFoo4 a = Maybe a type instance SFoo2 a = Maybe a instance SC a where type SFoo4 a = Maybe a |] ======> type SFoo1 a = Maybe a type family SFoo2 a type instance SFoo2 a = Maybe a type family SFoo3 a where SFoo3 a = Maybe a class SC (a :: Type) where type SFoo4 a type SFoo4 a = Maybe a instance SC a where type SFoo4 a = Maybe a type SFoo1Sym1 a0123456789876543210 = SFoo1 a0123456789876543210 instance SuppressUnusedWarnings SFoo1Sym0 where suppressUnusedWarnings = snd (((,) SFoo1Sym0KindInference) ()) data SFoo1Sym0 a0123456789876543210 where SFoo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SFoo1Sym0 arg) (SFoo1Sym1 arg) => SFoo1Sym0 a0123456789876543210 type instance Apply SFoo1Sym0 a0123456789876543210 = SFoo1 a0123456789876543210 type SFoo3Sym1 a0123456789876543210 = SFoo3 a0123456789876543210 instance SuppressUnusedWarnings SFoo3Sym0 where suppressUnusedWarnings = snd (((,) SFoo3Sym0KindInference) ()) data SFoo3Sym0 a0123456789876543210 where SFoo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SFoo3Sym0 arg) (SFoo3Sym1 arg) => SFoo3Sym0 a0123456789876543210 type instance Apply SFoo3Sym0 a0123456789876543210 = SFoo3 a0123456789876543210 type SFoo2Sym1 (a0123456789876543210 :: Type) = SFoo2 a0123456789876543210 instance SuppressUnusedWarnings SFoo2Sym0 where suppressUnusedWarnings = snd (((,) SFoo2Sym0KindInference) ()) data SFoo2Sym0 :: (~>) Type Type where SFoo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SFoo2Sym0 arg) (SFoo2Sym1 arg) => SFoo2Sym0 a0123456789876543210 type instance Apply SFoo2Sym0 a0123456789876543210 = SFoo2 a0123456789876543210 type SFoo4Sym1 (a0123456789876543210 :: Type) = SFoo4 a0123456789876543210 instance SuppressUnusedWarnings SFoo4Sym0 where suppressUnusedWarnings = snd (((,) SFoo4Sym0KindInference) ()) data SFoo4Sym0 :: (~>) Type Type where SFoo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SFoo4Sym0 arg) (SFoo4Sym1 arg) => SFoo4Sym0 a0123456789876543210 type instance Apply SFoo4Sym0 a0123456789876543210 = SFoo4 a0123456789876543210 class PSC (a :: Type) instance PSC a class SSC (a :: Type) instance SSC a singletons-2.5.1/tests/compile-and-dump/Singletons/T313.hs0000755000000000000000000000116107346545000021507 0ustar0000000000000000module T313 where import Data.Kind import Data.Singletons.TH $(promote [d| type PFoo1 a = Maybe a type family PFoo2 a type instance PFoo2 a = Maybe a type family PFoo3 a where PFoo3 a = Maybe a class PC (a :: Type) where type PFoo4 a type PFoo4 a = Maybe a instance PC a where type PFoo4 a = Maybe a |]) $(singletons [d| type SFoo1 a = Maybe a type family SFoo2 a type instance SFoo2 a = Maybe a type family SFoo3 a where SFoo3 a = Maybe a class SC (a :: Type) where type SFoo4 a type SFoo4 a = Maybe a instance SC a where type SFoo4 a = Maybe a |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T316.ghc86.template0000755000000000000000000000700007346545000023627 0ustar0000000000000000Singletons/T316.hs:(0,0)-(0,0): Splicing declarations promoteOnly [d| replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] replaceAllGTypes f types as = zipWith f as types |] ======> type ReplaceAllGTypesSym3 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) (a0123456789876543210 :: [a0123456789876543210]) = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ReplaceAllGTypesSym2KindInference) ()) data ReplaceAllGTypesSym2 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) (a0123456789876543210 :: [Type]) :: (~>) [a0123456789876543210] [a0123456789876543210] where ReplaceAllGTypesSym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) arg) (ReplaceAllGTypesSym3 a0123456789876543210 a0123456789876543210 arg) => ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypes a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ReplaceAllGTypesSym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ReplaceAllGTypesSym1KindInference) ()) data ReplaceAllGTypesSym1 (a0123456789876543210 :: (~>) a0123456789876543210 ((~>) Type a0123456789876543210)) :: (~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210]) where ReplaceAllGTypesSym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ReplaceAllGTypesSym1 a0123456789876543210) arg) (ReplaceAllGTypesSym2 a0123456789876543210 arg) => ReplaceAllGTypesSym1 a0123456789876543210 a0123456789876543210 type instance Apply (ReplaceAllGTypesSym1 a0123456789876543210) a0123456789876543210 = ReplaceAllGTypesSym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ReplaceAllGTypesSym0 where suppressUnusedWarnings = snd (((,) ReplaceAllGTypesSym0KindInference) ()) data ReplaceAllGTypesSym0 :: forall a0123456789876543210. (~>) ((~>) a0123456789876543210 ((~>) Type a0123456789876543210)) ((~>) [Type] ((~>) [a0123456789876543210] [a0123456789876543210])) where ReplaceAllGTypesSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ReplaceAllGTypesSym0 arg) (ReplaceAllGTypesSym1 arg) => ReplaceAllGTypesSym0 a0123456789876543210 type instance Apply ReplaceAllGTypesSym0 a0123456789876543210 = ReplaceAllGTypesSym1 a0123456789876543210 type family ReplaceAllGTypes (a :: (~>) a ((~>) Type a)) (a :: [Type]) (a :: [a]) :: [a] where ReplaceAllGTypes f types as = Apply (Apply (Apply ZipWithSym0 f) as) types singletons-2.5.1/tests/compile-and-dump/Singletons/T316.hs0000755000000000000000000000035407346545000021515 0ustar0000000000000000module T316 where import Data.Kind import Data.Singletons.Prelude import Data.Singletons.TH $(promoteOnly [d| replaceAllGTypes :: (a -> Type -> a) -> [Type] -> [a] -> [a] replaceAllGTypes f types as = zipWith f as types |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T322.ghc86.template0000755000000000000000000000445207346545000023634 0ustar0000000000000000Singletons/T322.hs:(0,0)-(0,0): Splicing declarations singletons [d| infixr 2 ! (!) :: Bool -> Bool -> Bool (!) = (||) |] ======> (!) :: Bool -> Bool -> Bool (!) = (||) infixr 2 ! type (!@#@$$$) (a0123456789876543210 :: Bool) (a0123456789876543210 :: Bool) = (:!) a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ((!@#@$$) a0123456789876543210) where suppressUnusedWarnings = snd (((,) (:!@#@$$###)) ()) data (!@#@$$) (a0123456789876543210 :: Bool) :: (~>) Bool Bool where (:!@#@$$###) :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply ((!@#@$$) a0123456789876543210) arg) ((!@#@$$$) a0123456789876543210 arg) => (!@#@$$) a0123456789876543210 a0123456789876543210 type instance Apply ((!@#@$$) a0123456789876543210) a0123456789876543210 = (:!) a0123456789876543210 a0123456789876543210 infixr 2 !@#@$$ instance SuppressUnusedWarnings (!@#@$) where suppressUnusedWarnings = snd (((,) (:!@#@$###)) ()) data (!@#@$) :: (~>) Bool ((~>) Bool Bool) where (:!@#@$###) :: forall a0123456789876543210 arg. SameKind (Apply (!@#@$) arg) ((!@#@$$) arg) => (!@#@$) a0123456789876543210 type instance Apply (!@#@$) a0123456789876543210 = (!@#@$$) a0123456789876543210 infixr 2 !@#@$ type family (:!) (a :: Bool) (a :: Bool) :: Bool where (:!) a_0123456789876543210 a_0123456789876543210 = Apply (Apply (||@#@$) a_0123456789876543210) a_0123456789876543210 infixr 2 :! infixr 2 %! (%!) :: forall (t :: Bool) (t :: Bool). Sing t -> Sing t -> Sing (Apply (Apply (!@#@$) t) t :: Bool) (%!) (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @(||@#@$)) (%||))) sA_0123456789876543210)) sA_0123456789876543210 instance SingI ((!@#@$) :: (~>) Bool ((~>) Bool Bool)) where sing = (singFun2 @(!@#@$)) (%!) instance SingI d => SingI ((!@#@$$) (d :: Bool) :: (~>) Bool Bool) where sing = (singFun1 @((!@#@$$) (d :: Bool))) ((%!) (sing @d)) singletons-2.5.1/tests/compile-and-dump/Singletons/T322.hs0000755000000000000000000000031607346545000021510 0ustar0000000000000000module T322 where import Data.Singletons.Prelude import Data.Singletons.TH $(singletons [d| (!) :: Bool -> Bool -> Bool (!) = (||) infixr 2 ! |]) f1 :: (False && True :! True) :~: True f1 = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/T323.ghc86.template0000755000000000000000000000000007346545000023616 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/T323.hs0000755000000000000000000000022307346545000021506 0ustar0000000000000000module T323 where import Data.Singletons.Prelude import Data.Type.Equality test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h test = Refl singletons-2.5.1/tests/compile-and-dump/Singletons/T33.ghc86.template0000755000000000000000000000250307346545000023546 0ustar0000000000000000Singletons/T33.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: (Bool, Bool) -> () foo ~(_, _) = () |] ======> foo :: (Bool, Bool) -> () foo ~(_, _) = () type FooSym1 (a0123456789876543210 :: (Bool, Bool)) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) (Bool, Bool) () where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Foo (a :: (Bool, Bool)) :: () where Foo '(_, _) = Tuple0Sym0 sFoo :: forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ()) sFoo (STuple2 _ _) = STuple0 instance SingI (FooSym0 :: (~>) (Bool, Bool) ()) where sing = (singFun1 @FooSym0) sFoo Singletons/T33.hs:0:0: warning: Lazy pattern converted into regular pattern in promotion | 6 | $(singletons [d| | ^^^^^^^^^^^^^^... Singletons/T33.hs:0:0: warning: Lazy pattern converted into regular pattern during singleton generation. | 6 | $(singletons [d| | ^^^^^^^^^^^^^^... singletons-2.5.1/tests/compile-and-dump/Singletons/T33.hs0000755000000000000000000000023507346545000021427 0ustar0000000000000000module Singletons.T33 where import Data.Singletons.TH import Data.Singletons.Prelude $(singletons [d| foo :: (Bool, Bool) -> () foo ~(_, _) = () |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T332.ghc86.template0000755000000000000000000000412007346545000023625 0ustar0000000000000000Singletons/T332.hs:(0,0)-(0,0): Splicing declarations promote [d| f :: Foo -> () f MkFoo {} = () data Foo = MkFoo |] ======> data Foo = MkFoo f :: Foo -> () f MkFoo {} = () type FSym1 (a0123456789876543210 :: Foo) = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = snd (((,) FSym0KindInference) ()) data FSym0 :: (~>) Foo () where FSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 type family F (a :: Foo) :: () where F MkFoo = Tuple0Sym0 type MkFooSym0 = MkFoo Singletons/T332.hs:(0,0)-(0,0): Splicing declarations singletons [d| b :: Bar -> () b MkBar {} = () data Bar = MkBar |] ======> data Bar = MkBar b :: Bar -> () b MkBar {} = () type MkBarSym0 = MkBar type BSym1 (a0123456789876543210 :: Bar) = B a0123456789876543210 instance SuppressUnusedWarnings BSym0 where suppressUnusedWarnings = snd (((,) BSym0KindInference) ()) data BSym0 :: (~>) Bar () where BSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BSym0 arg) (BSym1 arg) => BSym0 a0123456789876543210 type instance Apply BSym0 a0123456789876543210 = B a0123456789876543210 type family B (a :: Bar) :: () where B MkBar = Tuple0Sym0 sB :: forall (t :: Bar). Sing t -> Sing (Apply BSym0 t :: ()) sB SMkBar = STuple0 instance SingI (BSym0 :: (~>) Bar ()) where sing = (singFun1 @BSym0) sB data instance Sing :: Bar -> GHC.Types.Type where SMkBar :: Sing MkBar type SBar = (Sing :: Bar -> GHC.Types.Type) instance SingKind Bar where type Demote Bar = Bar fromSing SMkBar = MkBar toSing MkBar = SomeSing SMkBar instance SingI MkBar where sing = SMkBar singletons-2.5.1/tests/compile-and-dump/Singletons/T332.hs0000755000000000000000000000030607346545000021510 0ustar0000000000000000module T332 where import Data.Singletons.TH $(promote [d| data Foo = MkFoo f :: Foo -> () f MkFoo{} = () |]) $(singletons [d| data Bar = MkBar b :: Bar -> () b MkBar{} = () |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T342.ghc86.template0000755000000000000000000000147607346545000023641 0ustar0000000000000000Singletons/T342.hs:(0,0)-(0,0): Splicing declarations do synName <- newName "MyId" a <- newName "a" let syn = TySynD synName [PlainTV a] (VarT a) defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName] pure $ syn : defuns ======> type MyId a = a type MyIdSym1 a0123456789876543210 = MyId a0123456789876543210 instance SuppressUnusedWarnings MyIdSym0 where suppressUnusedWarnings = snd (((,) MyIdSym0KindInference) ()) data MyIdSym0 a0123456789876543210 where MyIdSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply MyIdSym0 arg) (MyIdSym1 arg) => MyIdSym0 a0123456789876543210 type instance Apply MyIdSym0 a0123456789876543210 = MyId a0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Singletons/T342.hs0000755000000000000000000000051007346545000021506 0ustar0000000000000000module T342 where import Data.Singletons.TH import Language.Haskell.TH import Language.Haskell.TH.Desugar $(do synName <- newName "MyId" a <- newName "a" let syn = TySynD synName [PlainTV a] (VarT a) defuns <- withLocalDeclarations [syn] $ genDefunSymbols [synName] pure $ syn:defuns) singletons-2.5.1/tests/compile-and-dump/Singletons/T353.ghc86.template0000755000000000000000000002401107346545000023631 0ustar0000000000000000Singletons/T353.hs:(0,0)-(0,0): Splicing declarations singletons [d| type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where Symmetry a y _ = y :~: a |] ======> type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (:~:) (a :: Proxy (t :: k)) (y :: Proxy (t :: k))) :: Type where Symmetry a y _ = (:~:) y a type SymmetrySym3 (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210) (e0123456789876543210 :: (:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) = Symmetry a0123456789876543210 y0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings (SymmetrySym2 y0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SymmetrySym2KindInference) ()) data SymmetrySym2 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: (~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type where SymmetrySym2KindInference :: forall a0123456789876543210 y0123456789876543210 e0123456789876543210 arg. SameKind (Apply (SymmetrySym2 a0123456789876543210 y0123456789876543210) arg) (SymmetrySym3 a0123456789876543210 y0123456789876543210 arg) => SymmetrySym2 a0123456789876543210 y0123456789876543210 e0123456789876543210 type instance Apply (SymmetrySym2 y0123456789876543210 a0123456789876543210) e0123456789876543210 = Symmetry y0123456789876543210 a0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings (SymmetrySym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) SymmetrySym1KindInference) ()) data SymmetrySym1 (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) :: forall (y0123456789876543210 :: Proxy t0123456789876543210). (~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type) where SymmetrySym1KindInference :: forall a0123456789876543210 y0123456789876543210 arg. SameKind (Apply (SymmetrySym1 a0123456789876543210) arg) (SymmetrySym2 a0123456789876543210 arg) => SymmetrySym1 a0123456789876543210 y0123456789876543210 type instance Apply (SymmetrySym1 a0123456789876543210) y0123456789876543210 = SymmetrySym2 a0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings SymmetrySym0 where suppressUnusedWarnings = snd (((,) SymmetrySym0KindInference) ()) data SymmetrySym0 :: forall k0123456789876543210 (t0123456789876543210 :: k0123456789876543210) (a0123456789876543210 :: Proxy t0123456789876543210) (y0123456789876543210 :: Proxy t0123456789876543210). (~>) (Proxy t0123456789876543210) ((~>) (Proxy t0123456789876543210) ((~>) ((:~:) (a0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210)) (y0123456789876543210 :: Proxy (t0123456789876543210 :: k0123456789876543210))) Type)) where SymmetrySym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply SymmetrySym0 arg) (SymmetrySym1 arg) => SymmetrySym0 a0123456789876543210 type instance Apply SymmetrySym0 a0123456789876543210 = SymmetrySym1 a0123456789876543210 Singletons/T353.hs:0:0:: Splicing declarations genDefunSymbols [''Prod] ======> type MkProdSym2 (t0123456789876543210 :: f0123456789876543210 p0123456789876543210) (t0123456789876543210 :: g0123456789876543210 p0123456789876543210) = 'MkProd t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkProdSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkProdSym1KindInference) ()) data MkProdSym1 (t0123456789876543210 :: (f0123456789876543210 :: k0123456789876543210 -> Type) (p0123456789876543210 :: k0123456789876543210)) :: forall (g0123456789876543210 :: k0123456789876543210 -> Type). (~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 -> Type) (g0123456789876543210 :: k0123456789876543210 -> Type) (p0123456789876543210 :: k0123456789876543210)) where MkProdSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkProdSym1 t0123456789876543210) arg) (MkProdSym2 t0123456789876543210 arg) => MkProdSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkProdSym1 t0123456789876543210) t0123456789876543210 = 'MkProd t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkProdSym0 where suppressUnusedWarnings = snd (((,) MkProdSym0KindInference) ()) data MkProdSym0 :: forall k0123456789876543210 (f0123456789876543210 :: k0123456789876543210 -> Type) (g0123456789876543210 :: k0123456789876543210 -> Type) (p0123456789876543210 :: k0123456789876543210). (~>) (f0123456789876543210 p0123456789876543210) ((~>) (g0123456789876543210 p0123456789876543210) (Prod (f0123456789876543210 :: k0123456789876543210 -> Type) (g0123456789876543210 :: k0123456789876543210 -> Type) (p0123456789876543210 :: k0123456789876543210))) where MkProdSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkProdSym0 arg) (MkProdSym1 arg) => MkProdSym0 t0123456789876543210 type instance Apply MkProdSym0 t0123456789876543210 = MkProdSym1 t0123456789876543210 Singletons/T353.hs:0:0:: Splicing declarations genDefunSymbols [''Foo] ======> type MkFooSym2 (t0123456789876543210 :: Proxy a0123456789876543210) (t0123456789876543210 :: Proxy b0123456789876543210) = 'MkFoo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (MkFooSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) MkFooSym1KindInference) ()) data MkFooSym1 (t0123456789876543210 :: Proxy (a0123456789876543210 :: k0123456789876543210)) :: forall k0123456789876543210 (b0123456789876543210 :: k0123456789876543210). (~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210)) where MkFooSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (MkFooSym1 t0123456789876543210) arg) (MkFooSym2 t0123456789876543210 arg) => MkFooSym1 t0123456789876543210 t0123456789876543210 type instance Apply (MkFooSym1 t0123456789876543210) t0123456789876543210 = 'MkFoo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings MkFooSym0 where suppressUnusedWarnings = snd (((,) MkFooSym0KindInference) ()) data MkFooSym0 :: forall k0123456789876543210 (a0123456789876543210 :: k0123456789876543210) k0123456789876543210 (b0123456789876543210 :: k0123456789876543210). (~>) (Proxy a0123456789876543210) ((~>) (Proxy b0123456789876543210) (Foo (a0123456789876543210 :: k0123456789876543210) (b0123456789876543210 :: k0123456789876543210))) where MkFooSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply MkFooSym0 arg) (MkFooSym1 arg) => MkFooSym0 t0123456789876543210 type instance Apply MkFooSym0 t0123456789876543210 = MkFooSym1 t0123456789876543210 singletons-2.5.1/tests/compile-and-dump/Singletons/T353.hs0000755000000000000000000000063507346545000021520 0ustar0000000000000000module T353 where import Data.Kind import Data.Proxy import Data.Singletons.TH $(singletons [d| type family Symmetry (a :: Proxy t) (y :: Proxy t) (e :: (a :: Proxy (t :: k)) :~: (y :: Proxy (t :: k))) :: Type where Symmetry a y _ = y :~: a |]) data Prod f g p = MkProd (f p) (g p) $(genDefunSymbols [''Prod]) data Foo a b = MkFoo (Proxy a) (Proxy b) $(genDefunSymbols [''Foo]) singletons-2.5.1/tests/compile-and-dump/Singletons/T358.ghc86.template0000755000000000000000000001416407346545000023646 0ustar0000000000000000Singletons/T358.hs:(0,0)-(0,0): Splicing declarations singletons [d| class C1 (f :: k -> Type) where method1 :: f a class C2 a where method2a, method2b :: forall b. b -> a instance C1 [] where method1 :: [a] method1 = [] instance C2 [a] where method2a _ = [] method2b :: forall b. b -> [a] method2b _ = [] |] ======> class C1 (f :: k -> Type) where method1 :: f a instance C1 [] where method1 :: [a] method1 = [] class C2 a where method2a :: forall b. b -> a method2b :: forall b. b -> a instance C2 [a] where method2b :: forall b. b -> [a] method2a _ = [] method2b _ = [] type Method1Sym0 = Method1 class PC1 (f :: k -> Type) where type Method1 :: f a type Method2aSym1 (arg0123456789876543210 :: b0123456789876543210) = Method2a arg0123456789876543210 instance SuppressUnusedWarnings Method2aSym0 where suppressUnusedWarnings = snd (((,) Method2aSym0KindInference) ()) data Method2aSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Method2aSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply Method2aSym0 arg) (Method2aSym1 arg) => Method2aSym0 arg0123456789876543210 type instance Apply Method2aSym0 arg0123456789876543210 = Method2a arg0123456789876543210 type Method2bSym1 (arg0123456789876543210 :: b0123456789876543210) = Method2b arg0123456789876543210 instance SuppressUnusedWarnings Method2bSym0 where suppressUnusedWarnings = snd (((,) Method2bSym0KindInference) ()) data Method2bSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Method2bSym0KindInference :: forall arg0123456789876543210 arg. SameKind (Apply Method2bSym0 arg) (Method2bSym1 arg) => Method2bSym0 arg0123456789876543210 type instance Apply Method2bSym0 arg0123456789876543210 = Method2b arg0123456789876543210 class PC2 (a :: Type) where type Method2a (arg :: b) :: a type Method2b (arg :: b) :: a type family Method1_0123456789876543210 :: [a] where Method1_0123456789876543210 = '[] type Method1_0123456789876543210Sym0 = Method1_0123456789876543210 instance PC1 [] where type Method1 = Method1_0123456789876543210Sym0 type family Method2a_0123456789876543210 (a :: b) :: [a] where Method2a_0123456789876543210 _ = '[] type Method2a_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = Method2a_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Method2a_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2a_0123456789876543210Sym0KindInference) ()) data Method2a_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 [a0123456789876543210] where Method2a_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Method2a_0123456789876543210Sym0 arg) (Method2a_0123456789876543210Sym1 arg) => Method2a_0123456789876543210Sym0 a0123456789876543210 type instance Apply Method2a_0123456789876543210Sym0 a0123456789876543210 = Method2a_0123456789876543210 a0123456789876543210 type family Method2b_0123456789876543210 (a :: b) :: [a] where Method2b_0123456789876543210 _ = '[] type Method2b_0123456789876543210Sym1 (a0123456789876543210 :: b0123456789876543210) = Method2b_0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Method2b_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Method2b_0123456789876543210Sym0KindInference) ()) data Method2b_0123456789876543210Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) b0123456789876543210 [a0123456789876543210] where Method2b_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Method2b_0123456789876543210Sym0 arg) (Method2b_0123456789876543210Sym1 arg) => Method2b_0123456789876543210Sym0 a0123456789876543210 type instance Apply Method2b_0123456789876543210Sym0 a0123456789876543210 = Method2b_0123456789876543210 a0123456789876543210 instance PC2 [a] where type Method2a a = Apply Method2a_0123456789876543210Sym0 a type Method2b a = Apply Method2b_0123456789876543210Sym0 a class SC1 (f :: k -> Type) where sMethod1 :: forall a. Sing (Method1Sym0 :: f a) class SC2 a where sMethod2a :: forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: a) sMethod2b :: forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: a) instance SC1 [] where sMethod1 :: forall a. Sing (Method1Sym0 :: [a]) sMethod1 = Data.Singletons.Prelude.Instances.SNil instance SC2 [a] where sMethod2a :: forall b (t :: b). Sing t -> Sing (Apply Method2aSym0 t :: [a]) sMethod2b :: forall b (t :: b). Sing t -> Sing (Apply Method2bSym0 t :: [a]) sMethod2a _ = Data.Singletons.Prelude.Instances.SNil sMethod2b _ = Data.Singletons.Prelude.Instances.SNil instance SC2 a => SingI (Method2aSym0 :: (~>) b a) where sing = (singFun1 @Method2aSym0) sMethod2a instance SC2 a => SingI (Method2bSym0 :: (~>) b a) where sing = (singFun1 @Method2bSym0) sMethod2b singletons-2.5.1/tests/compile-and-dump/Singletons/T358.hs0000755000000000000000000000072007346545000021520 0ustar0000000000000000module T358 where import Data.Kind import Data.Singletons.TH $(singletons [d| class C1 (f :: k -> Type) where method1 :: f a instance C1 [] where method1 :: [a] method1 = [] class C2 a where method2a, method2b :: forall b. b -> a -- Test that variables bound by instance head aren't quantified by the -- generated InstanceSigs instance C2 [a] where method2a _ = [] method2b :: forall b. b -> [a] method2b _ = [] |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T371.ghc86.template0000755000000000000000000003701407346545000023640 0ustar0000000000000000Singletons/T371.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Y (a :: Type) = Y1 | Y2 (X a) deriving Show data X (a :: Type) = X1 | X2 (Y a) deriving Show |] ======> data X (a :: Type) = X1 | X2 (Y a) deriving Show data Y (a :: Type) = Y1 | Y2 (X a) deriving Show type X1Sym0 = X1 type X2Sym1 (t0123456789876543210 :: Y a0123456789876543210) = X2 t0123456789876543210 instance SuppressUnusedWarnings X2Sym0 where suppressUnusedWarnings = snd (((,) X2Sym0KindInference) ()) data X2Sym0 :: forall (a0123456789876543210 :: Type). (~>) (Y a0123456789876543210) (X (a0123456789876543210 :: Type)) where X2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) => X2Sym0 t0123456789876543210 type instance Apply X2Sym0 t0123456789876543210 = X2 t0123456789876543210 type Y1Sym0 = Y1 type Y2Sym1 (t0123456789876543210 :: X a0123456789876543210) = Y2 t0123456789876543210 instance SuppressUnusedWarnings Y2Sym0 where suppressUnusedWarnings = snd (((,) Y2Sym0KindInference) ()) data Y2Sym0 :: forall (a0123456789876543210 :: Type). (~>) (X a0123456789876543210) (Y (a0123456789876543210 :: Type)) where Y2Sym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply Y2Sym0 arg) (Y2Sym1 arg) => Y2Sym0 t0123456789876543210 type instance Apply Y2Sym0 t0123456789876543210 = Y2 t0123456789876543210 type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: X a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ X1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "X1") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (X2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "X2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: X a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. (~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) GHC.Types.Nat ((~>) (X a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (X a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a type family ShowsPrec_0123456789876543210 (a :: GHC.Types.Nat) (a :: Y a) (a :: GHC.Types.Symbol) :: GHC.Types.Symbol where ShowsPrec_0123456789876543210 _ Y1 a_0123456789876543210 = Apply (Apply ShowStringSym0 "Y1") a_0123456789876543210 ShowsPrec_0123456789876543210 p_0123456789876543210 (Y2 arg_0123456789876543210) a_0123456789876543210 = Apply (Apply (Apply ShowParenSym0 (Apply (Apply (>@#@$) p_0123456789876543210) (Data.Singletons.Prelude.Num.FromInteger 10))) (Apply (Apply (.@#@$) (Apply ShowStringSym0 "Y2 ")) (Apply (Apply ShowsPrecSym0 (Data.Singletons.Prelude.Num.FromInteger 11)) arg_0123456789876543210))) a_0123456789876543210 type ShowsPrec_0123456789876543210Sym3 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) (a0123456789876543210 :: GHC.Types.Symbol) = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym2KindInference) ()) data ShowsPrec_0123456789876543210Sym2 (a0123456789876543210 :: GHC.Types.Nat) (a0123456789876543210 :: Y a0123456789876543210) :: (~>) GHC.Types.Symbol GHC.Types.Symbol where ShowsPrec_0123456789876543210Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym3 a0123456789876543210 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym1KindInference) ()) data ShowsPrec_0123456789876543210Sym1 (a0123456789876543210 :: GHC.Types.Nat) :: forall a0123456789876543210. (~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol) where ShowsPrec_0123456789876543210Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) arg) (ShowsPrec_0123456789876543210Sym2 a0123456789876543210 arg) => ShowsPrec_0123456789876543210Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (ShowsPrec_0123456789876543210Sym1 a0123456789876543210) a0123456789876543210 = ShowsPrec_0123456789876543210Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) ShowsPrec_0123456789876543210Sym0KindInference) ()) data ShowsPrec_0123456789876543210Sym0 :: forall a0123456789876543210. (~>) GHC.Types.Nat ((~>) (Y a0123456789876543210) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) where ShowsPrec_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) => ShowsPrec_0123456789876543210Sym0 a0123456789876543210 type instance Apply ShowsPrec_0123456789876543210Sym0 a0123456789876543210 = ShowsPrec_0123456789876543210Sym1 a0123456789876543210 instance PShow (Y a) where type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a data instance Sing :: X a -> Type where SX1 :: Sing X1 SX2 :: forall a (n :: Y a). (Sing (n :: Y a)) -> Sing (X2 n) type SX = (Sing :: X a -> Type) instance SingKind a => SingKind (X a) where type Demote (X a) = X (Demote a) fromSing SX1 = X1 fromSing (SX2 b) = X2 (fromSing b) toSing X1 = SomeSing SX1 toSing (X2 (b :: Demote (Y a))) = case toSing b :: SomeSing (Y a) of { SomeSing c -> SomeSing (SX2 c) } data instance Sing :: Y a -> Type where SY1 :: Sing Y1 SY2 :: forall a (n :: X a). (Sing (n :: X a)) -> Sing (Y2 n) type SY = (Sing :: Y a -> Type) instance SingKind a => SingKind (Y a) where type Demote (Y a) = Y (Demote a) fromSing SY1 = Y1 fromSing (SY2 b) = Y2 (fromSing b) toSing Y1 = SomeSing SY1 toSing (Y2 (b :: Demote (X a))) = case toSing b :: SomeSing (X a) of { SomeSing c -> SomeSing (SY2 c) } instance SShow (Y a) => SShow (X a) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: X a) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (X a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> Type) t1) t2) t3) sShowsPrec _ SX1 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "X1"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SX2 (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "X2 ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))) sA_0123456789876543210 instance SShow (X a) => SShow (Y a) where sShowsPrec :: forall (t1 :: GHC.Types.Nat) (t2 :: Y a) (t3 :: GHC.Types.Symbol). Sing t1 -> Sing t2 -> Sing t3 -> Sing (Apply (Apply (Apply (ShowsPrecSym0 :: TyFun GHC.Types.Nat ((~>) (Y a) ((~>) GHC.Types.Symbol GHC.Types.Symbol)) -> Type) t1) t2) t3) sShowsPrec _ SY1 (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Y1"))) sA_0123456789876543210 sShowsPrec (sP_0123456789876543210 :: Sing p_0123456789876543210) (SY2 (sArg_0123456789876543210 :: Sing arg_0123456789876543210)) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((applySing ((singFun3 @ShowParenSym0) sShowParen)) ((applySing ((applySing ((singFun2 @(>@#@$)) (%>))) sP_0123456789876543210)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 10))))) ((applySing ((applySing ((singFun3 @(.@#@$)) (%.))) ((applySing ((singFun2 @ShowStringSym0) sShowString)) (sing :: Sing "Y2 ")))) ((applySing ((applySing ((singFun3 @ShowsPrecSym0) sShowsPrec)) (Data.Singletons.Prelude.Num.sFromInteger (sing :: Sing 11)))) sArg_0123456789876543210)))) sA_0123456789876543210 deriving instance Data.Singletons.ShowSing.ShowSing (Y a) => Show (Sing (z :: X a)) deriving instance Data.Singletons.ShowSing.ShowSing (X a) => Show (Sing (z :: Y a)) instance SingI X1 where sing = SX1 instance SingI n => SingI (X2 (n :: Y a)) where sing = SX2 sing instance SingI (X2Sym0 :: (~>) (Y a) (X (a :: Type))) where sing = (singFun1 @X2Sym0) SX2 instance SingI (TyCon1 X2 :: (~>) (Y a) (X (a :: Type))) where sing = (singFun1 @(TyCon1 X2)) SX2 instance SingI Y1 where sing = SY1 instance SingI n => SingI (Y2 (n :: X a)) where sing = SY2 sing instance SingI (Y2Sym0 :: (~>) (X a) (Y (a :: Type))) where sing = (singFun1 @Y2Sym0) SY2 instance SingI (TyCon1 Y2 :: (~>) (X a) (Y (a :: Type))) where sing = (singFun1 @(TyCon1 Y2)) SY2 singletons-2.5.1/tests/compile-and-dump/Singletons/T371.hs0000755000000000000000000000055207346545000021516 0ustar0000000000000000module T371 where import Data.Kind import Data.Singletons.TH $(singletons [d| data X (a :: Type) = X1 | X2 (Y a) deriving Show data Y (a :: Type) = Y1 | Y2 (X a) deriving Show |]) main :: IO () main = do print (sing :: Sing ('[] :: [Bool])) print (sing :: Sing '[True]) print (sing :: Sing (X1 :: X Bool)) print (sing :: Sing (Y2 X1 :: Y Bool)) singletons-2.5.1/tests/compile-and-dump/Singletons/T54.ghc86.template0000755000000000000000000000613207346545000023553 0ustar0000000000000000Singletons/T54.hs:(0,0)-(0,0): Splicing declarations singletons [d| g :: Bool -> Bool g e = (case [not] of { [_] -> not }) e |] ======> g :: Bool -> Bool g e = (case [not] of { [_] -> not }) e type Let0123456789876543210Scrutinee_0123456789876543210Sym1 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference) ()) data Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 where Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference :: forall e0123456789876543210 arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) => Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 e0123456789876543210 = Let0123456789876543210Scrutinee_0123456789876543210 e0123456789876543210 type family Let0123456789876543210Scrutinee_0123456789876543210 e where Let0123456789876543210Scrutinee_0123456789876543210 e = Apply (Apply (:@#@$) NotSym0) '[] type family Case_0123456789876543210 e t where Case_0123456789876543210 e '[_] = NotSym0 type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = snd (((,) GSym0KindInference) ()) data GSym0 :: (~>) Bool Bool where GSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 type family G (a :: Bool) :: Bool where G e = Apply (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)) e sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) sG (sE :: Sing e) = (applySing (let sScrutinee_0123456789876543210 :: Sing (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e) sScrutinee_0123456789876543210 = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @NotSym0) sNot))) SNil in (case sScrutinee_0123456789876543210 of { SCons _ SNil -> (singFun1 @NotSym0) sNot }) :: Sing (Case_0123456789876543210 e (Let0123456789876543210Scrutinee_0123456789876543210Sym1 e)))) sE instance SingI (GSym0 :: (~>) Bool Bool) where sing = (singFun1 @GSym0) sG singletons-2.5.1/tests/compile-and-dump/Singletons/T54.hs0000755000000000000000000000034107346545000021430 0ustar0000000000000000{-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.T54 where import Data.Singletons.TH import Data.Singletons.Prelude $(singletons [d| g :: Bool -> Bool g e = (case [not] of [_] -> not) e |]) singletons-2.5.1/tests/compile-and-dump/Singletons/T78.ghc86.template0000755000000000000000000000243607346545000023564 0ustar0000000000000000Singletons/T78.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: MaybeBool -> Bool foo (Just False) = False foo (Just True) = True foo Nothing = False |] ======> foo :: MaybeBool -> Bool foo (Just False) = False foo (Just True) = True foo Nothing = False type FooSym1 (a0123456789876543210 :: Maybe Bool) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) (Maybe Bool) Bool where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Foo (a :: Maybe Bool) :: Bool where Foo ( 'Just 'False) = FalseSym0 Foo ( 'Just 'True) = TrueSym0 Foo 'Nothing = FalseSym0 sFoo :: forall (t :: Maybe Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) sFoo (SJust SFalse) = SFalse sFoo (SJust STrue) = STrue sFoo SNothing = SFalse instance SingI (FooSym0 :: (~>) (Maybe Bool) Bool) where sing = (singFun1 @FooSym0) sFoo singletons-2.5.1/tests/compile-and-dump/Singletons/T78.hs0000755000000000000000000000036607346545000021445 0ustar0000000000000000module Singletons.T78 where import Data.Singletons.TH import Data.Singletons.Prelude type MaybeBool = Maybe Bool $(singletons [d| foo :: MaybeBool -> Bool foo (Just False) = False foo (Just True) = True foo Nothing = False |]) singletons-2.5.1/tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template0000755000000000000000000004002007346545000026444 0ustar0000000000000000Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations singletons [d| data Bool = False | True data Foo = Bar Bool Bool |] ======> data Bool = False | True data Foo = Bar Bool Bool type FalseSym0 = False type TrueSym0 = True type BarSym2 (t0123456789876543210 :: Bool) (t0123456789876543210 :: Bool) = Bar t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (BarSym1 t0123456789876543210) where suppressUnusedWarnings = Data.Tuple.snd (((,) BarSym1KindInference) ()) data BarSym1 (t0123456789876543210 :: Bool) :: (~>) Bool Foo where BarSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (BarSym1 t0123456789876543210) arg) (BarSym2 t0123456789876543210 arg) => BarSym1 t0123456789876543210 t0123456789876543210 type instance Apply (BarSym1 t0123456789876543210) t0123456789876543210 = Bar t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bool ((~>) Bool Foo) where BarSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 t0123456789876543210 type instance Apply BarSym0 t0123456789876543210 = BarSym1 t0123456789876543210 data instance Sing :: Bool -> GHC.Types.Type where SFalse :: Sing False STrue :: Sing True type SBool = (Sing :: Bool -> GHC.Types.Type) instance SingKind Bool where type Demote Bool = Bool fromSing SFalse = False fromSing STrue = True toSing False = SomeSing SFalse toSing True = SomeSing STrue data instance Sing :: Foo -> GHC.Types.Type where SBar :: forall (n :: Bool) (n :: Bool). (Sing (n :: Bool)) -> (Sing (n :: Bool)) -> Sing (Bar n n) type SFoo = (Sing :: Foo -> GHC.Types.Type) instance SingKind Foo where type Demote Foo = Foo fromSing (SBar b b) = (Bar (fromSing b)) (fromSing b) toSing (Bar (b :: Demote Bool) (b :: Demote Bool)) = case ((,) (toSing b :: SomeSing Bool)) (toSing b :: SomeSing Bool) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SBar c) c) } instance SingI False where sing = SFalse instance SingI True where sing = STrue instance (SingI n, SingI n) => SingI (Bar (n :: Bool) (n :: Bool)) where sing = (SBar sing) sing instance SingI (BarSym0 :: (~>) Bool ((~>) Bool Foo)) where sing = (singFun2 @BarSym0) SBar instance SingI (TyCon2 Bar :: (~>) Bool ((~>) Bool Foo)) where sing = (singFun2 @(TyCon2 Bar)) SBar instance SingI d => SingI (BarSym1 (d :: Bool) :: (~>) Bool Foo) where sing = (singFun1 @(BarSym1 (d :: Bool))) (SBar (sing @d)) instance SingI d => SingI (TyCon1 (Bar (d :: Bool)) :: (~>) Bool Foo) where sing = (singFun1 @(TyCon1 (Bar (d :: Bool)))) (SBar (sing @d)) Singletons/TopLevelPatterns.hs:(0,0)-(0,0): Splicing declarations singletons [d| otherwise :: Bool otherwise = True id :: a -> a id x = x not :: Bool -> Bool not True = False not False = True false_ = False f, g :: Bool -> Bool [f, g] = [not, id] h, i :: Bool -> Bool (h, i) = (f, g) j, k :: Bool (Bar j k) = Bar True (h False) l, m :: Bool [l, m] = [not True, id False] |] ======> otherwise :: Bool otherwise = True id :: a -> a id x = x not :: Bool -> Bool not True = False not False = True false_ = False f :: Bool -> Bool g :: Bool -> Bool [f, g] = [not, id] h :: Bool -> Bool i :: Bool -> Bool (h, i) = (f, g) j :: Bool k :: Bool Bar j k = (Bar True) (h False) l :: Bool m :: Bool [l, m] = [not True, id False] type family Case_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 a_0123456789876543210 '[y_0123456789876543210, _] = y_0123456789876543210 type family Case_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 a_0123456789876543210 '[_, y_0123456789876543210] = y_0123456789876543210 type family Case_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 a_0123456789876543210 '(y_0123456789876543210, _) = y_0123456789876543210 type family Case_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 a_0123456789876543210 '(_, y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Bar y_0123456789876543210 _) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 ( 'Bar _ y_0123456789876543210) = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[y_0123456789876543210, _] = y_0123456789876543210 type family Case_0123456789876543210 t where Case_0123456789876543210 '[_, y_0123456789876543210] = y_0123456789876543210 type False_Sym0 = False_ type NotSym1 (a0123456789876543210 :: Bool) = Not a0123456789876543210 instance SuppressUnusedWarnings NotSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) NotSym0KindInference) ()) data NotSym0 :: (~>) Bool Bool where NotSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) => NotSym0 a0123456789876543210 type instance Apply NotSym0 a0123456789876543210 = Not a0123456789876543210 type IdSym1 (a0123456789876543210 :: a0123456789876543210) = Id a0123456789876543210 instance SuppressUnusedWarnings IdSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) IdSym0KindInference) ()) data IdSym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where IdSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) => IdSym0 a0123456789876543210 type instance Apply IdSym0 a0123456789876543210 = Id a0123456789876543210 type FSym1 (a0123456789876543210 :: Bool) = F a0123456789876543210 instance SuppressUnusedWarnings FSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) FSym0KindInference) ()) data FSym0 :: (~>) Bool Bool where FSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FSym0 arg) (FSym1 arg) => FSym0 a0123456789876543210 type instance Apply FSym0 a0123456789876543210 = F a0123456789876543210 type GSym1 (a0123456789876543210 :: Bool) = G a0123456789876543210 instance SuppressUnusedWarnings GSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) GSym0KindInference) ()) data GSym0 :: (~>) Bool Bool where GSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply GSym0 arg) (GSym1 arg) => GSym0 a0123456789876543210 type instance Apply GSym0 a0123456789876543210 = G a0123456789876543210 type HSym1 (a0123456789876543210 :: Bool) = H a0123456789876543210 instance SuppressUnusedWarnings HSym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) HSym0KindInference) ()) data HSym0 :: (~>) Bool Bool where HSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply HSym0 arg) (HSym1 arg) => HSym0 a0123456789876543210 type instance Apply HSym0 a0123456789876543210 = H a0123456789876543210 type ISym1 (a0123456789876543210 :: Bool) = I a0123456789876543210 instance SuppressUnusedWarnings ISym0 where suppressUnusedWarnings = Data.Tuple.snd (((,) ISym0KindInference) ()) data ISym0 :: (~>) Bool Bool where ISym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply ISym0 arg) (ISym1 arg) => ISym0 a0123456789876543210 type instance Apply ISym0 a0123456789876543210 = I a0123456789876543210 type JSym0 = J type KSym0 = K type LSym0 = L type MSym0 = M type OtherwiseSym0 = Otherwise type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type X_0123456789876543210Sym0 = X_0123456789876543210 type family False_ where False_ = FalseSym0 type family Not (a :: Bool) :: Bool where Not 'True = FalseSym0 Not 'False = TrueSym0 type family Id (a :: a) :: a where Id x = x type family F (a :: Bool) :: Bool where F a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 type family G (a :: Bool) :: Bool where G a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 type family H (a :: Bool) :: Bool where H a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 type family I (a :: Bool) :: Bool where I a_0123456789876543210 = Apply (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0) a_0123456789876543210 type family J :: Bool where J = Case_0123456789876543210 X_0123456789876543210Sym0 type family K :: Bool where K = Case_0123456789876543210 X_0123456789876543210Sym0 type family L :: Bool where L = Case_0123456789876543210 X_0123456789876543210Sym0 type family M :: Bool where M = Case_0123456789876543210 X_0123456789876543210Sym0 type family Otherwise :: Bool where Otherwise = TrueSym0 type family X_0123456789876543210 where X_0123456789876543210 = Apply (Apply (:@#@$) NotSym0) (Apply (Apply (:@#@$) IdSym0) '[]) type family X_0123456789876543210 where X_0123456789876543210 = Apply (Apply Tuple2Sym0 FSym0) GSym0 type family X_0123456789876543210 where X_0123456789876543210 = Apply (Apply BarSym0 TrueSym0) (Apply HSym0 FalseSym0) type family X_0123456789876543210 where X_0123456789876543210 = Apply (Apply (:@#@$) (Apply NotSym0 TrueSym0)) (Apply (Apply (:@#@$) (Apply IdSym0 FalseSym0)) '[]) sFalse_ :: Sing False_Sym0 sNot :: forall (t :: Bool). Sing t -> Sing (Apply NotSym0 t :: Bool) sId :: forall a (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) sF :: forall (t :: Bool). Sing t -> Sing (Apply FSym0 t :: Bool) sG :: forall (t :: Bool). Sing t -> Sing (Apply GSym0 t :: Bool) sH :: forall (t :: Bool). Sing t -> Sing (Apply HSym0 t :: Bool) sI :: forall (t :: Bool). Sing t -> Sing (Apply ISym0 t :: Bool) sJ :: Sing (JSym0 :: Bool) sK :: Sing (KSym0 :: Bool) sL :: Sing (LSym0 :: Bool) sM :: Sing (MSym0 :: Bool) sOtherwise :: Sing (OtherwiseSym0 :: Bool) sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sX_0123456789876543210 :: Sing X_0123456789876543210Sym0 sFalse_ = SFalse sNot STrue = SFalse sNot SFalse = STrue sId (sX :: Sing x) = sX sF (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((case sX_0123456789876543210 of { SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) (SCons _ SNil) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) sA_0123456789876543210 sG (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((case sX_0123456789876543210 of { SCons _ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) sA_0123456789876543210 sH (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((case sX_0123456789876543210 of { STuple2 (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) sA_0123456789876543210 sI (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((case sX_0123456789876543210 of { STuple2 _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 a_0123456789876543210 X_0123456789876543210Sym0))) sA_0123456789876543210 sJ = (case sX_0123456789876543210 of { SBar (sY_0123456789876543210 :: Sing y_0123456789876543210) _ -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) sK = (case sX_0123456789876543210 of { SBar _ (sY_0123456789876543210 :: Sing y_0123456789876543210) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) sL = (case sX_0123456789876543210 of { SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) (SCons _ SNil) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) sM = (case sX_0123456789876543210 of { SCons _ (SCons (sY_0123456789876543210 :: Sing y_0123456789876543210) SNil) -> sY_0123456789876543210 }) :: Sing (Case_0123456789876543210 X_0123456789876543210Sym0 :: Bool) sOtherwise = STrue sX_0123456789876543210 = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @NotSym0) sNot))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((singFun1 @IdSym0) sId))) SNil) sX_0123456789876543210 = (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) ((singFun1 @FSym0) sF))) ((singFun1 @GSym0) sG) sX_0123456789876543210 = (applySing ((applySing ((singFun2 @BarSym0) SBar)) STrue)) ((applySing ((singFun1 @HSym0) sH)) SFalse) sX_0123456789876543210 = (applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @NotSym0) sNot)) STrue))) ((applySing ((applySing ((singFun2 @(:@#@$)) SCons)) ((applySing ((singFun1 @IdSym0) sId)) SFalse))) SNil) instance SingI (NotSym0 :: (~>) Bool Bool) where sing = (singFun1 @NotSym0) sNot instance SingI (IdSym0 :: (~>) a a) where sing = (singFun1 @IdSym0) sId instance SingI (FSym0 :: (~>) Bool Bool) where sing = (singFun1 @FSym0) sF instance SingI (GSym0 :: (~>) Bool Bool) where sing = (singFun1 @GSym0) sG instance SingI (HSym0 :: (~>) Bool Bool) where sing = (singFun1 @HSym0) sH instance SingI (ISym0 :: (~>) Bool Bool) where sing = (singFun1 @ISym0) sI singletons-2.5.1/tests/compile-and-dump/Singletons/TopLevelPatterns.hs0000755000000000000000000000132107346545000024326 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} module Singletons.TopLevelPatterns where import Data.Singletons import Data.Singletons.Prelude.List import Data.Singletons.SuppressUnusedWarnings import Data.Singletons.TH hiding (STrue, SFalse, TrueSym0, FalseSym0) $(singletons [d| data Bool = False | True data Foo = Bar Bool Bool |]) $(singletons [d| otherwise :: Bool otherwise = True id :: a -> a id x = x not :: Bool -> Bool not True = False not False = True false_ = False f,g :: Bool -> Bool [f,g] = [not, id] h,i :: Bool -> Bool (h,i) = (f, g) j,k :: Bool (Bar j k) = Bar True (h False) l,m :: Bool [l,m] = [not True, id False] |]) singletons-2.5.1/tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template0000755000000000000000000000000007346545000025255 0ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/Singletons/TypeRepTYPE.hs0000755000000000000000000000165707346545000023161 0ustar0000000000000000{-# LANGUAGE MagicHash #-} module TypeRepTYPE where import Data.Kind (Type) import Data.Singletons.Decide import Data.Singletons.Prelude import Data.Singletons.TypeRepTYPE import GHC.Exts (Char#, RuntimeRep(..), TYPE, Word#) import Type.Reflection (Typeable, typeRep) eqTYPETest1 :: (Type == Type) :~: 'True eqTYPETest1 = Refl eqTYPETest2 :: (Type == TYPE 'IntRep) :~: 'False eqTYPETest2 = Refl f :: Sing (a :: Type) -> Maybe a f tr | Proved Refl <- tr %~ sing @Bool = Just True | Proved Refl <- tr %~ sing @Ordering = Just EQ | otherwise = Nothing data MaybeWordRep (a :: TYPE 'WordRep) = NothingWordRep | JustWordRep a g :: Sing (a :: TYPE 'WordRep) -> MaybeWordRep a g tr | Proved Refl <- tr %~ sing @Word# = JustWordRep 42## | Proved Refl <- tr %~ sing @Char# = JustWordRep 'j'# | otherwise = NothingWordRep h :: forall (rep :: RuntimeRep) (a :: TYPE rep). Typeable a => Sing a h = STypeRep (typeRep @a) singletons-2.5.1/tests/compile-and-dump/Singletons/Undef.ghc86.template0000755000000000000000000000421407346545000024237 0ustar0000000000000000Singletons/Undef.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo :: Bool -> Bool foo = undefined bar :: Bool -> Bool bar = error "urk" |] ======> foo :: Bool -> Bool foo = undefined bar :: Bool -> Bool bar = error "urk" type BarSym1 (a0123456789876543210 :: Bool) = Bar a0123456789876543210 instance SuppressUnusedWarnings BarSym0 where suppressUnusedWarnings = snd (((,) BarSym0KindInference) ()) data BarSym0 :: (~>) Bool Bool where BarSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) => BarSym0 a0123456789876543210 type instance Apply BarSym0 a0123456789876543210 = Bar a0123456789876543210 type FooSym1 (a0123456789876543210 :: Bool) = Foo a0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: (~>) Bool Bool where FooSym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 a0123456789876543210 type instance Apply FooSym0 a0123456789876543210 = Foo a0123456789876543210 type family Bar (a :: Bool) :: Bool where Bar a_0123456789876543210 = Apply (Apply ErrorSym0 "urk") a_0123456789876543210 type family Foo (a :: Bool) :: Bool where Foo a_0123456789876543210 = Apply UndefinedSym0 a_0123456789876543210 sBar :: forall (t :: Bool). Sing t -> Sing (Apply BarSym0 t :: Bool) sFoo :: forall (t :: Bool). Sing t -> Sing (Apply FooSym0 t :: Bool) sBar (sA_0123456789876543210 :: Sing a_0123456789876543210) = (sError (sing :: Sing "urk")) sA_0123456789876543210 sFoo (sA_0123456789876543210 :: Sing a_0123456789876543210) = sUndefined sA_0123456789876543210 instance SingI (BarSym0 :: (~>) Bool Bool) where sing = (singFun1 @BarSym0) sBar instance SingI (FooSym0 :: (~>) Bool Bool) where sing = (singFun1 @FooSym0) sFoo singletons-2.5.1/tests/compile-and-dump/Singletons/Undef.hs0000755000000000000000000000027607346545000022124 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} module Singletons.Undef where import Data.Singletons.TH $(singletons [d| foo :: Bool -> Bool foo = undefined bar :: Bool -> Bool bar = error "urk" |]) singletons-2.5.1/tests/compile-and-dump/0000755000000000000000000000000007346545000016372 5ustar0000000000000000singletons-2.5.1/tests/compile-and-dump/buildGoldenFiles.awk0000755000000000000000000000013307346545000022311 0ustar0000000000000000/INSERT/{while((getline line < $2) > 0 ){if(line !~ /INSERT/){print line}}close($2);next}1