packages feed

singletons 2.5.1 → 3.0.4

raw patch · 270 files changed

Files

CHANGES.md view
@@ -1,5 +1,321 @@-Changelog for singletons project-================================+Changelog for the `singletons` project+======================================++3.0.4 [2024.12.11]+------------------+* Define `Sing` instances such that they explicitly match on their types on the+  left-hand sides (e.g., define `type instance Sing @(k1 ~> k2) = SLambda`+  instead of `type instance Sing = SLambda`. Doing so will make `singletons`+  future-proof once+  [GHC#23515](https://gitlab.haskell.org/ghc/ghc/-/issues/23515) is fixed.++3.0.3 [2024.05.12]+------------------+* Allow building with GHC 9.10.++3.0.2 [2022.08.23]+------------------+* Allow building with GHC 9.4.+* When building with GHC 9.4 or later, use the new+  [`withDict`](https://hackage.haskell.org/package/ghc-prim-0.9.0/docs/GHC-Magic-Dict.html#v:withDict)+  primitive to implement `withSingI` instead of `unsafeCoerce`. This change+  should not have any consequences for user-facing code.++3.0.1 [2021.10.30]+------------------+* Add `SingI1` and `SingI2`, higher-order versions of `SingI`, to+  `Data.Singletons`, along with various derived functions:++  * `sing{1,2}`+  * `singByProxy{1,2}` and `singByProxy{1,2}#`+  * `usingSing{1,2}`+  * `withSing{1,2}`+  * `singThat{1,2}`++3.0 [2021.03.12]+----------------+* The `singletons` library has been split into three libraries:++  * The new `singletons` library is now a minimal library that only provides+    `Data.Singletons`, `Data.Singletons.Decide`, `Data.Singletons.Sigma`, and+    `Data.Singletons.ShowSing` (if compiled with GHC 8.6 or later).+    `singletons` now supports building GHCs back to GHC 8.0, as well as GHCJS.+  * The `singletons-th` library defines Template Haskell functionality for+    promoting and singling term-level definitions, but but nothing else. This+    library continues to require the latest stable release of GHC.+  * The `singletons-base` library defines promoted and singled versions of+    definitions from the `base` library, including the `Prelude`. This library+    continues to require the latest stable release of GHC.++  Consult the changelogs for `singletons-th` and `singletons-base` for changes+  specific to those libraries. For more information on this split, see the+  [relevant GitHub discussion](https://github.com/goldfirere/singletons/issues/420).+* The internals of `ShowSing` have been tweaked to make it possible to derive+  `Show` instances for singleton types, e.g.,++  ```hs+  deriving instance ShowSing a => Show (SList (z :: [a]))+  ```++  For the most part, this is a backwards-compatible change, although there+  exists at least one corner case where the new internals of `ShowSing` require+  extra work to play nicely with GHC's constraint solver. For more details,+  refer to the Haddocks for `ShowSing'` in `Data.Singletons.ShowSing`.++2.7+---+* Require GHC 8.10.+* Record selectors are now singled as top-level functions. For instance,+  `$(singletons [d| data T = MkT { unT :: Bool } |])` will now generate this:++  ```hs+  data ST :: T -> Type where+    SMkT :: Sing b -> Sing (MkT b)++  sUnT :: Sing (t :: T) -> Sing (UnT t :: Bool)+  sUnT (SMkT sb) = sb++  ...+  ```++  Instead of this:++  ```hs+  data ST :: T -> Type where+    SMkT :: { sUnT :: Sing b } -> Sing (MkT b)+  ```++  Note that the new type of `sUnT` is more general than the previous type+  (`Sing (MkT b) -> Sing b`).++  There are two primary reasons for this change:++  1. Singling record selectors as top-level functions is consistent with how+     promoting records works (note that `MkT` is also a top-level function). As+  2. Embedding record selectors directly into a singleton data constructor can+     result in surprising behavior. This can range from simple code using a+     record selector not typechecking to the inability to define multiple+     constructors that share the same record name.++  See [this GitHub issue](https://github.com/goldfirere/singletons/issues/364)+  for an extended discussion on the motivation behind this change.+* The Template Haskell machinery now supports fine-grained configuration in+  the way of an `Options` data type, which lives in the new+  `Data.Singletons.TH.Options` module. Besides `Options`, this module also+  contains:+    * `Options`' record selectors. Currently, these include options to toggle+      generating quoted declarations, toggle generating `SingKind` instances,+      and configure how `singletons` generates the names of promoted or singled+      types. In the future, there may be additional options.+    * A `defaultOptions` value.+    * An `mtl`-like `OptionsMonad` class for monads that support carrying+      `Option`s. This includes `Q`, which uses `defaultOptions` if it is the+      top of the monad transformer stack.+    * An `OptionM` monad transformer that turns any `DsMonad` into an+      `OptionsMonad`.+    * A `withOptions` function which allows passing `Options` to TH functions+      (e.g., `promote` or `singletons`). See the `README` for a full example+      of how to use `withOptions`.+  Most TH functions are now polymorphic over `OptionsMonad` instead of+  `DsMonad`.+* `singletons` now does a much better job of preserving the order of type+  variables in type signatures during promotion and singling. See the+  `Support for TypeApplications` section of the `README` for more details.++  When generating type-level declarations in particular (e.g., promoted type+  families or defunctionalization symbols), `singletons` will likely also+  generate standalone kind signatures to preserve type variable order. As a+  result, most `singletons` code that uses Template Haskell will require the+  use of the `StandaloneKindSignatures` extension (and, by extension, the+  `NoCUSKs` extension) to work.+* `singletons` now does a more much thorough job of rejecting higher-rank types+  during promotion or singling, as `singletons` cannot support them.+  (Previously, `singletons` would sometimes accept them, often changing rank-2+  types to rank-1 types incorrectly in the process.)+* Add the `Data.Singletons.Prelude.Proxy` module.+* Remove the promoted versions of `genericTake`, `genericDrop`,+  `genericSplitAt`, `genericIndex`, and `genericReplicate` from+  `Data.Singletons.Prelude.List`. These definitions were subtly wrong since+  (1) they claim to work over any `Integral` type `i`, but in practice would+  only work on `Nat`s, and (2) wouldn't even typecheck if they were singled.+* Export `ApplyTyConAux1`, `ApplyTyConAux2`, as well as the record pattern+  synonyms selector `applySing2`, `applySing3`, etc. from `Data.Singletons`.+  These were unintentionally left out in previous releases.+* Export promoted and singled versions of the `getDown` record selector in+  `Data.Singletons.Prelude.Ord`.+* Fix a slew of bugs related to fixity declarations:+  * Fixity declarations for data types are no longer singled, as fixity+    declarations do not serve any purpose for singled data type constructors,+    which always have exactly one argument.+  * `singletons` now promotes fixity declarations for class names.+    `genPromotions`/`genSingletons` now also handle fixity declarations for+    classes, class methods, data types, and record selectors correctly.+  * `singletons` will no longer erroneously try to single fixity declarations+    for type synonym or type family names.+  * A bug that caused fixity declarations for certain defunctionalization+    symbols not to be generated has been fixed.+  * `promoteOnly` and `singletonsOnly` will now produce fixity declarations+    for values with infix names.++2.6+---+* Require GHC 8.8.+* `Sing` has switched from a data family to a type family. This+  [GitHub issue comment](https://github.com/goldfirere/singletons/issues/318#issuecomment-467067257)+  provides a detailed explanation for the motivation behind this change.++  This has a number of consequences:+  * Names like `SBool`, `SMaybe`, etc. are no longer type synonyms for+    particular instantiations of `Sing` but are instead the names of the+    singleton data types themselves. In other words, previous versions of+    `singletons` would provide this:++    ```haskell+    data instance Sing :: Bool -> Type where+      SFalse :: Sing False+      STrue  :: Sing True+    type SBool = (Sing :: Bool -> Type)+    ```++    Whereas with `Sing`-as-a-type-family, `singletons` now provides this:++    ```haskell+    data SBool :: Bool -> Type where+      SFalse :: SBool False+      STrue  :: SBool True+    type instance Sing @Bool = SBool+    ```+  * The `Sing` instance for `TYPE rep` in `Data.Singletons.TypeRepTYPE` is now+    directly defined as `type instance Sing @(TYPE rep) = TypeRep`, without the+    use of an intermediate newtype as before.+  * Due to limitations in the ways that quantified constraints and type+    families can interact+    (see [this GHC issue](https://gitlab.haskell.org/ghc/ghc/issues/14860)),+    the internals of `ShowSing` has to be tweaked in order to continue to+    work with `Sing`-as-a-type-family. One notable consequence of this is+    that `Show` instances for singleton types can no longer be derived—they+    must be written by hand in order to work around+    [this GHC bug](https://gitlab.haskell.org/ghc/ghc/issues/16365).+    This is unlikely to affect you unless you define 'Show' instances for+    singleton types by hand. For more information, refer to the Haddocks for+    `ShowSing'` in `Data.Singletons.ShowSing`.+  * GHC does not permit type class instances to mention type families, which+    means that it is no longer possible to define instances that mention the+    `Sing` type constructor. For this reason, a `WrappedSing` data type (which+    is a newtype around `Sing`) was introduced so that one can hang instances+    off of it.++    This had one noticeable effect in `singletons`+    itself: there are no longer `TestEquality Sing` or `TestCoercion Sing`+    instances. Instead, `singletons` now generates a separate+    `TestEquality`/`TestCoercion` instance for every data type that singles a+    derived `Eq` instance. In addition, the `Data.Singletons.Decide` module+    now provides top-level `decideEquality`/`decideCoercion` functions which+    provide the behavior of `testEquality`/`testCoercion`, but monomorphized+    to `Sing`. Finally, `TestEquality`/`TestCoercion` instances are provided+    for `WrappedSing`.+* GHC's behavior surrounding kind inference for local definitions has changed+  in 8.8, and certain code that `singletons` generates for local definitions+  may no longer typecheck as a result. While we have taken measures to mitigate+  the issue on `singletons`' end, there still exists code that must be patched+  on the users' end in order to continue compiling. For instance, here is an+  example of code that stopped compiling with the switch to GHC 8.8:++  ```haskell+  replicateM_ :: (Applicative m) => Nat -> m a -> m ()+  replicateM_ cnt0 f =+      loop cnt0+    where+      loop cnt+          | cnt <= 0  = pure ()+          | otherwise = f *> loop (cnt - 1)+  ```++  This produces errors to the effect of:++  ```+  • Could not deduce (SNum k1) arising from a use of ‘sFromInteger’+    from the context: SApplicative m+    ...++  • Could not deduce (SOrd k1) arising from a use of ‘%<=’+    from the context: SApplicative m+    ...+  ```++  The issue is that GHC 8.8 now kind-generalizes `sLoop` (whereas it did not+  previously), explaining why the error message mentions a mysterious kind+  variable `k1` that only appeared after kind generalization. The solution is+  to give `loop` an explicit type signature like so:++  ```diff+  -replicateM_       :: (Applicative m) => Nat -> m a -> m ()+  +replicateM_       :: forall m a. (Applicative m) => Nat -> m a -> m ()+   replicateM_ cnt0 f =+       loop cnt0+     where+  +    loop :: Nat -> m ()+       loop cnt+           | cnt <= 0  = pure ()+           | otherwise = f *> loop (cnt - 1)+  ```++  This general approach should be sufficient to fix any type inference+  regressions that were introduced between GHC 8.6 and 8.8. If this isn't the+  case, please file an issue.+* Due to [GHC Trac #16133](https://ghc.haskell.org/trac/ghc/ticket/16133) being+  fixed, `singletons`-generated code now requires explicitly enabling the+  `TypeApplications` extension. (The generated code was always using+  `TypeApplications` under the hood, but it's only now that GHC is detecting+  it.)+* `Data.Singletons` now defines a family of `SingI` instances for `TyCon1`+  through `TyCon8`:++  ```haskell+  instance (forall a.    SingI a           => SingI (f a),   ...) => SingI (TyCon1 f)+  instance (forall a b. (SingI a, SingI b) => SingI (f a b), ...) => SingI (TyCon2 f)+  ...+  ```++  As a result, `singletons` no longer generates instances for `SingI` instances+  for applications of `TyCon{N}` to particular type constructors, as they have+  been superseded by the instances above.+* Changes to `Data.Singletons.Sigma`:+  * `SSigma`, the singleton type for `Sigma`, is now defined.+  * New functions `fstSigma`, `sndSigma`, `FstSigma`, `SndSigma`, `currySigma`,+    and `uncurrySigma` have been added. A `Show` instance for `Sigma` has also+    been added.+  * `projSigma1` has been redefined to use continuation-passing style to more+    closely resemble its cousin `projSigma2`. The new type signature of+    `projSigma1` is:++    ```hs+    projSigma1 :: (forall (fst :: s). Sing fst -> r) -> Sigma s t -> r+    ```++    The old type signature of `projSigma1` can be found in the `fstSigma`+    function.+  * `Σ` has been redefined such that it is now a partial application of+    `Sigma`, like so:++    ```haskell+    type Σ = Sigma+    ```++    One benefit of this change is that one no longer needs defunctionalization+    symbols in order to partially apply `Σ`. As a result, `ΣSym0`, `ΣSym1`,+    and `ΣSym2` have been removed.+* In line with corresponding changes in `base-4.13`, the `Fail`/`sFail` methods+  of `{P,S}Monad` have been removed in favor of new `{P,S}MonadFail` classes+  introduced in the `Data.Singletons.Prelude.Monad.Fail` module. These classes+  are also re-exported from `Data.Singletons.Prelude`.+* Fix a bug where expressions with explicit signatures involving function types+  would fail to single.+* The infix names `(.)` and `(!)` are no longer mapped to `(:.)` and `(:!)`,+  as GHC 8.8 learned to parse them at the type level.+* The `Enum` instance for `SomeSing` now uses more efficient implementations of+  `enumFromTo` and `enumFromThenTo` that no longer require a `SingKind`+  constraint.  2.5.1 -----
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012, Richard Eisenberg+Copyright (c) 2012-2020, Richard Eisenberg All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,767 +1,24 @@-singletons 2.5.1-================+`singletons`+============  [![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, <rae@cs.brynmawr.edu>, and-with significant contributions by Jan Stolarek, <jan.stolarek@p.lodz.pl>.  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, <ryan.gl.scott@gmail.com>, 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+`singletons` contains the basic types and definitions needed to support+dependently typed programming techniques in Haskell. This library was+originally presented in+[_Dependently Typed Programming with Singletons_](https://richarde.dev/papers/2012/singletons/paper.pdf),+published at the Haskell Symposium, 2012. -  instance C [] where-    method = []-  ```+`singletons` is intended to be a small, foundational library on which other+projects can build. As such, `singletons` has a minimal dependency+footprint and supports GHCs dating back to GHC 8.0. For more information,+consult the `singletons`+[`README`](https://github.com/goldfirere/singletons/blob/master/README.md). -  Adding a type signature for `method` in the `C []` is sufficient-  to work around the issue, though:+You may also be interested in the following related libraries: -  ```haskell-  instance C [] where-    method :: [a]-    method = []-  ```+* The `singletons-th` library defines Template Haskell functionality that+  allows _promotion_ of term-level functions to type-level equivalents and+  _singling_ functions to dependently typed equivalents.+* The `singletons-base` library uses `singletons-th` to define promoted and+  singled functions from the `base` library, including the `Prelude`.
Setup.hs view
@@ -1,138 +1,2 @@-{-# 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' }+main = defaultMain
singletons.cabal view
@@ -1,159 +1,82 @@ name:           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+version:        3.0.4+cabal-version:  1.24+synopsis:       Basic singleton types and definitions homepage:       http://www.github.com/goldfirere/singletons category:       Dependent Types author:         Richard Eisenberg <rae@cs.brynmawr.edu>, Jan Stolarek <jan.stolarek@p.lodz.pl> maintainer:     Ryan Scott <ryan.gl.scott@gmail.com> 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+tested-with:    GHC == 8.0.2+              , GHC == 8.2.2+              , GHC == 8.4.4+              , GHC == 8.6.5+              , GHC == 8.8.4+              , GHC == 8.10.7+              , GHC == 9.0.2+              , GHC == 9.2.7+              , GHC == 9.4.8+              , GHC == 9.6.6+              , GHC == 9.8.2+              , GHC == 9.10.1+              , GHC == 9.12.1+extra-source-files: README.md, CHANGES.md license:        BSD3 license-file:   LICENSE-build-type:     Custom+build-type:     Simple 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.-    (<https://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf>)--    Version 1.0 and onwards works a lot harder to promote functions. See the-    paper published at Haskell Symposium, 2014:-    <https://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf>.+    @singletons@ contains the basic types and definitions needed to support+    dependently typed programming techniques in Haskell. This library was+    originally presented in /Dependently Typed Programming with Singletons/,+    published at the Haskell Symposium, 2012.+    (<https://richarde.dev/papers/2012/singletons/paper.pdf>)+    .+    @singletons@ is intended to be a small, foundational library on which other+    projects can build. As such, @singletons@ has a minimal dependency+    footprint and supports GHCs dating back to GHC 8.0. For more information,+    consult the @singletons@+    @<https://github.com/goldfirere/singletons/blob/master/README.md README>@.+    .+    You may also be interested in the following related libraries:+    .+    * The @singletons-th@ library defines Template Haskell functionality that+      allows /promotion/ of term-level functions to type-level equivalents and+      /singling/ functions to dependently typed equivalents.+    .+    * The @singletons-base@ library uses @singletons-th@ to define promoted and+      singled functions from the @base@ library, including the "Prelude".  source-repository this   type:     git   location: https://github.com/goldfirere/singletons.git-  tag:      v2.5.1+  subdir:   singletons+  tag:      v3.0.2  source-repository head   type:     git   location: https://github.com/goldfirere/singletons.git+  subdir:   singletons   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+  build-depends:      base >= 4.9 && < 4.22   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+  ghc-options:        -Wall  test-suite singletons-test-suite   type:               exitcode-stdio-1.0   hs-source-dirs:     tests-  ghc-options:        -Wall+  ghc-options:        -Wall -threaded   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+  build-depends:      base >= 4.9 && < 4.22,+                      singletons
src/Data/Singletons.hs view
@@ -1,167 +1,1339 @@-{-# 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--- <http://cs.brynmawr.edu/~rae/papers/2012/singletons/paper.pdf>--- and <http://cs.brynmawr.edu/~rae/papers/2014/promotion/promotion.pdf>.----------------------------------------------------------------------------------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+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#else+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif++#if __GLASGOW_HASKELL__ >= 910+{-# LANGUAGE TypeAbstractions #-}+#endif++-----------------------------------------------------------------------------+-- |+-- 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. See also+-- @Prelude.Singletons@ from the @singletons-base@+-- library, which re-exports this module alongside many singled definitions+-- based on the "Prelude".+--+-- You may also want to read+-- the original papers presenting this library, available at+-- <https://richarde.dev/papers/2012/singletons/paper.pdf>+-- and <https://richarde.dev/papers/2014/promotion/promotion.pdf>.+--+----------------------------------------------------------------------------++module Data.Singletons (+  -- * Main singleton definitions++  Sing, SLambda(..), (@@),++  SingI(..),+  SingI1(..), sing1,+  SingI2(..), sing2,+  SingKind(..),++  -- * Working with singletons+  KindOf, SameKind,+  SingInstance(..), SomeSing(..),+  singInstance, pattern Sing, withSingI,+  withSomeSing, pattern FromSing,+  usingSingI1, usingSingI2,+  singByProxy, singByProxy1, singByProxy2,+  demote, demote1, demote2,++  singByProxy#, singByProxy1#, singByProxy2#,+  withSing, withSing1, withSing2,+  singThat, singThat1, singThat2,++  -- ** @WrappedSing@+  WrappedSing(..), SWrappedSing(..), UnwrapSing,+  -- $SingletonsOfSingletons++  -- ** Defunctionalization+  TyFun, type (~>),+  TyCon1, TyCon2, TyCon3, TyCon4, TyCon5, TyCon6, TyCon7, TyCon8,+  Apply, type (@@),+#if __GLASGOW_HASKELL__ >= 806+  TyCon, ApplyTyCon, ApplyTyConAux1, ApplyTyConAux2,+#endif++  -- ** 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, applySing2,+  pattern SLambda3, applySing3,+  pattern SLambda4, applySing4,+  pattern SLambda5, applySing5,+  pattern SLambda6, applySing6,+  pattern SLambda7, applySing7,+  pattern SLambda8, applySing8,++  -- | 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.Kind (Constraint, Type)+import Data.Proxy (Proxy(..))+import GHC.Exts (Proxy#)+import Unsafe.Coerce (unsafeCoerce)++#if MIN_VERSION_base(4,17,0)+import GHC.Exts (withDict)+#endif++-- | Convenient synonym to refer to the kind of a type variable:+-- @type KindOf (a :: k) = k@+#if __GLASGOW_HASKELL__ >= 810+type KindOf :: k -> Type+#endif+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.+#if __GLASGOW_HASKELL__ >= 810+type SameKind :: k -> k -> Constraint+#endif+type SameKind (a :: k) (b :: k) = (() :: Constraint)++----------------------------------------------------------------------+---- Sing & friends --------------------------------------------------+----------------------------------------------------------------------++-- | The singleton kind-indexed type family.+#if __GLASGOW_HASKELL__ >= 810+type Sing :: k -> Type+#endif+#if __GLASGOW_HASKELL__ >= 910+type family Sing @k :: k -> Type+#else+type family Sing :: k -> Type+#endif++{-+Note [The kind of Sing]+~~~~~~~~~~~~~~~~~~~~~~~+It is important to define Sing like this:++  type Sing :: k -> Type+  type family Sing++Or, equivalently,++  type family Sing :: k -> Type++There are other conceivable ways to define Sing, but they all suffer from+various drawbacks:++* type family Sing :: forall k. k -> Type++  Surprisingly, this is /not/ equivalent to `type family Sing :: k -> Type`.+  The difference lies in their arity, i.e., the number of arguments that must+  be supplied in order to apply Sing. The former declaration has arity 0, while+  the latter has arity 1 (this is more obvious if you write the declaration as+  GHCi would display it with -fprint-explicit-kinds enabled:+  `type family Sing @k :: k -> Type`).++  The former declaration having arity 0 is actually what makes it useless. If+  we were to adopt an arity-0 definition of `Sing`, then in order to write+  `type instance Sing = SFoo`, GHC would require that `SFoo` must have the kind+  `forall k. k -> Type`, and moreover, the kind /must/ be polymorphic in `k`.+  This is undesirable, because in practice, every single `Sing` instance in the+  wild must monomorphize `k` (e.g., `SBool` monomorphizes it to `Bool`), so an+  arity-0 `Sing` simply won't work. In contrast, the current arity-1 definition+  of `Sing` /does/ let you monomorphize `k` in type family instances.++* type family Sing (a :: k) = (r :: Type) | r -> a++  Again, this is not equivalent to `type family Sing :: k -> Type`. This+  version of `Sing` has arity 2, since one must supply both `k` and `a` in+  order to apply it. While an arity-2 `Sing` is not suffer from the same+  polymorphism issues as the arity-0 `Sing` in the previous bullet point, it+  does suffer from another issue in that it cannot be partially applied. This+  is because its `a` argument /must/ be supplied, whereas with the arity-1+  `Sing`, it is perfectly admissible to write `Sing` without an explicit `a`+  argument. (Its invisible `k` argument is filled in automatically behind the+  scenes.)++* type family Sing = (r :: k -> Type) | r -> k++  This is the same as `type family Sing :: k -> Type`, but with an injectivity+  annotation. Technically, this definition isn't /wrong/, but the injectivity+  annotation is actually unnecessary. Because the return kind of `Sing` is+  declared to be `k -> Type`, the `Sing` type constructor is automatically+  injective, so `Sing a1 ~ Sing a2` implies `a1 ~~ a2`.++  Another way of phrasing this, using the terminology of Dependent Haskell, is+  that the arrow in `Sing`'s return kind is /matchable/, which implies that+  `Sing` is an injective type constructor as a consequence.+-}++-- | A 'SingI' constraint is essentially an implicitly-passed singleton.+--+-- In contrast to the 'SingKind' class, which is parameterized over data types+-- promoted to the kind level, the 'SingI' class is parameterized over values+-- promoted to the type level. To explain this distinction another way, consider+-- this code:+--+-- @+-- f = fromSing (sing @(T :: K))+-- @+--+-- Here, @f@ uses methods from both 'SingI' and 'SingKind'. However, the shape+-- of each constraint is rather different: using 'sing' requires a @SingI T@+-- constraint, whereas using 'fromSing' requires a @SingKind K@ constraint.+--+-- If you need to satisfy this constraint with an explicit singleton, please+-- see 'withSingI' or the v'Sing' pattern synonym.+#if __GLASGOW_HASKELL__ >= 900+type SingI :: forall {k}. k -> Constraint+#endif+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++-- | A version of the 'SingI' class lifted to unary type constructors.+#if __GLASGOW_HASKELL__ >= 900+type SingI1 :: forall {k1} {k2}. (k1 -> k2) -> Constraint+#endif+class+#if __GLASGOW_HASKELL__ >= 806+  (forall x. SingI x => SingI (f x)) =>+#endif+    SingI1 f where+  -- | Lift an explicit singleton through a unary type constructor.+  -- You will likely need the @ScopedTypeVariables@ extension to use this+  -- method the way you want.+  liftSing :: Sing x -> Sing (f x)++-- | Produce a singleton explicitly using implicit 'SingI1' and 'SingI'+-- constraints. You will likely need the @ScopedTypeVariables@ extension to use+-- this method the way you want.+sing1 :: (SingI1 f, SingI x) => Sing (f x)+sing1 = liftSing sing++-- | A version of the 'SingI' class lifted to binary type constructors.+#if __GLASGOW_HASKELL__ >= 900+type SingI2 :: forall {k1} {k2} {k3}. (k1 -> k2 -> k3) -> Constraint+#endif+class+#if __GLASGOW_HASKELL__ >= 806+  (forall x y. (SingI x, SingI y) => SingI (f x y)) =>+#endif+    SingI2 f where+  -- | Lift explicit singletons through a binary type constructor.+  -- You will likely need the @ScopedTypeVariables@ extension to use this+  -- method the way you want.+  liftSing2 :: Sing x -> Sing y -> Sing (f x y)++-- | Produce a singleton explicitly using implicit 'SingI2' and 'SingI'+-- constraints. You will likely need the @ScopedTypeVariables@ extension to use+-- this method the way you want.+sing2 :: (SingI2 f, SingI x, SingI y) => Sing (f x y)+sing2 = liftSing2 sing sing++-- | 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.+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Sing #-}+#endif+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'+-- @+#if __GLASGOW_HASKELL__ >= 810+type SingKind :: Type -> Constraint+#endif+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'.+#if __GLASGOW_HASKELL__ >= 810+type SomeSing :: Type -> Type+#endif+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)+-- @+#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE FromSing #-}+#endif+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++----------------------------------------------------------------------+---- WrappedSing -----------------------------------------------------+----------------------------------------------------------------------++-- | A newtype around 'Sing'.+--+-- Since 'Sing' is a type family, it cannot be used directly in type class+-- instances. As one example, one cannot write a catch-all+-- @instance 'SDecide' k => 'TestEquality' ('Sing' k)@. On the other hand,+-- 'WrappedSing' is a perfectly ordinary data type, which means that it is+-- quite possible to define an+-- @instance 'SDecide' k => 'TestEquality' ('WrappedSing' k)@.+#if __GLASGOW_HASKELL__ >= 810+type WrappedSing :: k -> Type+#endif+newtype WrappedSing :: forall k. k -> Type where+  WrapSing :: forall k (a :: k). { unwrapSing :: Sing a } -> WrappedSing a++-- | The singleton for 'WrappedSing's. Informally, this is the singleton type+-- for other singletons.+#if __GLASGOW_HASKELL__ >= 810+type SWrappedSing :: forall k (a :: k). WrappedSing a -> Type+#endif+newtype SWrappedSing :: forall k (a :: k). WrappedSing a -> Type where+  SWrapSing :: forall k (a :: k) (ws :: WrappedSing a).+               { sUnwrapSing :: Sing a } -> SWrappedSing ws+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(WrappedSing a) =+#else+type instance Sing =+#endif+  SWrappedSing++#if __GLASGOW_HASKELL__ >= 810+type UnwrapSing :: forall k (a :: k). WrappedSing a -> Sing a+#endif+type family UnwrapSing (ws :: WrappedSing (a :: k)) :: Sing a where+  UnwrapSing ('WrapSing s) = s++instance SingKind (WrappedSing a) where+  type Demote (WrappedSing a) = WrappedSing a+  fromSing (SWrapSing s) = WrapSing s+  toSing (WrapSing s) = SomeSing $ SWrapSing s++instance forall a (s :: Sing a). SingI a => SingI ('WrapSing s) where+  sing = SWrapSing sing++----------------------------------------------------------------------+---- SingInstance ----------------------------------------------------+----------------------------------------------------------------------++-- | A 'SingInstance' wraps up a 'SingI' instance for explicit handling.+#if __GLASGOW_HASKELL__ >= 810+type SingInstance :: k -> Type+#endif+data SingInstance (a :: k) where+  SingInstance :: 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+#if MIN_VERSION_base(4,17,0)+    with_sing_i = withDict @(SingI a) @(Sing a) s+#else+    with_sing_i si = unsafeCoerce (Don'tInstantiate si) s++-- dirty implementation of explicit-to-implicit conversion+#if __GLASGOW_HASKELL__ >= 810+type DI :: k -> Type+#endif+newtype DI a = Don'tInstantiate (SingI a => SingInstance a)+#endif++----------------------------------------------------------------------+---- 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.+#if __GLASGOW_HASKELL__ >= 810+type TyFun :: Type -> Type -> Type+#endif+data TyFun :: Type -> Type -> Type++-- | Something of kind @a '~>' b@ is a defunctionalized type function that is+-- not necessarily generative or injective. Defunctionalized type functions+-- (also called \"defunctionalization symbols\") can be partially applied, even+-- if the original type function cannot be. For more information on how this+-- works, see the "Promotion and partial application" section of the+-- @<https://github.com/goldfirere/singletons/blob/master/README.md README>@.+--+-- The singleton for things of kind @a '~>' b@ is 'SLambda'. 'SLambda' values+-- can be constructed in one of two ways:+--+-- 1. With the @singFun*@ family of combinators (e.g., 'singFun1'). For+--    example, if you have:+--+--    @+--    type Id :: a -> a+--    sId :: Sing a -> Sing (Id a)+--    @+--+--    Then you can construct a value of type @'Sing' \@(a '~>' a)@ (that is,+--    @'SLambda' \@a \@a@ like so:+--+--    @+--    sIdFun :: 'Sing' \@(a '~>' a) IdSym0+--    sIdFun = singFun1 @IdSym0 sId+--    @+--+--    Where @IdSym0 :: a '~>' a@ is the defunctionlized version of @Id@.+--+-- 2. Using the 'SingI' class. For example, @'sing' \@IdSym0@ is another way of+--    defining @sIdFun@ above. The @singletons-th@ library automatically+--    generates 'SingI' instances for defunctionalization symbols such as+--    @IdSym0@.+--+-- Normal type-level arrows @(->)@ can be converted into defunctionalization+-- arrows @('~>')@ by the use of the 'TyCon' family of types. (Refer to the+-- Haddocks for 'TyCon1' to see an example of this in practice.) For this+-- reason, we do not make an effort to define defunctionalization symbols for+-- most type constructors of kind @a -> b@, as they can be used in+-- defunctionalized settings by simply applying @TyCon{N}@ with an appropriate+-- @N@.+--+-- This includes the @(->)@ type constructor itself, which is of kind+-- @'Type' -> 'Type' -> 'Type'@. One can turn it into something of kind+-- @'Type' '~>' 'Type' '~>' 'Type'@ by writing @'TyCon2' (->)@, or something of+-- kind @'Type' -> 'Type' '~>' 'Type'@ by writing @'TyCon1' ((->) t)@+-- (where @t :: 'Type'@).+#if __GLASGOW_HASKELL__ >= 810+type (~>) :: Type -> Type -> Type+#endif+type a ~> b = TyFun a b -> Type+infixr 0 ~>++-- | Type level function application+#if __GLASGOW_HASKELL__ >= 810+type Apply :: (k1 ~> k2) -> k1 -> k2+#endif+type family Apply (f :: k1 ~> k2) (x :: k1) :: k2++-- | An infix synonym for `Apply`+#if __GLASGOW_HASKELL__ >= 810+type (@@) :: (k1 ~> k2) -> k1 -> k2+#endif+type a @@ b = Apply a b+infixl 9 @@++#if __GLASGOW_HASKELL__ >= 806+-- | 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.+--+-- Note that this is only defined on GHC 8.6 or later. Prior to GHC 8.6,+-- 'TyCon1' /et al./ were defined as separate data types.+#if __GLASGOW_HASKELL__ >= 810+type TyCon :: (k1 -> k2) -> unmatchable_fun+#endif+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.++-- | An \"internal\" definition used primary in the 'Apply' instance for+-- 'TyCon'.+--+-- Note that this only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun)+#endif+#if __GLASGOW_HASKELL__ >= 910+type family ApplyTyCon @k1 @k2 @unmatchable_fun :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where+#else+type family ApplyTyCon :: (k1 -> k2) -> (k1 ~> unmatchable_fun) where+#endif+#if __GLASGOW_HASKELL__ >= 808+  ApplyTyCon @k1 @(k2 -> k3) @unmatchable_fun = ApplyTyConAux2+  ApplyTyCon @k1 @k2         @k2              = ApplyTyConAux1+#else+  ApplyTyCon = (ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun))+  ApplyTyCon = (ApplyTyConAux1 :: (k1 -> k2)       -> (k1 ~> k2))+#endif+-- Upon first glance, the definition of ApplyTyCon (as well as the+-- corresponding Apply instance for TyCon) seems a little indirect. One might+-- wonder why these aren't defined like so:+--+--   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+--+-- This also works, but it requires that ApplyTyCon always be applied to a+-- minimum of two arguments. In particular, this rules out a trick that we use+-- elsewhere in the library to write SingI instances for different TyCons,+-- which relies on partial applications of ApplyTyCon:+--+--   instance forall k1 k2 (f :: k1 -> k2).+--            ( forall a. SingI a => SingI (f a)+--            , (ApplyTyCon :: (k1 -> k2) -> (k1 ~> k2)) ~ ApplyTyConAux1+--            ) => SingI (TyCon1 f) where+#if __GLASGOW_HASKELL__ >= 808+type instance Apply @k1 @k3 (TyCon @k1 @k2 @(k1 ~> k3) f) x =+#else+type instance Apply (TyCon f) x =+#endif+  ApplyTyCon f @@ x++-- | An \"internal\" defunctionalization symbol used primarily in the+-- definition of 'ApplyTyCon', as well as the 'SingI' instances for 'TyCon1',+-- 'TyCon2', etc.+--+-- Note that this is only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyConAux1 :: (k1 -> k2) -> (k1 ~> k2)+#endif+data ApplyTyConAux1 :: (k1 -> k2) -> (k1 ~> k2)++-- | An \"internal\" defunctionalization symbol used primarily in the+-- definition of 'ApplyTyCon'.+--+-- Note that this is only defined on GHC 8.6 or later.+#if __GLASGOW_HASKELL__ >= 810+type ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun)+#endif+data ApplyTyConAux2 :: (k1 -> k2 -> k3) -> (k1 ~> unmatchable_fun)++type instance Apply (ApplyTyConAux1 f) x = f x+type instance Apply (ApplyTyConAux2 f) x = TyCon (f x)++#if __GLASGOW_HASKELL__ >= 810+type TyCon1          :: (k1 -> k2) -> (k1 ~> k2)+type TyCon2          :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3)+type TyCon3          :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4)+type TyCon4          :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5)+type TyCon5          :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6)+type TyCon6          :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7)+type TyCon7          :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8)+type TyCon8          :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9)+#endif++-- | 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]+#if __GLASGOW_HASKELL__ >= 910+type TyCon1 @k1 @k2 = (TyCon :: (k1 -> k2) -> (k1 ~> k2))++-- | Similar to 'TyCon1', but for two-parameter type constructors.+type TyCon2 @k1 @k2 @k3 =+              (TyCon :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3))+type TyCon3 @k1 @k2 @k3 @k4 =+              (TyCon :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4))+type TyCon4 @k1 @k2 @k3 @k4 @k5 =+              (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5))+type TyCon5 @k1 @k2 @k3 @k4 @k5 @k6 =+              (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6))+type TyCon6 @k1 @k2 @k3 @k4 @k5 @k6 @k7 =+              (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7))+type TyCon7 @k1 @k2 @k3 @k4 @k5 @k6 @k7 @k8 =+              (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8))+type TyCon8 @k1 @k2 @k3 @k4 @k5 @k6 @k7 @k8 @k9 =+              (TyCon :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+                     -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9))+#else+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))+#endif+#else+-- | 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]+data TyCon1 :: (k1 -> k2) -> (k1 ~> k2)++-- | Similar to 'TyCon1', but for two-parameter type constructors.+data TyCon2 :: (k1 -> k2 -> k3) -> (k1 ~> k2 ~> k3)+data TyCon3 :: (k1 -> k2 -> k3 -> k4) -> (k1 ~> k2 ~> k3 ~> k4)+data TyCon4 :: (k1 -> k2 -> k3 -> k4 -> k5) -> (k1 ~> k2 ~> k3 ~> k4 ~> k5)+data TyCon5 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6)+            -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6)+data TyCon6 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7)+            -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7)+data TyCon7 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8)+            -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8)+data TyCon8 :: (k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> k9)+            -> (k1 ~> k2 ~> k3 ~> k4 ~> k5 ~> k6 ~> k7 ~> k8 ~> k9)++type instance Apply (TyCon1 f) x = f x+type instance Apply (TyCon2 f) x = TyCon1 (f x)+type instance Apply (TyCon3 f) x = TyCon2 (f x)+type instance Apply (TyCon4 f) x = TyCon3 (f x)+type instance Apply (TyCon5 f) x = TyCon4 (f x)+type instance Apply (TyCon6 f) x = TyCon5 (f x)+type instance Apply (TyCon7 f) x = TyCon6 (f x)+type instance Apply (TyCon8 f) x = TyCon7 (f x)+#endif++----------------------------------------------------------------------+---- Defunctionalized Sing instance and utilities --------------------+----------------------------------------------------------------------++-- | The singleton type for functions. Functions have somewhat special+-- treatment in @singletons@ (see the Haddocks for @('~>')@ for more information+-- about this), and as a result, the 'Sing' instance for 'SLambda' is one of the+-- only such instances defined in the @singletons@ library rather than, say,+-- @singletons-base@.+#if __GLASGOW_HASKELL__ >= 810+type SLambda :: (k1 ~> k2) -> Type+#endif+newtype SLambda (f :: k1 ~> k2) =+  SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) }+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(k1 ~> k2) =+#else+type instance Sing =+#endif+  SLambda++-- | An infix synonym for `applySing`+(@@) :: forall k1 k2 (f :: k1 ~> k2) (t :: k1). Sing f -> Sing t -> Sing (f @@ t)+(@@) f = applySing f++-- | 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)++#if __GLASGOW_HASKELL__ >= 810+type SingFunction1 :: (a1 ~> b) -> Type+type SingFunction2 :: (a1 ~> a2 ~> b) -> Type+type SingFunction3 :: (a1 ~> a2 ~> a3 ~> b) -> Type+type SingFunction4 :: (a1 ~> a2 ~> a3 ~> a4 ~> b) -> Type+type SingFunction5 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> b) -> Type+type SingFunction6 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> b) -> Type+type SingFunction7 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> b) -> Type+type SingFunction8 :: (a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> a8 ~> b) -> Type+#endif++type SingFunction1 (f :: a1 ~> b) =+  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 :: a1 ~> a2 ~> b) =+  forall t1 t2. Sing t1 -> Sing t2 -> Sing (f @@ t1 @@ t2)+singFun2 :: forall f. SingFunction2 f -> Sing f+singFun2 f = SLambda (\x -> singFun1 (f x))++type SingFunction3 (f :: a1 ~> a2 ~> a3 ~> b) =+     forall t1 t2 t3.+     Sing t1 -> Sing t2 -> Sing t3+  -> Sing (f @@ t1 @@ t2 @@ t3)+singFun3 :: forall f. SingFunction3 f -> Sing f+singFun3 f = SLambda (\x -> singFun2 (f x))++type SingFunction4 (f :: a1 ~> a2 ~> a3 ~> a4 ~> b) =+     forall t1 t2 t3 t4.+     Sing t1 -> Sing t2 -> Sing t3 -> Sing t4+  -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4)+singFun4 :: forall f. SingFunction4 f -> Sing f+singFun4 f = SLambda (\x -> singFun3 (f x))++type SingFunction5 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> b) =+     forall t1 t2 t3 t4 t5.+     Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5+  -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5)+singFun5 :: forall f. SingFunction5 f -> Sing f+singFun5 f = SLambda (\x -> singFun4 (f x))++type SingFunction6 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> b) =+     forall t1 t2 t3 t4 t5 t6.+     Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6+  -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6)+singFun6 :: forall f. SingFunction6 f -> Sing f+singFun6 f = SLambda (\x -> singFun5 (f x))++type SingFunction7 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> b) =+     forall t1 t2 t3 t4 t5 t6 t7.+     Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6 -> Sing t7+  -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6 @@ t7)+singFun7 :: forall f. SingFunction7 f -> Sing f+singFun7 f = SLambda (\x -> singFun6 (f x))++type SingFunction8 (f :: a1 ~> a2 ~> a3 ~> a4 ~> a5 ~> a6 ~> a7 ~> a8 ~> b) =+     forall t1 t2 t3 t4 t5 t6 t7 t8.+     Sing t1 -> Sing t2 -> Sing t3 -> Sing t4 -> Sing t5 -> Sing t6 -> Sing t7 -> Sing t8+  -> Sing (f @@ t1 @@ t2 @@ t3 @@ t4 @@ t5 @@ t6 @@ t7 @@ t8)+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)++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE SLambda2 #-}+{-# COMPLETE SLambda3 #-}+{-# COMPLETE SLambda4 #-}+{-# COMPLETE SLambda5 #-}+{-# COMPLETE SLambda6 #-}+{-# COMPLETE SLambda7 #-}+{-# COMPLETE SLambda8 #-}+#endif++pattern SLambda2 :: forall f. SingFunction2 f -> Sing f+pattern SLambda2 {applySing2} <- (unSingFun2 -> applySing2)+  where SLambda2 lam2         = singFun2 lam2++pattern SLambda3 :: forall f. SingFunction3 f -> Sing f+pattern SLambda3 {applySing3} <- (unSingFun3 -> applySing3)+  where SLambda3 lam3         = singFun3 lam3++pattern SLambda4 :: forall f. SingFunction4 f -> Sing f+pattern SLambda4 {applySing4} <- (unSingFun4 -> applySing4)+  where SLambda4 lam4         = singFun4 lam4++pattern SLambda5 :: forall f. SingFunction5 f -> Sing f+pattern SLambda5 {applySing5} <- (unSingFun5 -> applySing5)+  where SLambda5 lam5         = singFun5 lam5++pattern SLambda6 :: forall f. SingFunction6 f -> Sing f+pattern SLambda6 {applySing6} <- (unSingFun6 -> applySing6)+  where SLambda6 lam6         = singFun6 lam6++pattern SLambda7 :: forall f. SingFunction7 f -> Sing f+pattern SLambda7 {applySing7} <- (unSingFun7 -> applySing7)+  where SLambda7 lam7         = singFun7 lam7++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'++-- | Convert a group of 'SingI1' and 'SingI' constraints (representing a+-- function to apply and its argument, respectively) into a single 'SingI'+-- constraint representing the application. You will likely need the+-- @ScopedTypeVariables@ extension to use this method the way you want.+usingSingI1 :: forall f x r. (SingI1 f, SingI x) => (SingI (f x) => r) -> r+usingSingI1 k = withSingI (sing1 @f @x) k++-- | Convert a group of 'SingI2' and 'SingI' constraints (representing a+-- function to apply and its arguments, respectively) into a single 'SingI'+-- constraint representing the application. You will likely need the+-- @ScopedTypeVariables@ extension to use this method the way you want.+usingSingI2 :: forall f x y r. (SingI2 f, SingI x, SingI y) => (SingI (f x y) => r) -> r+usingSingI2 k = withSingI (sing2 @f @x @y) k++-- | 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 useful when we need to name a singleton value for a+-- unary type constructor multiple times. Without this function, each use of+-- 'sing1' could potentially refer to a different singleton, and one has to use+-- type signatures (often with @ScopedTypeVariables@) to ensure that they are+-- the same.+withSing1 :: (SingI1 f, SingI x) => (Sing (f x) -> b) -> b+withSing1 f = f sing1++-- | A convenience function useful when we need to name a singleton value for a+-- binary type constructor multiple times. Without this function, each use of+-- 'sing1' could potentially refer to a different singleton, and one has to use+-- type signatures (often with @ScopedTypeVariables@) to ensure that they are+-- the same.+withSing2 :: (SingI2 f, SingI x, SingI y) => (Sing (f x y) -> b) -> b+withSing2 f = f sing2++-- | 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++-- | A convenience function that names a singleton for a unary type constructor+-- 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.+singThat1 :: forall k1 k2 (f :: k1 -> k2) (x :: k1).+             (SingKind k2, SingI1 f, SingI x)+          => (Demote k2 -> Bool) -> Maybe (Sing (f x))+singThat1 p = withSing1 $ \x -> if p (fromSing x) then Just x else Nothing++-- | A convenience function that names a singleton for a binary type constructor+-- 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.+singThat2 :: forall k1 k2 k3 (f :: k1 -> k2 -> k3) (x :: k1) (y :: k2).+             (SingKind k3, SingI2 f, SingI x, SingI y)+          => (Demote k3 -> Bool) -> Maybe (Sing (f x y))+singThat2 p = withSing2 $ \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 for a unary type constructor when a proxy+-- is at hand.+singByProxy1 :: (SingI1 f, SingI x) => proxy (f x) -> Sing (f x)+singByProxy1 _ = sing1++-- | Allows creation of a singleton for a binary type constructor when a proxy+-- is at hand.+singByProxy2 :: (SingI2 f, SingI x, SingI y) => proxy (f x y) -> Sing (f x y)+singByProxy2 _ = sing2++-- | 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 for a unary type constructor when a+-- @proxy#@ is at hand.+singByProxy1# :: (SingI1 f, SingI x) => Proxy# (f x) -> Sing (f x)+singByProxy1# _ = sing1++-- | Allows creation of a singleton for a binary type constructor when a+-- @proxy#@ is at hand.+singByProxy2# :: (SingI2 f, SingI x, SingI y) => Proxy# (f x y) -> Sing (f x y)+singByProxy2# _ = sing2++-- | 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 @(Just EQ)+-- Just EQ+--+-- >>> demote @'(True,EQ)+-- (True,EQ)+demote ::+#if __GLASGOW_HASKELL__ >= 900+  forall {k} (a :: k). (SingKind k, SingI a) => Demote k+#else+  forall a. (SingKind (KindOf a), SingI a) => Demote (KindOf a)+#endif+demote = fromSing (sing @a)++-- | A convenience function that takes a unary type constructor and its+-- argument as input, applies them, and demotes the result to its+-- value-level counterpart as output. This uses 'SingKind', 'SingI1', and+-- 'SingI' behind the scenes, so @'demote1' = 'fromSing' 'sing1'@.+--+-- This function is intended to be used with @TypeApplications@. For example:+--+-- >>> demote1 @Just @EQ+-- Just EQ+--+-- >>> demote1 @('(,) True) @EQ+-- (True,EQ)+demote1 ::+#if __GLASGOW_HASKELL__ >= 900+  forall {k1} {k2} (f :: k1 -> k2) (x :: k1).+  (SingKind k2, SingI1 f, SingI x) =>+  Demote k2+#else+  forall f x.+  (SingKind (KindOf (f x)), SingI1 f, SingI x) =>+  Demote (KindOf (f x))+#endif+demote1 = fromSing (sing1 @f @x)++-- | A convenience function that takes a binary type constructor and its+-- arguments as input, applies them, and demotes the result to its+-- value-level counterpart as output. This uses 'SingKind', 'SingI2', and+-- 'SingI' behind the scenes, so @'demote2' = 'fromSing' 'sing2'@.+--+-- This function is intended to be used with @TypeApplications@. For example:+--+-- >>> demote2 @'(,) @True @EQ+-- (True,EQ)+demote2 ::+#if __GLASGOW_HASKELL__ >= 900+  forall {k1} {k2} {k3} (f :: k1 -> k2 -> k3) (x :: k1) (y :: k2).+  (SingKind k3, SingI2 f, SingI x, SingI y) =>+  Demote k3+#else+  forall f x y.+  (SingKind (KindOf (f x y)), SingI2 f, SingI x, SingI y) =>+  Demote (KindOf (f x y))+#endif+demote2 = fromSing (sing2 @f @x @y)++----------------------------------------------------------------------+---- SingI TyCon{N} instances ----------------------------------------+----------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 806+instance forall k1 kr (f :: k1 -> kr).+         ( forall a. SingI a => SingI (f a)+         ,   (ApplyTyCon :: (k1 -> kr) -> (k1 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon1 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 kr (f :: k1 -> k2 -> kr).+         ( forall a b. (SingI a, SingI b) => SingI (f a b)+         ,   (ApplyTyCon :: (k2 -> kr) -> (k2 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon2 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 kr (f :: k1 -> k2 -> k3 -> kr).+         ( forall a b c. (SingI a, SingI b, SingI c) => SingI (f a b c)+         ,   (ApplyTyCon :: (k3 -> kr) -> (k3 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon3 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 kr (f :: k1 -> k2 -> k3 -> k4 -> kr).+         ( forall a b c d. (SingI a, SingI b, SingI c, SingI d) => SingI (f a b c d)+         ,   (ApplyTyCon :: (k4 -> kr) -> (k4 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon4 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 kr+                (f :: k1 -> k2 -> k3 -> k4 -> k5 -> kr).+         ( forall a b c d e.+              (SingI a, SingI b, SingI c, SingI d, SingI e)+           => SingI (f a b c d e)+         ,   (ApplyTyCon :: (k5 -> kr) -> (k5 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon5 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 kr+                (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> kr).+         ( forall a b c d e f'.+              (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f')+           => SingI (f a b c d e f')+         ,   (ApplyTyCon :: (k6 -> kr) -> (k6 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon6 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 k7 kr+                (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> kr).+         ( forall a b c d e f' g.+              (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f', SingI g)+           => SingI (f a b c d e f' g)+         ,   (ApplyTyCon :: (k7 -> kr) -> (k7 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon7 f) where+  sing = singFun1 (`withSingI` sing)+instance forall k1 k2 k3 k4 k5 k6 k7 k8 kr+                (f :: k1 -> k2 -> k3 -> k4 -> k5 -> k6 -> k7 -> k8 -> kr).+         ( forall a b c d e f' g h.+              (SingI a, SingI b, SingI c, SingI d, SingI e, SingI f', SingI g, SingI h)+           => SingI (f a b c d e f' g h)+         ,   (ApplyTyCon :: (k8 -> kr) -> (k8 ~> kr))+           ~ ApplyTyConAux1+         ) => SingI (TyCon8 f) where+  sing = singFun1 (`withSingI` sing)+#endif++----------------------------------------------------------------------+---- Defunctionalization symbols -------------------------------------+----------------------------------------------------------------------++-- $(genDefunSymbols [''Demote, ''SameKind, ''KindOf, ''(~>), ''Apply, ''(@@)])+-- WrapSing, UnwrapSing, and SingFunction1 et al. are not defunctionalizable+-- at the moment due to GHC#9269++#if __GLASGOW_HASKELL__ >= 810+type DemoteSym0 :: Type ~> Type+type DemoteSym1 :: Type -> Type+#endif++data DemoteSym0 :: Type ~> Type+type DemoteSym1 x = Demote x++type instance Apply DemoteSym0 x = Demote x++-----++#if __GLASGOW_HASKELL__ >= 810+type SameKindSym0 :: forall k. k ~> k ~> Constraint+type SameKindSym1 :: forall k. k -> k ~> Constraint+type SameKindSym2 :: forall k. k -> k -> Constraint+#endif++data SameKindSym0 :: forall k. k ~> k ~> Constraint+data SameKindSym1 :: forall k. k -> k ~> Constraint+type SameKindSym2 (x :: k) (y :: k) = SameKind x y++type instance Apply SameKindSym0 x = SameKindSym1 x+type instance Apply (SameKindSym1 x) y = SameKind x y++-----++#if __GLASGOW_HASKELL__ >= 810+type KindOfSym0 :: forall k. k ~> Type+type KindOfSym1 :: forall k. k -> Type+#endif++data KindOfSym0 :: forall k. k ~> Type+type KindOfSym1 (x :: k) = KindOf x++type instance Apply KindOfSym0 x = KindOf x++-----++infixr 0 ~>@#@$, ~>@#@$$, ~>@#@$$$++#if __GLASGOW_HASKELL__ >= 810+type (~>@#@$)  :: Type ~> Type ~> Type+type (~>@#@$$) :: Type -> Type ~> Type+type (~>@#@$$$) :: Type -> Type -> Type+#endif++data (~>@#@$)  :: Type ~> Type ~> Type+data (~>@#@$$) :: Type -> Type ~> Type+type x ~>@#@$$$ y = x ~> y++type instance Apply (~>@#@$) x = (~>@#@$$) x+type instance Apply ((~>@#@$$) x) y = x ~> y++-----++#if __GLASGOW_HASKELL__ >= 810+type ApplySym0 :: forall a b. (a ~> b) ~> a ~> b+type ApplySym1 :: forall a b. (a ~> b) -> a ~> b+type ApplySym2 :: forall a b. (a ~> b) -> a -> b+#endif++data ApplySym0 :: forall a b. (a ~> b) ~> a ~> b+data ApplySym1 :: forall a b. (a ~> b) -> a ~> b+type ApplySym2 (f :: a ~> b) (x :: a) = Apply f x++type instance Apply ApplySym0 f = ApplySym1 f+type instance Apply (ApplySym1 f) x = Apply f x++-----++infixl 9 @@@#@$, @@@#@$$, @@@#@$$$++#if __GLASGOW_HASKELL__ >= 810+type (@@@#@$)  :: forall a b. (a ~> b) ~> a ~> b+type (@@@#@$$) :: forall a b. (a ~> b) -> a ~> b+type (@@@#@$$$) :: forall a b. (a ~> b) -> a -> b+#endif++data (@@@#@$)  :: forall a b. (a ~> b) ~> a ~> b+data (@@@#@$$) :: forall a b. (a ~> b) -> a ~> b+type (f :: a ~> b) @@@#@$$$ (x :: a) = f @@ x++type instance Apply (@@@#@$) f = (@@@#@$$) f+type instance Apply ((@@@#@$$) f) x = f @@ x++{- $SingletonsOfSingletons++Aside from being a data type to hang instances off of, 'WrappedSing' has+another purpose as a general-purpose mechanism for allowing one to write+code that uses singletons of other singletons. For instance, suppose you+had the following data type:++@+data T :: Type -> Type where+  MkT :: forall a (x :: a). 'Sing' x -> F a -> T a+@++A naïve attempt at defining a singleton for @T@ would look something like+this:++@+data ST :: forall a. T a -> Type where+  SMkT :: forall a (x :: a) (sx :: 'Sing' x) (f :: F a).+          'Sing' sx -> 'Sing' f -> ST (MkT sx f)+@++But there is a problem here: what exactly /is/ @'Sing' sx@? If @x@ were 'True',+for instance, then @sx@ would be 'STrue', but it's not clear what+@'Sing' 'STrue'@ should be. One could define @SSBool@ to be the singleton of+'SBool's, but in order to be thorough, one would have to generate a singleton+for /every/ singleton type out there. Plus, it's not clear when to stop. Should+we also generate @SSSBool@, @SSSSBool@, etc.?++Instead, 'WrappedSing' and its singleton 'SWrappedSing' provide a way to talk+about singletons of other arbitrary singletons without the need to generate a+bazillion instances. For reference, here is the definition of 'SWrappedSing':++@+newtype 'SWrappedSing' :: forall k (a :: k). 'WrappedSing' a -> Type where+  'SWrapSing' :: forall k (a :: k) (ws :: 'WrappedSing' a).+                 { 'sUnwrapSing' :: 'Sing' a } -> 'SWrappedSing' ws+type instance 'Sing' \@('WrappedSing' a) = 'SWrappedSing'+@++'SWrappedSing' is a bit of an unusual singleton in that its field is a+singleton for @'Sing' \@k@, not @'WrappedSing' \@k@. But that's exactly the+point—a singleton of a singleton contains as much type information as the+underlying singleton itself, so we can get away with just @'Sing' \@k@.++As an example of this in action, here is how you would define the singleton+for the earlier @T@ type:++@+data ST :: forall a. T a -> Type where+  SMkT :: forall a (x :: a) (sx :: 'Sing' x) (f :: F a).+          'Sing' ('WrapSing' sx) -> 'Sing' f -> ST (MkT sx f)+@++With this technique, we won't need anything like @SSBool@ in order to+instantiate @x@ with 'True'. Instead, the field of type+@'Sing' ('WrapSing' sx)@ will simply be a newtype around 'SBool'. In general,+you'll need /n/ layers of 'WrapSing' if you wish to single a singleton /n/+times.++Note that this is not the only possible way to define a singleton for @T@.+An alternative approach that does not make use of singletons-of-singletons is+discussed at some length+<https://github.com/goldfirere/singletons/issues/366#issuecomment-489469086 here>.+Due to the technical limitations of this approach, however, we do not use it+in @singletons@ at the moment, instead favoring the+slightly-clunkier-but-more-reliable 'WrappedSing' approach.+-}++{- $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.List.Singletons >>> :set -XTypeApplications >>> >>> :t 'SLambda2'
− src/Data/Singletons/CustomStar.hs
@@ -1,151 +0,0 @@-{-# 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
src/Data/Singletons/Decide.hs view
@@ -1,7 +1,16 @@-{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators,-             TypeFamilies, FlexibleContexts, UndecidableInstances, GADTs #-}+{-# LANGUAGE CPP, RankNTypes, PolyKinds, DataKinds, TypeOperators,+             TypeFamilies, FlexibleContexts, UndecidableInstances,+             GADTs, TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} +#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Singletons.Decide@@ -20,11 +29,12 @@   SDecide(..),    -- * Supporting definitions-  (:~:)(..), Void, Refuted, Decision(..)+  (:~:)(..), Void, Refuted, Decision(..),+  decideEquality, decideCoercion   ) where -import Data.Kind (Type)-import Data.Singletons.Internal+import Data.Kind+import Data.Singletons import Data.Type.Coercion import Data.Type.Equality import Data.Void@@ -36,29 +46,50 @@ -- | 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'+#if __GLASGOW_HASKELL__ >= 810+type Refuted :: Type -> Type+#endif type Refuted a = (a -> Void)  -- | A 'Decision' about a type @a@ is either a proof of existence or a proof that @a@ -- cannot exist.+#if __GLASGOW_HASKELL__ >= 810+type Decision :: Type -> Type+#endif 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.+#if __GLASGOW_HASKELL__ >= 810+type SDecide :: Type -> Constraint+#endif 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+-- | A suitable default implementation for 'testEquality' that leverages+-- 'SDecide'.+decideEquality :: forall k (a :: k) (b :: k). SDecide k+               => Sing a -> Sing b -> Maybe (a :~: b)+decideEquality 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+instance SDecide k => TestEquality (WrappedSing :: k -> Type) where+  testEquality (WrapSing s1) (WrapSing s2) = decideEquality s1 s2++-- | A suitable default implementation for 'testCoercion' that leverages+-- 'SDecide'.+decideCoercion :: forall k (a :: k) (b :: k). SDecide k+               => Sing a -> Sing b -> Maybe (Coercion a b)+decideCoercion a b =+  case a %~ b of+    Proved Refl -> Just Coercion+    Disproved _ -> Nothing++instance SDecide k => TestCoercion (WrappedSing :: k -> Type) where+  testCoercion (WrapSing s1) (WrapSing s2) = decideCoercion s1 s2
− src/Data/Singletons/Deriving/Bounded.hs
@@ -1,59 +0,0 @@--------------------------------------------------------------------------------- |--- 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) ] }
− src/Data/Singletons/Deriving/Enum.hs
@@ -1,55 +0,0 @@--------------------------------------------------------------------------------- |--- 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) ] })
− src/Data/Singletons/Deriving/Foldable.hs
@@ -1,99 +0,0 @@-{-# 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 }
− src/Data/Singletons/Deriving/Functor.hs
@@ -1,95 +0,0 @@-{-# 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 }
− src/Data/Singletons/Deriving/Infer.hs
@@ -1,163 +0,0 @@-{-# 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
− src/Data/Singletons/Deriving/Ord.hs
@@ -1,71 +0,0 @@--------------------------------------------------------------------------------- |--- 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)
− src/Data/Singletons/Deriving/Show.hs
@@ -1,162 +0,0 @@--------------------------------------------------------------------------------- |--- 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
− src/Data/Singletons/Deriving/Traversable.hs
@@ -1,69 +0,0 @@-{-# 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) ] }
− src/Data/Singletons/Deriving/Util.hs
@@ -1,313 +0,0 @@-{-# 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]
− src/Data/Singletons/Internal.hs
@@ -1,430 +0,0 @@-{-# 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)
− src/Data/Singletons/Names.hs
@@ -1,362 +0,0 @@-{- 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.--}
− src/Data/Singletons/Partition.hs
@@ -1,306 +0,0 @@--------------------------------------------------------------------------------- |--- 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.--}
− src/Data/Singletons/Prelude.hs
@@ -1,279 +0,0 @@--------------------------------------------------------------------------------- |--- 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
− src/Data/Singletons/Prelude/Applicative.hs
@@ -1,73 +0,0 @@-{-# 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)-  |])
− src/Data/Singletons/Prelude/Base.hs
@@ -1,115 +0,0 @@-{-# 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 $!
− src/Data/Singletons/Prelude/Bool.hs
@@ -1,108 +0,0 @@-{-# 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
− src/Data/Singletons/Prelude/Const.hs
@@ -1,141 +0,0 @@-{-# 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)-  |])
− src/Data/Singletons/Prelude/Either.hs
@@ -1,112 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Enum.hs
@@ -1,137 +0,0 @@-{-# 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)
− src/Data/Singletons/Prelude/Eq.hs
@@ -1,90 +0,0 @@-{-# 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 %/=)
− src/Data/Singletons/Prelude/Foldable.hs
@@ -1,645 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Function.hs
@@ -1,119 +0,0 @@--------------------------------------------------------------------------------- |--- 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 @(*) &#x2209; {&#x22a5;, 'const' &#x22a5;}@)-  ---  -- -* @((*) \`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 &
− src/Data/Singletons/Prelude/Functor.hs
@@ -1,206 +0,0 @@-{-# 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 <&>
− src/Data/Singletons/Prelude/Identity.hs
@@ -1,114 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Instances.hs
@@ -1,34 +0,0 @@-{- 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-  |])
− src/Data/Singletons/Prelude/IsString.hs
@@ -1,59 +0,0 @@-{-# 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
− src/Data/Singletons/Prelude/List.hs
@@ -1,296 +0,0 @@-{-# 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-         )
− src/Data/Singletons/Prelude/List/Internal.hs
@@ -1,670 +0,0 @@-{-# 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- |])
− src/Data/Singletons/Prelude/List/Internal/Disambiguation.hs
@@ -1,169 +0,0 @@--------------------------------------------------------------------------------- |--- 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
− src/Data/Singletons/Prelude/List/NonEmpty.hs
@@ -1,558 +0,0 @@-{-# 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--  |])
− src/Data/Singletons/Prelude/Maybe.hs
@@ -1,129 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Monad.hs
@@ -1,293 +0,0 @@-{-# 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 <$!>
− src/Data/Singletons/Prelude/Monad/Internal.hs
@@ -1,519 +0,0 @@-{-# 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 []-  |])
− src/Data/Singletons/Prelude/Monad/Zip.hs
@@ -1,106 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Monoid.hs
@@ -1,212 +0,0 @@-{-# 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-  -- <http://en.wikipedia.org/wiki/Monoid>: \"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-  |])
− src/Data/Singletons/Prelude/Num.hs
@@ -1,145 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Ord.hs
@@ -1,115 +0,0 @@-{-# 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)
− src/Data/Singletons/Prelude/Semigroup.hs
@@ -1,307 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Semigroup/Internal.hs
@@ -1,280 +0,0 @@-{-# 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
− src/Data/Singletons/Prelude/Show.hs
@@ -1,194 +0,0 @@-{-# 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 ])
− src/Data/Singletons/Prelude/Traversable.hs
@@ -1,286 +0,0 @@-{-# 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-  |])
− src/Data/Singletons/Prelude/Tuple.hs
@@ -1,72 +0,0 @@-{-# 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)-  |])
− src/Data/Singletons/Prelude/Void.hs
@@ -1,55 +0,0 @@-{-# 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 {}-  |])
− src/Data/Singletons/Promote.hs
@@ -1,840 +0,0 @@-{- 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
− src/Data/Singletons/Promote/Defun.hs
@@ -1,532 +0,0 @@-{- 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.--}
− src/Data/Singletons/Promote/Eq.hs
@@ -1,70 +0,0 @@-{- 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
− src/Data/Singletons/Promote/Monad.hs
@@ -1,188 +0,0 @@-{- 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--}
− src/Data/Singletons/Promote/Type.hs
@@ -1,64 +0,0 @@-{- 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
src/Data/Singletons/ShowSing.hs view
@@ -1,15 +1,24 @@-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Singletons.ShowSing@@ -19,26 +28,30 @@ -- Stability   :  experimental -- Portability :  non-portable ----- Defines the class 'ShowSing' type synonym, which is useful for defining--- 'Show' instances for singleton types.+-- Defines the class 'ShowSing' which is useful for defining 'Show' instances+-- for singleton types. Because 'ShowSing' crucially relies on+-- @QuantifiedConstraints@, it is only defined if this library is built with+-- GHC 8.6 or later. -- ----------------------------------------------------------------------------  module Data.Singletons.ShowSing (+#if __GLASGOW_HASKELL__ >= 806   -- * The 'ShowSing' type-  ShowSing+  ShowSing,++  -- * Internal utilities+  ShowSing'+#endif   ) 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+#if __GLASGOW_HASKELL__ >= 806+import Data.Kind+import Data.Singletons+import Text.Show  -- | 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+-- @singletons-base@ 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@@ -48,37 +61,51 @@ -- an instance with the following shape: -- -- @--- deriving instance ??? => Show (Sing (x :: [k]))+-- instance ??? => 'Show' ('SList' (z :: [k])) where+--   showsPrec p 'SNil' = showString \"SNil\"+--   showsPrec p ('SCons' sx sxs) =+--     showParen (p > 10) $ showString \"SCons \" . showsPrec 11 sx+--                        . showSpace . showsPrec 11 sxs -- @ -- -- 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+-- 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:+-- @(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@.+-- This lets us write something closer to this: -- -- @--- deriving instance (forall a. Show (Sing (a :: k))) => Show (Sing (x :: [k]))+-- instance (forall a. 'Show' ('Sing' (a :: k))) => 'SList' ('Sing' (z :: [k])) where ... -- @ ----- Because that quantified constraint is somewhat lengthy, we provide the--- 'ShowSing' class synonym as a convenient shorthand. Thus, the above instance--- is equivalent to:+-- The 'ShowSing' class is a thin wrapper around+-- @(forall a. 'Show' ('Sing' (a :: k)))@. With 'ShowSing', our final instance+-- declaration becomes this: -- -- @--- deriving instance ShowSing k => Show (Sing (x :: [k]))+-- instance 'ShowSing' k => 'Show' ('SList' (z :: [k])) where ... -- @ ----- When singling a derived 'Show' instance, @singletons@ will also derive+-- In fact, this instance can be derived:+--+-- @+-- deriving instance 'ShowSing' k => 'Show' ('SList' (z :: [k]))+-- @+--+-- (Note that the actual definition of 'ShowSing' is slightly more complicated+-- than what this documentation might suggest. For the full story,+-- refer to the documentation for `ShowSing'`.)+--+-- When singling a derived 'Show' instance, @singletons-th@ will also generate -- a 'Show' instance for the corresponding singleton type using 'ShowSing'.--- In other words, if you give @singletons@ a derived 'Show' instance, then+-- In other words, if you give @singletons-th@ a derived 'Show' instance, then -- you'll receive the following in return: -- -- * A promoted (@PShow@) instance@@ -86,21 +113,129 @@ -- * 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 +-- One might wonder we we simply don't define ShowSing as+-- @type ShowSing k = (forall (z :: k). ShowSing' z)@ instead of going the+-- extra mile to define it as a class.+-- See Note [Define ShowSing as a class, not a type synonym] for an explanation.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing :: Type -> Constraint+#endif+class    (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)+instance (forall (z :: k). ShowSing' z) => ShowSing (k :: Type)++-- | The workhorse that powers 'ShowSing'. The only reason that `ShowSing'`+-- exists is to work around GHC's inability to put type families in the head+-- of a quantified constraint (see+-- <https://gitlab.haskell.org/ghc/ghc/issues/14860 this GHC issue> for more+-- details on this point). In other words, GHC will not let you define+-- 'ShowSing' like so:+--+-- @+-- class (forall (z :: k). 'Show' ('Sing' z)) => 'ShowSing' k+-- @+--+-- By replacing @'Show' ('Sing' z)@ with @ShowSing' z@, we are able to avoid+-- this restriction for the most part.+--+-- The superclass of `ShowSing'` is a bit peculiar:+--+-- @+-- class (forall (sing :: k -> Type). sing ~ 'Sing' => 'Show' (sing z)) => `ShowSing'` (z :: k)+-- @+--+-- One might wonder why this superclass is used instead of this seemingly more+-- direct equivalent:+--+-- @+-- class 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- Actually, these aren't equivalent! The latter's superclass mentions a type+-- family in its head, and this gives GHC's constraint solver trouble when+-- trying to match this superclass against other constraints. (See the+-- discussion beginning at+-- https://gitlab.haskell.org/ghc/ghc/-/issues/16365#note_189057 for more on+-- this point). The former's superclass, on the other hand, does /not/ mention+-- a type family in its head, which allows it to match other constraints more+-- easily. It may sound like a small difference, but it's the only reason that+-- 'ShowSing' is able to work at all without a significant amount of additional+-- workarounds.+--+-- The quantified superclass has one major downside. Although the head of the+-- quantified superclass is more eager to match, which is usually a good thing,+-- it can bite under certain circumstances. Because @'Show' (sing z)@ will+-- match a 'Show' instance for /any/ types @sing :: k -> Type@ and @z :: k@,+-- (where @k@ is a kind variable), it is possible for GHC's constraint solver+-- to get into a situation where multiple instances match @'Show' (sing z)@,+-- and GHC will get confused as a result. Consider this example:+--+-- @+-- -- As in "Data.Singletons"+-- newtype 'WrappedSing' :: forall k. k -> Type where+--   'WrapSing' :: forall k (a :: k). { 'unwrapSing' :: 'Sing' a } -> 'WrappedSing' a+--+-- instance 'ShowSing' k => 'Show' ('WrappedSing' (a :: k)) where+--   'showsPrec' _ s = 'showString' "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}'+-- @+--+-- When typechecking the 'Show' instance for 'WrappedSing', GHC must fill in a+-- default definition @'show' = defaultShow@, where+-- @defaultShow :: 'Show' ('WrappedSing' a) => 'WrappedSing' a -> 'String'@.+-- GHC's constraint solver has two possible ways to satisfy the+-- @'Show' ('WrappedSing' a)@ constraint for @defaultShow@:+--+-- 1. The top-level instance declaration for @'Show' ('WrappedSing' (a :: k))@+--    itself, and+--+-- 2. @'Show' (sing (z :: k))@ from the head of the quantified constraint arising+--    from @'ShowSing' k@.+--+-- In practice, GHC will choose (2), as local quantified constraints shadow+-- global constraints. This confuses GHC greatly, causing it to error out with+-- an error akin to @Couldn't match type Sing with WrappedSing@. See+-- https://gitlab.haskell.org/ghc/ghc/-/issues/17934 for a full diagnosis of+-- the issue.+--+-- The bad news is that because of GHC#17934, we have to manually define 'show'+-- (and 'showList') in the 'Show' instance for 'WrappedSing' in order to avoid+-- confusing GHC's constraint solver. In other words, @deriving 'Show'@ is a+-- no-go for 'WrappedSing'. The good news is that situations like 'WrappedSing'+-- are quite rare in the world of @singletons@—most of the time, 'Show'+-- instances for singleton types do /not/ have the shape+-- @'Show' (sing (z :: k))@, where @k@ is a polymorphic kind variable. Rather,+-- most such instances instantiate @k@ to a specific kind (e.g., @Bool@, or+-- @[a]@), which means that they will not overlap the head of the quantified+-- superclass in `ShowSing'` as observed above.+--+-- Note that we define the single instance for `ShowSing'` without the use of a+-- quantified constraint in the instance context:+--+-- @+-- instance 'Show' ('Sing' z) => `ShowSing'` (z :: k)+-- @+--+-- We /could/ define this instance with a quantified constraint in the instance+-- context, and it would be equally as expressive. But it doesn't provide any+-- additional functionality that the non-quantified version gives, so we opt+-- for the non-quantified version, which is easier to read.+#if __GLASGOW_HASKELL__ >= 810+type ShowSing' :: k -> Constraint+#endif+class    (forall (sing :: k -> Type). sing ~ Sing => Show (sing z))+                       => ShowSing' (z :: k)+instance Show (Sing z) => ShowSing' (z :: 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:+In an ideal world, we would simply define ShowSing like this: -  type ShowSing k = (forall (z :: k). Show (Sing z) :: Constraint)+  type ShowSing k = (forall (z :: k). ShowSing' 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.+In fact, I used to define ShowSing in a manner similar to this in version 2.5+of singletons. However, I realized some time after 2.5's release that the+this encoding 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.@@ -130,18 +265,18 @@ 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))+  deriving instance (forall z. ShowSing' (z :: Y a)) => Show (Sing (z :: X a))+  deriving instance (forall z. ShowSing' (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+#15888), when GHC has a Wanted `ShowSing' (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).+`forall z. ShowSing' (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+`ShowSing' (z1 :: Y Bool)` constraint. GHC chooses the appropriate instance+and emits a Wanted `forall z. ShowSing' (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+`ShowSing' (z2 :: X Bool)` constraint... we repeat the process and find ourselves in an infinite loop that eventually overflows the reduction stack. Eep. @@ -151,7 +286,7 @@ 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'+   off. But determining this would require significantly improving singletons-th'    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@@ -164,31 +299,21 @@ -}  --------------------------------------------------------------- TypeLits instances+-- (S)WrappedSing 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)-      )+-- Note that we cannot derive this Show instance due to+-- https://gitlab.haskell.org/ghc/ghc/-/issues/17934. The Haddocks for+-- ShowSing' contain a lengthier explanation of how GHC#17934 relates to+-- ShowSing.+instance ShowSing k => Show (WrappedSing (a :: k)) where+  showsPrec = showsWrappedSingPrec+  show x = showsWrappedSingPrec 0 x ""+  showList = showListWith (showsWrappedSingPrec 0) ---------------------------------------------------------------- Template Haskell-generated instances-------------------------------------------------------------+showsWrappedSingPrec :: ShowSing k => Int -> WrappedSing (a :: k) -> ShowS+showsWrappedSingPrec p (WrapSing s) = showParen (p >= 11) $+  showString "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}' -$(showSingInstances basicTypes)+deriving instance ShowSing k => Show (SWrappedSing (ws :: WrappedSing (a :: k)))+#endif
src/Data/Singletons/Sigma.hs view
@@ -1,14 +1,30 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#else+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#else+{-# LANGUAGE ImpredicativeTypes #-} -- See Note [Impredicative Σ?]+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Singletons.Sigma@@ -23,40 +39,115 @@ ----------------------------------------------------------------------------  module Data.Singletons.Sigma-    ( Sigma(..), Σ+    ( -- * The 'Sigma' type+      Sigma(..), Σ+    , Sing, SSigma(..), SΣ++      -- * Operations over 'Sigma'+    , fstSigma, FstSigma, sndSigma, SndSigma     , projSigma1, projSigma2     , mapSigma, zipSigma+    , currySigma, uncurrySigma -      -- * Defunctionalization symbols-    , ΣSym0, ΣSym1, ΣSym2+#if __GLASGOW_HASKELL__ >= 806+      -- * Internal utilities+      -- $internalutilities+    , ShowApply,  ShowSingApply+    , ShowApply', ShowSingApply'+#endif     ) where -import Data.Kind (Type)-import Data.Singletons.Internal-import Data.Singletons.Promote+import Data.Kind+import Data.Singletons+#if __GLASGOW_HASKELL__ >= 806+import Data.Singletons.ShowSing+#endif  -- | A dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type Sigma :: forall s -> (s ~> Type) -> Type+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type Σ :: forall s -> (s ~> Type) -> Type+#endif+type Σ = Sigma +{-+Note [Impredicative Σ?]+~~~~~~~~~~~~~~~~~~~~~~~+The following definition alone:++  type Σ = Sigma++will not typecheck without the use of ImpredicativeTypes. There isn't a+fundamental reason that this should be the case, and the only reason that GHC+currently requires this is due to GHC#13408. Thankfully, giving Σ a standalone+kind signature works around GHC#13408, so we only have to enable+ImpredicativeTypes on pre-8.10 versions of GHC.+-}++-- | The singleton type for 'Sigma'.+#if __GLASGOW_HASKELL__ >= 810+type SSigma :: Sigma s t -> Type+#endif+data SSigma :: forall s t. Sigma s t -> Type where+  (:%&:) :: forall s t (fst :: s) (sfst :: Sing fst) (snd :: t @@ fst).+            Sing ('WrapSing sfst) -> Sing snd -> SSigma (sfst ':&: snd :: Sigma s t)+infixr 4 :%&:+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Sigma s t) =+#else+type instance Sing =+#endif+  SSigma++instance forall s t (fst :: s) (a :: Sing fst) (b :: t @@ fst).+       (SingI fst, SingI b)+    => SingI (a ':&: b :: Sigma s t) where+  sing = sing :%&: sing++-- | Unicode shorthand for 'SSigma'.+#if __GLASGOW_HASKELL__ >= 810+type SΣ :: Sigma s t -> Type+#endif+type SΣ = SSigma+ -- | Project the first element out of a dependent pair.-projSigma1 :: forall s t. SingKind s => Sigma s t -> Demote s-projSigma1 (a :&: _) = fromSing a+fstSigma :: forall s t. SingKind s => Sigma s t -> Demote s+fstSigma (a :&: _) = fromSing a +-- | Project the first element out of a dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type FstSigma :: Sigma s t -> s+#endif+type family FstSigma (sig :: Sigma s t) :: s where+  FstSigma ((_ :: Sing fst) ':&: _) = fst+ -- | 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.+sndSigma :: forall s t (sig :: Sigma s t).+            SingKind (t @@ FstSigma sig)+         => SSigma sig -> Demote (t @@ FstSigma sig)+sndSigma (_ :%&: b) = fromSing b++-- | Project the second element out of a dependent pair.+#if __GLASGOW_HASKELL__ >= 810+type SndSigma :: forall s t. forall (sig :: Sigma s t) -> t @@ FstSigma sig+#endif+type family SndSigma (sig :: Sigma s t) :: t @@ FstSigma sig where+  SndSigma (_ ':&: b) = b++-- | Project the first element out of a dependent pair using+-- continuation-passing style.+projSigma1 :: (forall (fst :: s). Sing fst -> r) -> Sigma s t -> r+projSigma1 f (a :&: _) = f a++-- | Project the second element out of a dependent pair using+-- continuation-passing style. projSigma2 :: forall s t r. (forall (fst :: s). t @@ fst -> r) -> Sigma s t -> r projSigma2 f ((_ :: Sing (fst :: s)) :&: b) = f @fst b @@ -72,4 +163,86 @@ zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) =   (f @@ a @@ b) :&: (g @fstA @fstB p q) -$(genDefunSymbols [''Σ])+-- | Convert an uncurried function on 'Sigma' to a curried one.+--+-- Together, 'currySigma' and 'uncurrySigma' witness an isomorphism such that+-- the following identities hold:+--+-- @+-- id1 :: forall a (b :: a ~> Type) (c :: 'Sigma' a b ~> Type).+--        (forall (p :: Sigma a b). 'SSigma' p -> c @@ p)+--     -> (forall (p :: Sigma a b). 'SSigma' p -> c @@ p)+-- id1 f = 'uncurrySigma' @a @b @c ('currySigma' @a @b @c f)+--+-- id2 :: forall a (b :: a ~> Type) (c :: 'Sigma' a b ~> Type).+--        (forall (x :: a) (sx :: Sing x) (y :: b @@ x). Sing ('WrapSing' sx) -> Sing y -> c @@ (sx :&: y))+--     -> (forall (x :: a) (sx :: Sing x) (y :: b @@ x). Sing ('WrapSing' sx) -> Sing y -> c @@ (sx :&: y))+-- id2 f = 'currySigma' @a @b @c ('uncurrySigma' @a @b @c f)+-- @+currySigma :: forall a (b :: a ~> Type) (c :: Sigma a b ~> Type).+              (forall (p :: Sigma a b). SSigma p -> c @@ p)+           -> (forall (x :: a) (sx :: Sing x) (y :: b @@ x).+                 Sing ('WrapSing sx) -> Sing y -> c @@ (sx ':&: y))+currySigma f x y = f (x :%&: y)++-- | Convert a curried function on 'Sigma' to an uncurried one.+--+-- Together, 'currySigma' and 'uncurrySigma' witness an isomorphism.+-- (Refer to the documentation for 'currySigma' for more details.)+uncurrySigma :: forall a (b :: a ~> Type) (c :: Sigma a b ~> Type).+                (forall (x :: a) (sx :: Sing x) (y :: b @@ x).+                   Sing ('WrapSing sx) -> Sing y -> c @@ (sx ':&: y))+             -> (forall (p :: Sigma a b). SSigma p -> c @@ p)+uncurrySigma f (x :%&: y) = f x y++#if __GLASGOW_HASKELL__ >= 806+instance (ShowSing s, ShowApply t) => Show (Sigma s t) where+  showsPrec p ((a :: Sing (fst :: s)) :&: b) = showParen (p >= 5) $+    showsPrec 5 a . showString " :&: " . showsPrec 5 b+      :: ShowApply' t fst => ShowS++instance forall s (t :: s ~> Type) (sig :: Sigma s t).+         (ShowSing s, ShowSingApply t)+      => Show (SSigma sig) where+  showsPrec p ((sa :: Sing ('WrapSing (sfst :: Sing fst))) :%&: (sb :: Sing snd)) =+    showParen (p >= 5) $+      showsPrec 5 sa . showString " :&: " . showsPrec 5 sb+        :: ShowSingApply' t fst snd => ShowS++------------------------------------------------------------+-- Internal utilities+------------------------------------------------------------++{- $internal-utilities++See the documentation in "Data.Singletons.ShowSing"—in particular, the+Haddocks for 'ShowSing' and `ShowSing'`—for an explanation for why these+classes exist.++Note that these classes are only defined on GHC 8.6 or later.+-}++#if __GLASGOW_HASKELL__ >= 810+type ShowApply :: (a ~> Type) -> Constraint+#endif+class    (forall (x :: a). ShowApply' f x) => ShowApply (f :: a ~> Type)+instance (forall (x :: a). ShowApply' f x) => ShowApply (f :: a ~> Type)++#if __GLASGOW_HASKELL__ >= 810+type ShowApply' :: (a ~> Type) -> a -> Constraint+#endif+class    Show (Apply f x) => ShowApply' (f :: a ~> Type) (x :: a)+instance Show (Apply f x) => ShowApply' (f :: a ~> Type) (x :: a)++#if __GLASGOW_HASKELL__ >= 810+type ShowSingApply :: (a ~> Type) -> Constraint+#endif+class    (forall (x :: a) (z :: Apply f x). ShowSingApply' f x z) => ShowSingApply (f :: a ~> Type)+instance (forall (x :: a) (z :: Apply f x). ShowSingApply' f x z) => ShowSingApply (f :: a ~> Type)++#if __GLASGOW_HASKELL__ >= 810+type ShowSingApply' :: forall a. forall (f :: a ~> Type) (x :: a) -> Apply f x -> Constraint+#endif+class    Show (Sing z) => ShowSingApply' (f :: a ~> Type) (x :: a) (z :: Apply f x)+instance Show (Sing z) => ShowSingApply' (f :: a ~> Type) (x :: a) (z :: Apply f x)+#endif
− src/Data/Singletons/Single.hs
@@ -1,874 +0,0 @@-{- 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 <https://github.com/goldfirere/singletons/blob/master/README.md> 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
− src/Data/Singletons/Single/Data.hs
@@ -1,181 +0,0 @@-{- 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'
− src/Data/Singletons/Single/Defun.hs
@@ -1,213 +0,0 @@--------------------------------------------------------------------------------- |--- 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.--}
− src/Data/Singletons/Single/Eq.hs
@@ -1,120 +0,0 @@-{- 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) []
− src/Data/Singletons/Single/Fixity.hs
@@ -1,33 +0,0 @@-module 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)
− src/Data/Singletons/Single/Monad.hs
@@ -1,217 +0,0 @@-{- 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.--}
− src/Data/Singletons/Single/Type.hs
@@ -1,69 +0,0 @@-{- 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
− src/Data/Singletons/SuppressUnusedWarnings.hs
@@ -1,18 +0,0 @@--- 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 :: ()
− src/Data/Singletons/Syntax.hs
@@ -1,237 +0,0 @@-{- 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.--}
− src/Data/Singletons/TH.hs
@@ -1,192 +0,0 @@-{-# 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 <<cases>> 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 <<cases>> 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)
− src/Data/Singletons/TypeError.hs
@@ -1,188 +0,0 @@-{-# 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 "<type>" -- 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--- @\"\<type\>\"@ 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
− src/Data/Singletons/TypeLits.hs
@@ -1,225 +0,0 @@-{-# 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`
− src/Data/Singletons/TypeLits/Internal.hs
@@ -1,231 +0,0 @@--------------------------------------------------------------------------------- |--- 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 %<=?)
− src/Data/Singletons/TypeRepTYPE.hs
@@ -1,100 +0,0 @@-{-# 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")
− src/Data/Singletons/Util.hs
@@ -1,549 +0,0 @@-{- 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 <<Rep>> 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 == '_'
tests/ByHand.hs view
@@ -14,67 +14,71 @@              FlexibleInstances, FlexibleContexts, UndecidableInstances,              RankNTypes, TypeOperators, MultiParamTypeClasses,              FunctionalDependencies, ScopedTypeVariables,-             LambdaCase, TemplateHaskell, EmptyCase,-             AllowAmbiguousTypes, TypeApplications, EmptyCase- #-}+             LambdaCase, EmptyCase,+             TypeApplications, EmptyCase, CPP #-} -module ByHand where+#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif -import Data.Kind (Type)-import Prelude hiding (Bool, False, True, Maybe, Just, Nothing, Either, Left, Right, map, zipWith,-                       (&&), (||), (+), (-))-import Unsafe.Coerce+#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+module ByHand where +import Data.Kind import Data.Type.Equality hiding (type (==), apply) import Data.Proxy- import Data.Singletons import Data.Singletons.Decide+import Prelude hiding ((+), (-), map, zipWith)+import Unsafe.Coerce  ----------------------------------- -- Original ADTs ------------------ ----------------------------------- -data Nat :: Type where+#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif+data Nat 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+#if __GLASGOW_HASKELL__ >= 810+type List :: Type -> Type+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type PEq :: Type -> Constraint+#endif class PEq k where   type (==) (a :: k) (b :: k) :: Bool   -- omitting definition of /=  -- Singleton type equality type class+#if __GLASGOW_HASKELL__ >= 810+type SEq :: Type -> Constraint+#endif 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 __GLASGOW_HASKELL__ >= 810+type If :: Bool -> a -> a -> a+#endif+type family If (cond :: Bool) (tru :: a) (fls :: a) :: a where   If True  tru  fls = tru   If False tru  fls = fls @@ -88,14 +92,30 @@  -- Nat -data instance Sing :: Nat -> Type where-  SZero :: Sing Zero-  SSucc :: Sing n -> Sing (Succ n)+#if __GLASGOW_HASKELL__ >= 810+type SNat :: Nat -> Type+#endif+data SNat :: Nat -> Type where+  SZero :: SNat Zero+  SSucc :: SNat n -> SNat (Succ n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Nat =+#else+type instance Sing =+#endif+  SNat +#if _+_GLASGOW_HASKELL__ >= 810+type SuccSym0 :: Nat ~> Nat+#endif data SuccSym0 :: Nat ~> Nat type instance Apply SuccSym0 x = Succ x -type family EqualsNat (a :: Nat) (b :: Nat) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsNat :: Nat -> Nat -> Bool+#endif+type family EqualsNat (a :: Nat) (b :: Nat) :: Bool where   EqualsNat Zero Zero = True   EqualsNat (Succ a) (Succ b) = a == b   EqualsNat (n1 :: Nat) (n2 :: Nat) = False@@ -121,6 +141,8 @@   sing = SZero instance SingI n => SingI (Succ n) where   sing = SSucc sing+instance SingI1 Succ where+  liftSing = SSucc instance SingKind Nat where   type Demote Nat = Nat   fromSing SZero = Zero@@ -130,14 +152,28 @@  -- Bool -data instance Sing :: Bool -> Type where-  SFalse :: Sing False-  STrue :: Sing True+#if __GLASGOW_HASKELL__ >= 810+type SBool :: Bool -> Type+#endif+data SBool :: Bool -> Type where+  SFalse :: SBool False+  STrue :: SBool True+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Bool =+#else+type instance Sing =+#endif+  SBool +{- (&&) :: Bool -> Bool -> Bool False && _ = False True  && x = x+-} +#if __GLASGOW_HASKELL__ >= 810+type (&&) :: Bool -> Bool -> Bool+#endif type family (a :: Bool) && (b :: Bool) :: Bool where   False && _ = False   True  && x = x@@ -161,11 +197,23 @@  -- Maybe -data instance Sing :: Maybe k -> Type where-  SNothing :: Sing Nothing-  SJust :: forall k (a :: k). Sing a -> Sing (Just a)+#if __GLASGOW_HASKELL__ >= 810+type SMaybe :: forall k. Maybe k -> Type+#endif+data SMaybe :: forall k. Maybe k -> Type where+  SNothing :: SMaybe Nothing+  SJust :: forall k (a :: k). Sing a -> SMaybe (Just a)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Maybe k) =+#else+type instance Sing =+#endif+  SMaybe -type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsMaybe :: Maybe k -> Maybe k -> Bool+#endif+type family EqualsMaybe (a :: Maybe k) (b :: Maybe k) :: Bool where   EqualsMaybe Nothing Nothing = True   EqualsMaybe (Just a) (Just a') = a == a'   EqualsMaybe (x :: Maybe k) (y :: Maybe k) = False@@ -191,6 +239,8 @@   sing = SNothing instance SingI a => SingI (Just (a :: k)) where   sing = SJust sing+instance SingI1 Just where+  liftSing = SJust instance SingKind k => SingKind (Maybe k) where   type Demote (Maybe k) = Maybe (Demote k)   fromSing SNothing = Nothing@@ -202,21 +252,41 @@  -- 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)+#if __GLASGOW_HASKELL__ >= 810+type SList :: forall k. List k -> Type+#endif+data SList :: forall k. List k -> Type where+  SNil :: SList Nil+  SCons :: forall k (h :: k) (t :: List k). Sing h -> SList t -> SList (Cons h t)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(List k) =+#else+type instance Sing =+#endif+  SList -type NilSym0 = Nil+#if __GLASGOW_HASKELL__ >= 810+type NilSym0 :: List a+#endif+type family NilSym0 :: List a where+  NilSym0 = Nil -data ConsSym0 :: a ~> List a ~> List a+#if __GLASGOW_HASKELL__ >= 810+type ConsSym0 :: forall a. a ~> List a ~> List a+type ConsSym1 :: forall a. a -> List a ~> List a+type ConsSym2 :: forall a. a -> List a -> List a+#endif+data ConsSym0 :: forall a. a ~> List a ~> List a+data ConsSym1 :: forall a. a -> List a ~> List a+type family ConsSym2 (x :: a) (y :: List a) :: List a where+  ConsSym2 x y = Cons x y 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 instance Apply (ConsSym1 a) b = Cons a b -type family EqualsList (a :: List k) (b :: List k) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsList :: List k -> List k -> Bool+#endif+type family EqualsList (a :: List k) (b :: List k) :: Bool where   EqualsList Nil Nil = True   EqualsList (Cons a b) (Cons a' b') = (a == a') && (b == b')   EqualsList (x :: List k) (y :: List k) = False@@ -244,6 +314,10 @@ instance (SingI h, SingI t) =>            SingI (Cons (h :: k) (t :: List k)) where   sing = SCons sing sing+instance SingI h => SingI1 (Cons (h :: k)) where+  liftSing = SCons sing+instance SingI2 Cons where+  liftSing2 = SCons instance SingKind k => SingKind (List k) where   type Demote (List k) = List (Demote k)   fromSing SNil = Nil@@ -256,14 +330,27 @@  -- 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)+#if __GLASGOW_HASKELL__ >= 810+type SEither :: forall k1 k2. Either k1 k2 -> Type+#endif+data SEither :: forall k1 k2. Either k1 k2 -> Type where+  SLeft :: forall k1 (a :: k1). Sing a -> SEither (Left a)+  SRight :: forall k2 (b :: k2). Sing b -> SEither (Right b)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Either k1 k2) =+#else+type instance Sing =+#endif+  SEither  instance (SingI a) => SingI (Left (a :: k)) where   sing = SLeft sing+instance SingI1 Left where+  liftSing = SLeft instance (SingI b) => SingI (Right (b :: k)) where   sing = SRight sing+instance SingI1 Right where+  liftSing = SRight 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)@@ -289,14 +376,28 @@  -- Composite +#if __GLASGOW_HASKELL__ >= 810+type Composite :: Type -> Type -> Type+#endif 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)+#if __GLASGOW_HASKELL__ >= 810+type SComposite :: forall k1 k2. Composite k1 k2 -> Type+#endif+data SComposite :: forall k1 k2. Composite k1 k2 -> Type where+  SMkComp :: forall k1 k2 (a :: Either (Maybe k1) k2). SEither a -> SComposite (MkComp a)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(Composite k1 k2) =+#else+type instance Sing =+#endif+  SComposite  instance SingI a => SingI (MkComp (a :: Either (Maybe k1) k2)) where   sing = SMkComp sing+instance SingI1 MkComp where+  liftSing = SMkComp instance (SingKind k1, SingKind k2) => SingKind (Composite k1 k2) where   type Demote (Composite k1 k2) =     Composite (Demote k1) (Demote k2)@@ -313,8 +414,22 @@  -- Empty +#if __GLASGOW_HASKELL__ >= 810+type Empty :: Type+#endif data Empty-data instance Sing :: Empty -> Type++#if __GLASGOW_HASKELL__ >= 810+type SEmpty :: Empty -> Type+#endif+data SEmpty :: Empty -> Type++#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Empty =+#else+type instance Sing =+#endif+  SEmpty instance SingKind Empty where   type Demote Empty = Empty   fromSing = \case@@ -322,23 +437,44 @@  -- Type +#if __GLASGOW_HASKELL__ >= 810+type Vec :: Type -> Nat -> Type+#endif data Vec :: Type -> Nat -> Type where   VNil :: Vec a Zero   VCons :: a -> Vec a n -> Vec a (Succ n) +#if __GLASGOW_HASKELL__ >= 810+type Rep :: Type+#endif 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)+#if __GLASGOW_HASKELL__ >= 810+type SRep :: Type -> Type+#endif+data SRep :: Type -> Type where+  SNat :: SRep Nat+  SMaybe :: SRep a -> SRep (Maybe a)+  SVec :: SRep a -> SNat n -> SRep (Vec a n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Type =+#else+type instance Sing =+#endif+  SRep  instance SingI Nat where   sing = SNat instance SingI a => SingI (Maybe a) where   sing = SMaybe sing+instance SingI1 Maybe where+  liftSing = SMaybe instance (SingI a, SingI n) => SingI (Vec a n) where   sing = SVec sing sing+instance SingI a => SingI1 (Vec a) where+  liftSing = SVec sing+instance SingI2 Vec where+  liftSing2 = SVec  instance SingKind Type where   type Demote Type = Rep@@ -374,7 +510,10 @@       (Disproved contra, _) -> Disproved (\Refl -> contra Refl)       (_, Disproved contra) -> Disproved (\Refl -> contra Refl) -type family EqualsType (a :: Type) (b :: Type) where+#if __GLASGOW_HASKELL__ >= 810+type EqualsType :: Type -> Type -> Bool+#endif+type family EqualsType (a :: Type) (b :: Type) :: Bool where   EqualsType a a = True   EqualsType _ _ = False instance PEq Type where@@ -394,12 +533,18 @@ isJust Nothing = False isJust (Just _) = True +#if __GLASGOW_HASKELL__ >= 810+type IsJust :: Maybe k -> Bool+#endif type family IsJust (a :: Maybe k) :: Bool where     IsJust Nothing = False     IsJust (Just a) = True  -- defunctionalization symbols-data IsJustSym0 :: Maybe a ~> Bool+#if __GLASGOW_HASKELL__ >= 810+type IsJustSym0 :: forall a. Maybe a ~> Bool+#endif+data IsJustSym0 :: forall a. Maybe a ~> Bool type instance Apply IsJustSym0 a = IsJust a  sIsJust :: Sing a -> Sing (IsJust a)@@ -410,10 +555,16 @@ pred Zero = Zero pred (Succ n) = n +#if __GLASGOW_HASKELL__ >= 810+type Pred :: Nat -> Nat+#endif type family Pred (a :: Nat) :: Nat where   Pred Zero = Zero   Pred (Succ n) = n +#if __GLASGOW_HASKELL__ >= 810+type PredSym0 :: Nat ~> Nat+#endif data PredSym0 :: Nat ~> Nat type instance Apply PredSym0 a = Pred a @@ -425,15 +576,22 @@ map _ Nil = Nil map f (Cons h t) = Cons (f h) (map f t) +#if __GLASGOW_HASKELL__ >= 810+type Map :: (k1 ~> k2) -> List k1 -> List k2+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type MapSym0 :: forall a b. (a ~> b) ~> List a ~> List b+type MapSym1 :: forall a b. (a ~> b) -> List a ~> List b+#endif+data MapSym0 :: forall a b. (a ~> b) ~> List a ~> List b+data MapSym1 :: forall a b. (a ~> b) -> List a ~> List b type instance Apply  MapSym0 f     = MapSym1 f+type instance Apply (MapSym1 f) xs = Map f xs  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)@@ -458,26 +616,32 @@ 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 _ []    []      = []+zipWith :: (a -> b -> c) -> List a -> List b -> List c+zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith f xs ys)+zipWith _ Nil         (Cons _ _)  = Nil+zipWith _ (Cons _ _)  Nil         = Nil+zipWith _ Nil         Nil         = Nil -type family ZipWith (k1 :: a ~> b ~> c)-                    (k2 :: List a)-                    (k3 :: List b) :: List c where+#if __GLASGOW_HASKELL__ >= 810+type ZipWith :: (a ~> b ~> c) -> List a -> List b -> List c+#endif+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+#if __GLASGOW_HASKELL__ >= 810+type ZipWithSym0 :: forall a b c. (a ~> b ~> c) ~> List a ~> List b ~> List c+type ZipWithSym1 :: forall a b c. (a ~> b ~> c) -> List a ~> List b ~> List c+type ZipWithSym2 :: forall a b c. (a ~> b ~> c) -> List a -> List b ~> List c+#endif+data ZipWithSym0 :: forall a b c. (a ~> b ~> c) ~> List a ~> List b ~> List c+data ZipWithSym1 :: forall a b c. (a ~> b ~> c) -> List a ~> List b ~> List c+data ZipWithSym2 :: forall a b c. (a ~> b ~> c) -> List a -> List b ~> List c type instance Apply  ZipWithSym0 f        = ZipWithSym1 f+type instance Apply (ZipWithSym1 f)    xs = ZipWithSym2 f xs+type instance Apply (ZipWithSym2 f xs) ys = ZipWith f xs ys   sZipWith :: forall a b c (k1 :: a ~> b ~> c) (k2 :: List a) (k3 :: List b).@@ -492,17 +656,25 @@ either l _ (Left x) = l x either _ r (Right x) = r x +#if __GLASGOW_HASKELL__ >= 810+type Either_ :: (a ~> c) -> (b ~> c) -> Either a b -> c+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type Either_Sym0 :: forall a c b. (a ~> c) ~> (b ~> c) ~> Either a b ~> c+type Either_Sym1 :: forall a c b. (a ~> c) -> (b ~> c) ~> Either a b ~> c+type Either_Sym2 :: forall a c b. (a ~> c) -> (b ~> c) -> Either a b ~> c+#endif+data Either_Sym0 :: forall a c b. (a ~> c) ~> (b ~> c) ~> Either a b ~> c+data Either_Sym1 :: forall a c b. (a ~> c) -> (b ~> c) ~> Either a b ~> c+data Either_Sym2 :: forall a c b. (a ~> c) -> (b ~> c) -> Either a b ~> c type instance Apply  Either_Sym0        k1 = Either_Sym1 k1+type instance Apply (Either_Sym1 k1)    k2 = Either_Sym2 k1 k2+type instance Apply (Either_Sym2 k1 k2) k3 = Either_     k1 k2 k3  sEither :: forall a b c                   (l :: a ~> c)@@ -541,6 +713,9 @@ eitherToNat (Left  x) = x eitherToNat (Right x) = x +#if __GLASGOW_HASKELL__ >= 810+type EitherToNat :: Either Nat Nat -> Nat+#endif type family EitherToNat (e :: Either Nat Nat) :: Nat where     EitherToNat (Left x) = x     EitherToNat (Right x) = x@@ -553,14 +728,21 @@ liftMaybe _ Nothing = Nothing liftMaybe f (Just a) = Just (f a) +#if __GLASGOW_HASKELL__ >= 810+type LiftMaybe :: (a ~> b) -> Maybe a -> Maybe b+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type LiftMaybeSym0 :: forall a b. (a ~> b) ~> Maybe a ~> Maybe b+type LiftMaybeSym1 :: forall a b. (a ~> b) -> Maybe a ~> Maybe b+#endif+data LiftMaybeSym0 :: forall a b. (a ~> b) ~> Maybe a ~> Maybe b+data LiftMaybeSym1 :: forall a b. (a ~> b) -> Maybe a ~> Maybe b type instance Apply  LiftMaybeSym0     k1 = LiftMaybeSym1 k1+type instance Apply (LiftMaybeSym1 k1) k2 = LiftMaybe k1 k2  sLiftMaybe :: forall a b (f :: a ~> b) (x :: Maybe a).                 (forall (y :: a). Proxy f -> Sing y -> Sing (Apply f y)) ->@@ -572,15 +754,22 @@ Zero + x = x (Succ x) + y = Succ (x + y) +#if __GLASGOW_HASKELL__ >= 810+type (+) :: Nat -> Nat -> Nat+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type (+@#@$)  :: Nat ~> Nat ~> Nat+type (+@#@$$) :: Nat -> Nat ~> Nat+#endif+data (+@#@$)  :: Nat ~> Nat ~> Nat+data (+@#@$$) :: Nat -> Nat ~> Nat+type instance Apply  (+@#@$)  k1     = (+@#@$$) k1+type instance Apply ((+@#@$$) k1) k2 = (+) k1 k2  (%+) :: Sing m -> Sing n -> Sing (m + n) SZero %+ x = x@@ -591,15 +780,22 @@ (Succ x) - Zero = Succ x (Succ x) - (Succ y) = x - y +#if __GLASGOW_HASKELL__ >= 810+type (-) :: Nat -> Nat -> Nat+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type (-@#@$)  :: Nat ~> Nat ~> Nat+type (-@#@$$) :: Nat -> Nat ~> Nat+#endif+data (-@#@$)  :: Nat ~> Nat ~> Nat+data (-@#@$$) :: Nat -> Nat ~> Nat+type instance Apply  (-@#@$)  k1     = (-@#@$$) k1+type instance Apply ((-@#@$$) k1) k2 = (-) k1 k2  (%-) :: Sing m -> Sing n -> Sing (m - n) SZero %- _ = SZero@@ -609,46 +805,66 @@ isZero :: Nat -> Bool isZero n = if n == Zero then True else False +#if __GLASGOW_HASKELL__ >= 810+type IsZero :: Nat -> Bool+#endif type family IsZero (n :: Nat) :: Bool where   IsZero n = If (n == Zero) True False +#if __GLASGOW_HASKELL__ >= 810+type IsZeroSym0 :: Nat ~> Bool+#endif 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+-} +#if __GLASGOW_HASKELL__ >= 810+type (||) :: Bool -> Bool -> Bool+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type (||@#@$)  :: Bool ~> Bool ~> Bool+type (||@#@$$) :: Bool -> Bool ~> Bool+#endif+data (||@#@$)  :: Bool ~> Bool ~> Bool+data (||@#@$$) :: Bool -> Bool ~> Bool+type instance Apply (||@#@$) a = (||@#@$$) a+type instance Apply ((||@#@$$) a) b = (||) a b  (%||) :: 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--} +#if __GLASGOW_HASKELL__ >= 810+type Contains :: k -> List k -> Bool+#endif 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+#if __GLASGOW_HASKELL__ >= 810+type ContainsSym0 :: forall a. a ~> List a ~> Bool+type ContainsSym1 :: forall a. a -> List a ~> Bool+#endif+data ContainsSym0 :: forall a. a ~> List a ~> Bool+data ContainsSym1 :: forall a. a -> List a ~> Bool type instance Apply  ContainsSym0 a    = ContainsSym1 a+type instance Apply (ContainsSym1 a) b = Contains a b  {- sContains :: forall k. SEq k =>@@ -671,13 +887,14 @@   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--} +#if __GLASGOW_HASKELL__ >= 810+type Cont :: a ~> List a ~> Bool+#endif type family Cont :: a ~> List a ~> Bool where   Cont = Lambda10Sym0 @@ -700,21 +917,22 @@  type family Case10 a b scrut where   Case10 elt list Nil = False-  Case10 elt list (Cons h t) = (||$) @@ ((==$) @@ elt @@ h) @@ (Cont @@ elt @@ t)+  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 (==@#@$) 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+data (==@#@$$) a f where+  (:###==@#@$$) :: ((==@#@$$) x @@ arg) ~ (==@#@$$$) x arg+                => Proxy arg+                -> (==@#@$$) x y+type instance (==@#@$$) a `Apply` b = (==) a b -type (==$$$) a b = (==) a b+type family (==@#@$$$) a b where+  (==@#@$$$) a b = (==) a b   impNat :: forall m n. SingI n => Proxy n -> Sing m -> Sing (n + m)@@ -723,29 +941,20 @@ 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+instance Show (SNat n) 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-+#if __GLASGOW_HASKELL__ >= 810+type FindIndices :: (a ~> Bool) -> List a -> List Nat+#endif type family FindIndices (f :: a ~> Bool) (ls :: List a) :: List Nat where   FindIndices p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls @@ -767,9 +976,10 @@   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 instance Apply (Let123LoopSym3 a b c) d = Let123Loop a b c d -type Let123LoopSym4 a b c d = Let123Loop a b c d+type family Let123LoopSym4 a b c d where+  Let123LoopSym4 a b c d = Let123Loop a b c d  data FindIndicesSym0 a where   KindInferenceFindIndicesSym0 :: (FindIndicesSym0 @@ z) ~ FindIndicesSym1 z@@ -781,17 +991,18 @@   KindInferenceFindIndicesSym1 :: (FindIndicesSym1 a @@ z) ~ FindIndicesSym2 a z                                => Proxy z                                -> FindIndicesSym1 a b-type instance Apply (FindIndicesSym1 a) b = FindIndicesSym2 a b+type instance Apply (FindIndicesSym1 a) b = FindIndices a b -type FindIndicesSym2 a b = FindIndices a b+type family FindIndicesSym2 a b where+  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+  let sLoop :: forall (u1 :: Nat) (u2 :: List a).+               Sing u1 -> Sing u2             -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2)       sLoop _ SNil = SNil       sLoop sN (sX `SCons` sXs) = case sP @@ sX of@@ -829,9 +1040,10 @@   KindInferenceLambda22Sym1 :: (Lambda22Sym1 a @@ z) ~ Lambda22Sym2 a z                             => Proxy z                             -> Lambda22Sym1 a b-type instance Apply (Lambda22Sym1 a) b = Lambda22Sym2 a b+type instance Apply (Lambda22Sym1 a) b = Lambda22 a b -type Lambda22Sym2 a b = Lambda22 a b+type family Lambda22Sym2 a b where+  Lambda22Sym2 a b = Lambda22 a b  {- sFI :: forall a (t1 :: a ~> Bool) (t2 :: List a). Sing t1@@ -857,8 +1069,20 @@  ------------------------------------------------------------ -data G a where+#if __GLASGOW_HASKELL__ >= 810+type G :: Type -> Type+#endif+data G :: Type -> Type where   MkG :: G Bool -data instance Sing :: G a -> Type where-  SMkG :: Sing MkG+#if __GLASGOW_HASKELL__ >= 810+type SG :: forall a. G a -> Type+#endif+data SG :: forall a. G a -> Type where+  SMkG :: SG MkG+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @(G a) =+#else+type instance Sing =+#endif+  SG
tests/ByHand2.hs view
@@ -1,44 +1,85 @@ {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators,              DefaultSignatures, ScopedTypeVariables, InstanceSigs,              MultiParamTypeClasses, FunctionalDependencies,-             UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-}+             UndecidableInstances, CPP, TypeApplications #-}+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-orphans #-}++#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif++#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif module ByHand2 where -import Prelude hiding ( Eq(..), Ord(..), Bool(..), Ordering(..), not )-import Data.Kind (Type)+import Data.Kind import Data.Singletons (Sing) +#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif data Nat = Zero | Succ Nat-data Bool = False | True-data Ordering = LT | EQ | GT -not :: Bool -> Bool-not False = True-not True  = False+#if __GLASGOW_HASKELL__ >= 810+type SNat :: Nat -> Type+#endif+data SNat :: Nat -> Type where+  SZero :: SNat 'Zero+  SSucc :: SNat n -> SNat ('Succ n)+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Nat =+#else+type instance Sing =+#endif+  SNat -class Eq a where-  (==) :: a -> a -> Bool-  (/=) :: a -> a -> Bool-  infix 4 ==, /=+{-+type Bool :: Type+data Bool = False | True+-} -  x == y = not (x /= y)-  x /= y = not (x == y)+#if __GLASGOW_HASKELL__ >= 810+type SBool :: Bool -> Type+#endif+data SBool :: Bool -> Type where+  SFalse :: SBool 'False+  STrue  :: SBool 'True+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Bool =+#else+type instance Sing =+#endif+  SBool -instance Eq Nat where-  Zero == Zero = True-  Zero == Succ _ = False-  Succ _ == Zero = False-  Succ x == Succ y = x == y+{-+type Ordering :: Type+data Ordering = LT | EQ | GT+-} -data instance Sing :: Bool -> Type where-  SFalse :: Sing 'False-  STrue  :: Sing 'True+#if __GLASGOW_HASKELL__ >= 810+type SOrdering :: Ordering -> Type+#endif+data SOrdering :: Ordering -> Type where+  SLT :: SOrdering 'LT+  SEQ :: SOrdering 'EQ+  SGT :: SOrdering 'GT+#if __GLASGOW_HASKELL__ >= 808+type instance Sing @Ordering =+#else+type instance Sing =+#endif+  SOrdering -data instance Sing :: Nat -> Type where-  SZero :: Sing 'Zero-  SSucc :: Sing n -> Sing ('Succ n)+{-+not :: Bool -> Bool+not True  = False+not False = True+-} +#if __GLASGOW_HASKELL__ >= 810+type Not :: Bool -> Bool+#endif type family Not (x :: Bool) :: Bool where   Not 'True = 'False   Not 'False = 'True@@ -47,6 +88,20 @@ sNot STrue = SFalse sNot SFalse = STrue +{-+type Eq :: Type -> Constraint+class Eq a where+  (==) :: a -> a -> Bool+  (/=) :: a -> a -> Bool+  infix 4 ==, /=++  x == y = not (x /= y)+  x /= y = not (x == y)+-}++#if __GLASGOW_HASKELL__ >= 810+type PEq :: Type -> Constraint+#endif class PEq a where   type (==) (x :: a) (y :: a) :: Bool   type (/=) (x :: a) (y :: a) :: Bool@@ -54,12 +109,9 @@   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-+#if __GLASGOW_HASKELL__ >= 810+type SEq :: Type -> Constraint+#endif class SEq a where   (%==) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x == y)   (%/=) :: Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y)@@ -70,6 +122,18 @@   default (%/=) :: ((x /= y) ~ (Not (x == y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y)   x %/= y = sNot (x %== y) +instance Eq Nat where+  Zero == Zero = True+  Zero == Succ _ = False+  Succ _ == Zero = False+  Succ x == Succ y = 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+ instance SEq Nat where   (%==) :: forall (x :: Nat) (y :: Nat). Sing x -> Sing y -> Sing (x == y)   SZero   %== SZero   = STrue@@ -77,6 +141,7 @@   SZero   %== SSucc _ = SFalse   SSucc x %== SSucc y = x %== y +{- instance Eq Ordering where   LT == LT = True   LT == EQ = False@@ -87,35 +152,7 @@   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@@ -139,6 +176,27 @@   SGT %== SEQ = SFalse   SGT %== SGT = STrue +{-+type Ord :: Type -> Constraint+class Eq a => Ord a where+  compare :: a -> a -> Ordering+  (<) :: a -> a -> Bool++  x < y = compare x y == LT+-}++#if __GLASGOW_HASKELL__ >= 810+type POrd :: Type -> Constraint+#endif+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++#if __GLASGOW_HASKELL__ >= 810+type SOrd :: Type -> Constraint+#endif 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)@@ -146,18 +204,39 @@   default (%<) :: ((x < y) ~ (Compare x y == 'LT)) => Sing (x :: a) -> Sing (y :: a) -> Sing (x < y)   x %< y = sCompare x y %== SLT +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+ instance SOrd Nat where   sCompare SZero SZero = SEQ   sCompare SZero (SSucc _) = SLT   sCompare (SSucc _) SZero = SGT   sCompare (SSucc x) (SSucc y) = sCompare x y +#if __GLASGOW_HASKELL__ >= 810+type Pointed :: Type -> Constraint+#endif class Pointed a where   point :: a +#if __GLASGOW_HASKELL__ >= 810+type PPointed :: Type -> Constraint+#endif class PPointed a where   type Point :: a +#if __GLASGOW_HASKELL__ >= 810+type SPointed :: Type -> Constraint+#endif class SPointed a where   sPoint :: Sing (Point :: a) @@ -172,6 +251,9 @@  -------------------------------- +#if __GLASGOW_HASKELL__ >= 810+type FD :: Type -> Type -> Constraint+#endif class FD a b | a -> b where   meth :: a -> a   l2r  :: a -> b@@ -184,6 +266,9 @@ t1 = meth True t2 = l2r False +#if __GLASGOW_HASKELL__ >= 810+type PFD :: Type -> Type -> Constraint+#endif class PFD a b | a -> b where   type Meth (x :: a) :: a   type L2r (x :: a) :: b@@ -194,8 +279,15 @@   type L2r 'True = 'Succ 'Zero  type T1 = Meth 'True-type T2 = L2r 'False +#if __GLASGOW_HASKELL__ >= 810+type T2 :: Nat+#endif+type T2 = (L2r 'False :: Nat)++#if __GLASGOW_HASKELL__ >= 810+type SFD :: Type -> Type -> Constraint+#endif 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)@@ -206,5 +298,5 @@   sL2r STrue = SSucc SZero  sT1 = sMeth STrue-sT2 :: Sing (T2 :: Nat)+sT2 :: Sing T2 sT2 = sL2r SFalse
tests/SingletonsTestSuite.hs view
@@ -1,123 +1,6 @@-module Main (-    main- ) where--import Test.Tasty               ( TestTree, defaultMain, testGroup          )-import SingletonsTestSuiteUtils ( compileAndDumpStdTest, compileAndDumpTest-                                , testCompileAndDumpGroup, ghcOpts-                             --   , cleanFiles-                                )+-- | Currently, there is code to execute at runtime as a part of this test+-- suite, as the only interesting part is making sure that the code typechecks.+module Main (main) where  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"-    ]-  ]+main = pure ()
− tests/SingletonsTestSuiteUtils.hs
@@ -1,205 +0,0 @@-{-# 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}"
− tests/compile-and-dump/GradingClient/Database.ghc86.template
@@ -1,2610 +0,0 @@-GradingClient/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
− tests/compile-and-dump/GradingClient/Database.hs
@@ -1,552 +0,0 @@-{- 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 <<inProof>>-        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
− tests/compile-and-dump/GradingClient/Main.ghc86.template
@@ -1,123 +0,0 @@-GradingClient/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))
− tests/compile-and-dump/GradingClient/Main.hs
@@ -1,54 +0,0 @@-{- 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"
− tests/compile-and-dump/InsertionSort/InsertionSortImp.ghc86.template
@@ -1,212 +0,0 @@-InsertionSort/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
− tests/compile-and-dump/InsertionSort/InsertionSortImp.hs
@@ -1,205 +0,0 @@-{- 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)
− tests/compile-and-dump/Promote/Constructors.ghc86.template
@@ -1,79 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/Constructors.hs
@@ -1,13 +0,0 @@-module 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- |])
− tests/compile-and-dump/Promote/GenDefunSymbols.ghc86.template
@@ -1,54 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/GenDefunSymbols.hs
@@ -1,17 +0,0 @@-module 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, ''(:+) ])
− tests/compile-and-dump/Promote/Newtypes.ghc86.template
@@ -1,48 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/Newtypes.hs
@@ -1,10 +0,0 @@-module 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 }- |])
− tests/compile-and-dump/Promote/Pragmas.ghc86.template
@@ -1,12 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/Pragmas.hs
@@ -1,10 +0,0 @@-module Promote.Pragmas where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(promote [d|-  {-# INLINE foo #-}-  foo :: Bool-  foo = True- |])
− tests/compile-and-dump/Promote/Prelude.ghc86.template
@@ -1,19 +0,0 @@-Promote/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))
− tests/compile-and-dump/Promote/Prelude.hs
@@ -1,132 +0,0 @@-module 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
− tests/compile-and-dump/Promote/T180.ghc86.template
@@ -1,54 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/T180.hs
@@ -1,10 +0,0 @@-module 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-  |]
− tests/compile-and-dump/Promote/T361.ghc86.template
@@ -1,21 +0,0 @@-Promote/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
− tests/compile-and-dump/Promote/T361.hs
@@ -1,11 +0,0 @@-module T361 where--import Data.Proxy-import Data.Singletons.TH--$(genDefunSymbols [''Proxy])--$(promote [d|-  f :: Proxy 1 -> Proxy 2-  f Proxy = Proxy-  |])
− tests/compile-and-dump/Singletons/AsPattern.ghc86.template
@@ -1,405 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/AsPattern.hs
@@ -1,32 +0,0 @@-module 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- |])
− tests/compile-and-dump/Singletons/BadBoundedDeriving.ghc86.template
@@ -1,6 +0,0 @@--Singletons/BadBoundedDeriving.hs:0:0: error:-    Can't derive Bounded instance for Foo_0 a_1.-  |-5 | $(singletons [d|-  |   ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/BadBoundedDeriving.hs
@@ -1,7 +0,0 @@-module Singletons.BadBoundedDeriving where--import Data.Singletons.TH--$(singletons [d|-  data Foo a = Foo | Bar a deriving (Bounded)-  |])
− tests/compile-and-dump/Singletons/BadEnumDeriving.ghc86.template
@@ -1,6 +0,0 @@--Singletons/BadEnumDeriving.hs:0:0: error:-    Can't derive Enum instance for Foo_0 a_1.-  |-5 | $(singletons [d|-  |   ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/BadEnumDeriving.hs
@@ -1,8 +0,0 @@-module Singletons.BadEnumDeriving where--import Data.Singletons.TH--$(singletons [d|-  data Foo a = Foo a-               deriving Enum-  |])
− tests/compile-and-dump/Singletons/BoundedDeriving.ghc86.template
@@ -1,249 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/BoundedDeriving.hs
@@ -1,52 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/BoxUnBox.ghc86.template
@@ -1,54 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/BoxUnBox.hs
@@ -1,10 +0,0 @@-module 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- |])
− tests/compile-and-dump/Singletons/CaseExpressions.ghc86.template
@@ -1,319 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/CaseExpressions.hs
@@ -1,66 +0,0 @@-{-# 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
− tests/compile-and-dump/Singletons/Classes.ghc86.template
@@ -1,577 +0,0 @@-Singletons/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'
− tests/compile-and-dump/Singletons/Classes.hs
@@ -1,98 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/Classes2.ghc86.template
@@ -1,91 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/Classes2.hs
@@ -1,22 +0,0 @@-module 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- |])
− tests/compile-and-dump/Singletons/Contains.ghc86.template
@@ -1,50 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Contains.hs
@@ -1,13 +0,0 @@-module 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)- |])
− tests/compile-and-dump/Singletons/DataValues.ghc86.template
@@ -1,186 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/DataValues.hs
@@ -1,20 +0,0 @@-module 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)]--  |])
− tests/compile-and-dump/Singletons/Empty.ghc86.template
@@ -1,10 +0,0 @@-Singletons/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)
− tests/compile-and-dump/Singletons/Empty.hs
@@ -1,7 +0,0 @@-module Singletons.Empty where--import Data.Singletons.TH--$(singletons [d|-  data Empty- |])
− tests/compile-and-dump/Singletons/EmptyShowDeriving.ghc86.template
@@ -1,68 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/EmptyShowDeriving.hs
@@ -1,7 +0,0 @@-module Singletons.EmptyShowDeriving where--import Data.Singletons.TH--$(singletons [d| data Foo-                 deriving instance Show Foo-               |])
− tests/compile-and-dump/Singletons/EnumDeriving.ghc86.template
@@ -1,199 +0,0 @@-Singletons/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)
− tests/compile-and-dump/Singletons/EnumDeriving.hs
@@ -1,11 +0,0 @@-module Singletons.EnumDeriving where--import Data.Singletons.TH--$(singletons [d|-  data Foo = Bar | Baz | Bum-    deriving Enum-  data Quux = Q1 | Q2-  |])--$(singEnumInstance ''Quux)
− tests/compile-and-dump/Singletons/EqInstances.ghc86.template
@@ -1,21 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/EqInstances.hs
@@ -1,8 +0,0 @@-module Singletons.EqInstances where--import Data.Singletons.TH-import Data.Singletons.Prelude.Bool-import Singletons.Empty-import Singletons.Operators--$(singEqInstances [''Foo, ''Empty])
− tests/compile-and-dump/Singletons/Error.ghc86.template
@@ -1,30 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/Error.hs
@@ -1,11 +0,0 @@-module 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"- |])
− tests/compile-and-dump/Singletons/Fixity.ghc86.template
@@ -1,86 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Fixity.hs
@@ -1,16 +0,0 @@-module 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 ====- |])
− tests/compile-and-dump/Singletons/FunDeps.ghc86.template
@@ -1,96 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/FunDeps.hs
@@ -1,21 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/FunctorLikeDeriving.ghc86.template
@@ -1,1646 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/FunctorLikeDeriving.hs
@@ -1,17 +0,0 @@-{-# 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)-  |])
− tests/compile-and-dump/Singletons/HigherOrder.ghc86.template
@@ -1,480 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/HigherOrder.hs
@@ -1,57 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/LambdaCase.ghc86.template
@@ -1,252 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/LambdaCase.hs
@@ -1,39 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/Lambdas.ghc86.template
@@ -1,830 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Lambdas.hs
@@ -1,94 +0,0 @@-{-# 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
− tests/compile-and-dump/Singletons/LambdasComprehensive.ghc86.template
@@ -1,71 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/LambdasComprehensive.hs
@@ -1,29 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/LetStatements.ghc86.template
@@ -1,1002 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/LetStatements.hs
@@ -1,193 +0,0 @@-{-# 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
− tests/compile-and-dump/Singletons/Maybe.ghc86.template
@@ -1,140 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/Maybe.hs
@@ -1,7 +0,0 @@-module Singletons.Maybe where--import Data.Singletons.TH--$(singletons [d|-  data Maybe a = Nothing | Just a deriving (Eq, Show)- |])
− tests/compile-and-dump/Singletons/Nat.ghc86.template
@@ -1,266 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/Nat.hs
@@ -1,18 +0,0 @@-module 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- |])
− tests/compile-and-dump/Singletons/NatSymbolReflexive.ghc86.template
− tests/compile-and-dump/Singletons/NatSymbolReflexive.hs
@@ -1,11 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/Operators.ghc86.template
@@ -1,128 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Operators.hs
@@ -1,20 +0,0 @@-module 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)- |])
− tests/compile-and-dump/Singletons/OrdDeriving.ghc86.template
@@ -1,1235 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/OrdDeriving.hs
@@ -1,58 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/OverloadedStrings.ghc86.template
@@ -1,35 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/OverloadedStrings.hs
@@ -1,13 +0,0 @@-{-# 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"-    |])
− tests/compile-and-dump/Singletons/PatternMatching.ghc86.template
@@ -1,574 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/PatternMatching.hs
@@ -1,51 +0,0 @@-{-# 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
− tests/compile-and-dump/Singletons/PolyKinds.ghc86.template
@@ -1,28 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/PolyKinds.hs
@@ -1,8 +0,0 @@-module Singletons.PolyKinds where--import Data.Singletons.TH--$(singletons [d|-  class Cls (a :: k) where-    fff :: Proxy (a :: k) -> ()-  |])
− tests/compile-and-dump/Singletons/PolyKindsApp.ghc86.template
@@ -1,12 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/PolyKindsApp.hs
@@ -1,12 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/Records.ghc86.template
@@ -1,79 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Records.hs
@@ -1,29 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/ReturnFunc.ghc86.template
@@ -1,98 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/ReturnFunc.hs
@@ -1,23 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/Sections.ghc86.template
@@ -1,122 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Sections.hs
@@ -1,40 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/ShowDeriving.ghc86.template
@@ -1,582 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/ShowDeriving.hs
@@ -1,41 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/StandaloneDeriving.ghc86.template
@@ -1,447 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/StandaloneDeriving.hs
@@ -1,30 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/Star.ghc86.template
@@ -1,422 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/Star.hs
@@ -1,13 +0,0 @@-module 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])
− tests/compile-and-dump/Singletons/T124.ghc86.template
@@ -1,33 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T124.hs
@@ -1,13 +0,0 @@-module 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 |])
− tests/compile-and-dump/Singletons/T136.ghc86.template
@@ -1,171 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T136.hs
@@ -1,35 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T136b.ghc86.template
@@ -1,53 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T136b.hs
@@ -1,14 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T145.ghc86.template
@@ -1,39 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T145.hs
@@ -1,9 +0,0 @@-module Singletons.T145 where--import Data.Singletons.TH-import Data.Kind (Type)--$(singletons [d|-  class Column (f :: Type -> Type) where-    col :: f a -> a -> Bool-  |])
− tests/compile-and-dump/Singletons/T153.ghc86.template
− tests/compile-and-dump/Singletons/T153.hs
@@ -1,13 +0,0 @@-{-# 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
− tests/compile-and-dump/Singletons/T157.ghc86.template
− tests/compile-and-dump/Singletons/T157.hs
@@ -1,6 +0,0 @@-module T157 where--import Data.Singletons.Prelude--foo :: SList '["a", "b", "c"]-foo = sing `SCons` sing `SCons` sing
− tests/compile-and-dump/Singletons/T159.ghc86.template
@@ -1,245 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T159.hs
@@ -1,27 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/T160.ghc86.template
@@ -1,85 +0,0 @@-Singletons/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-   |     ^^^^
− tests/compile-and-dump/Singletons/T160.hs
@@ -1,13 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/T163.ghc86.template
@@ -1,51 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T163.hs
@@ -1,5 +0,0 @@-module T163 where--import Data.Singletons.TH--$(singletons [d| data a + b = L a | R b |])
− tests/compile-and-dump/Singletons/T166.ghc86.template
@@ -1,139 +0,0 @@-Singletons/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|-   |   ^^^^^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/T166.hs
@@ -1,20 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T167.ghc86.template
@@ -1,178 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T167.hs
@@ -1,26 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T172.ghc86.template
@@ -1,40 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T172.hs
@@ -1,18 +0,0 @@-{-# 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-  ($>) = (+)-  |])
− tests/compile-and-dump/Singletons/T175.ghc86.template
@@ -1,45 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T175.hs
@@ -1,28 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T176.ghc86.template
@@ -1,166 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T176.hs
@@ -1,29 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T178.ghc86.template
@@ -1,210 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T178.hs
@@ -1,15 +0,0 @@-module 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 = []-  |])
− tests/compile-and-dump/Singletons/T183.ghc86.template
@@ -1,512 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T183.hs
@@ -1,65 +0,0 @@-module 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 ()-  |])
− tests/compile-and-dump/Singletons/T184.ghc86.template
@@ -1,499 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T184.hs
@@ -1,26 +0,0 @@-{-# 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]-  |])
− tests/compile-and-dump/Singletons/T187.ghc86.template
@@ -1,57 +0,0 @@-Singletons/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)
− tests/compile-and-dump/Singletons/T187.hs
@@ -1,8 +0,0 @@-module T187 where--import Data.Singletons.TH--$(singletons[d| data Empty-                deriving instance Eq Empty-                deriving instance Ord Empty-              |])
− tests/compile-and-dump/Singletons/T190.ghc86.template
@@ -1,188 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T190.hs
@@ -1,12 +0,0 @@-{-# 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) |])
− tests/compile-and-dump/Singletons/T197.ghc86.template
@@ -1,43 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T197.hs
@@ -1,10 +0,0 @@-module T197 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|-  infixl 5 $$:-  ($$:) :: Bool -> Bool -> Bool-  _ $$: _ = False- |])
− tests/compile-and-dump/Singletons/T197b.ghc86.template
@@ -1,106 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T197b.hs
@@ -1,10 +0,0 @@-module T197b where--import Data.Singletons.TH--$(singletons-  [d| data a :*: b = a :*: b--      data Pair a b = MkPair a b-      infixr 9 `Pair`, `MkPair`-    |])
− tests/compile-and-dump/Singletons/T200.ghc86.template
@@ -1,204 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T200.hs
@@ -1,15 +0,0 @@-module 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-    |])
− tests/compile-and-dump/Singletons/T206.ghc86.template
− tests/compile-and-dump/Singletons/T206.hs
@@ -1,5 +0,0 @@-module T206 where--import Data.Singletons.Prelude--x = SCons @Bool @True @'[False]
− tests/compile-and-dump/Singletons/T209.ghc86.template
@@ -1,82 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T209.hs
@@ -1,16 +0,0 @@-{-# 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)-    |])
− tests/compile-and-dump/Singletons/T216.ghc86.template
@@ -1,56 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T216.hs
@@ -1,12 +0,0 @@-module 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])
− tests/compile-and-dump/Singletons/T226.ghc86.template
@@ -1,6 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T226.hs
@@ -1,5 +0,0 @@-module T226 where--import Data.Singletons.TH--$(singletons [d| class a ~> b |])
− tests/compile-and-dump/Singletons/T229.ghc86.template
@@ -1,24 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T229.hs
@@ -1,6 +0,0 @@-module T229 where--import Data.Singletons.TH--$(singletons [d| ___foo :: Bool -> Bool-                 ___foo _ = True |])
− tests/compile-and-dump/Singletons/T249.ghc86.template
@@ -1,90 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T249.hs
@@ -1,12 +0,0 @@-module 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-    |])
− tests/compile-and-dump/Singletons/T271.ghc86.template
@@ -1,199 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T271.hs
@@ -1,13 +0,0 @@-module 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)-      |])
− tests/compile-and-dump/Singletons/T287.ghc86.template
@@ -1,116 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T287.hs
@@ -1,11 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T29.ghc86.template
@@ -1,115 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T29.hs
@@ -1,44 +0,0 @@-module 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
− tests/compile-and-dump/Singletons/T297.ghc86.template
@@ -1,59 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T297.hs
@@ -1,13 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T312.ghc86.template
@@ -1,215 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T312.hs
@@ -1,14 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T313.ghc86.template
@@ -1,130 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T313.hs
@@ -1,38 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T316.ghc86.template
@@ -1,40 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T316.hs
@@ -1,10 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/T322.ghc86.template
@@ -1,49 +0,0 @@-Singletons/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))
− tests/compile-and-dump/Singletons/T322.hs
@@ -1,13 +0,0 @@-module T322 where--import Data.Singletons.Prelude-import Data.Singletons.TH--$(singletons [d|-  (!) :: Bool -> Bool -> Bool-  (!) = (||)-  infixr 2 !-  |])--f1 :: (False && True :! True) :~: True-f1 = Refl
− tests/compile-and-dump/Singletons/T323.ghc86.template
− tests/compile-and-dump/Singletons/T323.hs
@@ -1,7 +0,0 @@-module T323 where--import Data.Singletons.Prelude-import Data.Type.Equality--test :: f .@#@$$$ (g .@#@$$$ h) :~: f .@#@$$$ g .@#@$$$ h-test = Refl
− tests/compile-and-dump/Singletons/T33.ghc86.template
@@ -1,36 +0,0 @@-Singletons/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|-  |   ^^^^^^^^^^^^^^...
− tests/compile-and-dump/Singletons/T33.hs
@@ -1,9 +0,0 @@-module Singletons.T33 where--import Data.Singletons.TH-import Data.Singletons.Prelude--$(singletons [d|-  foo :: (Bool, Bool) -> ()-  foo ~(_, _) = ()-  |])
− tests/compile-and-dump/Singletons/T332.ghc86.template
@@ -1,57 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T332.hs
@@ -1,17 +0,0 @@-module T332 where--import Data.Singletons.TH--$(promote [d|-  data Foo = MkFoo--  f :: Foo -> ()-  f MkFoo{} = ()-  |])--$(singletons [d|-  data Bar = MkBar--  b :: Bar -> ()-  b MkBar{} = ()-  |])
− tests/compile-and-dump/Singletons/T342.ghc86.template
@@ -1,17 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T342.hs
@@ -1,12 +0,0 @@-module 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)
− tests/compile-and-dump/Singletons/T353.ghc86.template
@@ -1,104 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T353.hs
@@ -1,17 +0,0 @@-module 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])
− tests/compile-and-dump/Singletons/T358.ghc86.template
@@ -1,118 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T358.hs
@@ -1,24 +0,0 @@-module 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 _ = []-  |])
− tests/compile-and-dump/Singletons/T371.ghc86.template
@@ -1,233 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T371.hs
@@ -1,16 +0,0 @@-module 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))
− tests/compile-and-dump/Singletons/T54.ghc86.template
@@ -1,53 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T54.hs
@@ -1,12 +0,0 @@-{-# 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-  |])
− tests/compile-and-dump/Singletons/T78.ghc86.template
@@ -1,32 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/T78.hs
@@ -1,13 +0,0 @@-module 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-  |])
− tests/compile-and-dump/Singletons/TopLevelPatterns.ghc86.template
@@ -1,347 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/TopLevelPatterns.hs
@@ -1,40 +0,0 @@-{-# 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]- |])
− tests/compile-and-dump/Singletons/TypeRepTYPE.ghc86.template
− tests/compile-and-dump/Singletons/TypeRepTYPE.hs
@@ -1,40 +0,0 @@-{-# 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)
− tests/compile-and-dump/Singletons/Undef.ghc86.template
@@ -1,47 +0,0 @@-Singletons/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
− tests/compile-and-dump/Singletons/Undef.hs
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-module Singletons.Undef where--import Data.Singletons.TH--$(singletons [d|-  foo :: Bool -> Bool-  foo = undefined--  bar :: Bool -> Bool-  bar = error "urk"-  |])
− tests/compile-and-dump/buildGoldenFiles.awk
@@ -1,1 +0,0 @@-/INSERT/{while((getline line < $2) > 0 ){if(line !~ /INSERT/){print line}}close($2);next}1