packages feed

singletons 2.4.1 → 3.0.4

raw patch · 227 files changed

Files

CHANGES.md view
@@ -1,5 +1,450 @@-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+-----+* `ShowSing` is now a type class (with a single instance) instead of a type+  synonym. This was changed because defining `ShowSing` as a type synonym+  prevents it from working well with recursive types due to an unfortunate GHC+  bug. For more information, see+  [issue #371](https://github.com/goldfirere/singletons/issues/371).+* Add an `IsString` instance for `SomeSing`.++2.5+---+* The `Data.Promotion.Prelude.*` namespace has been removed. Use the+  corresponding modules in the `Data.Singletons.Prelude.*` namespace instead.++* Fix a regression in which certain infix type families, such as `(++)`, `($)`,+  `(+)`, and others, did not have the correct fixities.++* The default implementation of the `(==)` type in `PEq` was changed from+  `(Data.Type.Equality.==)` to a custom type family, `DefaultEq`. The reason+  for this change is that `(Data.Type.Equality.==)` is unable to conclude that+  `a == a` reduces to `True` for any `a`. (As a result, the previous version of+  `singletons` regressed in terms of type inference for the `PEq` instances+  for `Nat` and `Symbol`, which used that default.) On the other hand,+  `DefaultEq a a` _does_ reduce to `True` for all `a`.++* Add `Enum Nat`, `Show Nat`, and `Show Symbol` instances to+  `Data.Singletons.TypeLits`.++* Template Haskell-generated code may require `DataKinds` and `PolyKinds` in+  scenarios which did not previously require it:+  * `singletons` now explicitly quantifies all kind variables used in explicit+    `forall`s.+  * `singletons` now generates `a ~> b` instead of `TyFun a b -> Type` whenever+    possible.++* Since `th-desugar` now desugars all data types to GADT syntax, Template+  Haskell-generated code may require `GADTs` in situations that didn't require+  it before.++* Overhaul the way derived `Show` instances for singleton types works. Before,+  there was an awkward `ShowSing` class (which was essentially a cargo-culted+  version of `Show` specialized for `Sing`) that one had to create instances+  for separately. Now that GHC has `QuantifiedConstraints`, we can scrap this+  whole class and turn `ShowSing` into a simple type synonym:++  ```haskell+  type ShowSing k = forall z. Show (Sing (z :: k))+  ```++  Now, instead of generating a hand-written `ShowSing` and `Show` instance for+  each singleton type, we only generate a single (derived!) `Show` instance.+  As a result of this change, you will likely need to enable+  `QuantifiedConstraints` and `StandaloneDeriving` if you single any derived+  `Show` instances in your code.++* The kind of the type parameter to `SingI` is no longer specified. This only+  affects you if you were using the `sing` method with `TypeApplications`. For+  instance, if you were using `sing @Bool @True` before, then you will now need+  to now use `sing @Bool` instead.++* `singletons` now generates `SingI` instances for defunctionalization symbols+  through Template Haskell. As a result, you may need to enable+  `FlexibleInstances` in more places.++* `genDefunSymbols` is now more robust with respect to types that use+  dependent quantification, such as:++  ```haskell+  type family MyProxy k (a :: k) :: Type where+    MyProxy k (a :: k) = Proxy a+  ```++  See the documentation for `genDefunSymbols` for limitations to this.++* Rename `Data.Singletons.TypeRepStar` to `Data.Singletons.TypeRepTYPE`, and+  generalize the `Sing :: Type -> Type` instance to `Sing :: TYPE rep -> Type`,+  allowing it to work over more open kinds. Also rename `SomeTypeRepStar` to+  `SomeTypeRepTYPE`, and change its definition accordingly.++* Promoting or singling a type synonym or type family declaration now produces+  defunctionalization symbols for it. (Previously, promoting or singling a type+  synonym did nothing whatsoever, and promoting or singling a type family+  produced an error.)++* `singletons` now produces fixity declarations for defunctionalization+  symbols when appropriate.++* Add `(%<=?)`, a singled version of `(<=?)` from `GHC.TypeNats`, as well as+  defunctionalization symbols for `(<=?)`, to `Data.Singletons.TypeLits`.++* Add `Data.Singletons.Prelude.{Semigroup,Monoid}`, which define+  promoted and singled versions of the `Semigroup` and `Monoid` type classes,+  as well as various newtype modifiers.++  `Symbol` is now has promoted `Semigroup` and `Monoid` instances as well.+  As a consequence, `Data.Singletons.TypeLits` no longer exports `(<>)` or+  `(%<>)`, as they are superseded by the corresponding methods from+  `PSemigroup` and `SSemigroup`.++* Add promoted and singled versions of the `Functor`, `Foldable`,+  `Traversable`, `Applicative`, `Alternative`, `Monad`, `MonadPlus`, and+  `MonadZip` classes. Among other things, this grants the ability to promote+  or single `do`-notation and list comprehensions.+  * `Data.Singletons.Prelude.List` now reexports more general+    `Foldable`/`Traversable` functions wherever possible, just as `Data.List`+    does.++* Add `Data.Singletons.Prelude.{Const,Identity}`, which define+  promoted and singled version of the `Const` and `Identity` data types,+  respectively.++* Promote and single the `Down` newtype in `Data.Singletons.Prelude.Ord`.++* To match the `base` library, the promoted/singled versions of `comparing`+  and `thenCmp` are no longer exported from `Data.Singletons.Prelude`. (They+  continue to live in `Data.Singletons.Prelude.Ord`.)++* Permit singling of expression and pattern signatures.++* Permit promotion and singling of `InstanceSigs`.++* `sError` and `sUndefined` now have `HasCallStack` constraints, like their+  counterparts `error` and `undefined`. The promoted and singled counterparts+  to `errorWithoutStackTrace` have also been added in case you do not want+  this behavior.++* Add `Data.Singletons.TypeError`, which provides a drop-in replacement for+  `GHC.TypeLits.TypeError` which can be used at both the value- and type-level.  2.4.1 -----
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,668 +1,24 @@-singletons 2.4-==============+`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.--Compatibility----------------The singletons library requires GHC 8.4.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:--* `DefaultSignatures`-* `EmptyCase`-* `ExistentialQuantification`-* `FlexibleContexts`-* `FlexibleInstances`-* `GADTs`-* `InstanceSigs`-* `KindSignatures`-* `RankNTypes`-* `ScopedTypeVariables`-* `TemplateHaskell`-* `TypeFamilies`-* `TypeInType`-* `TypeOperators`-* `UndecidableInstances`--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` class provided in the-`Data.Singletons.ShowSing` module, which facilitates the ability to write-`Show` instances for `Sing` instances.--What is the difference between the two? 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 `ShowSing Bool`-instance is intended for printing the value of the _singleton_ constructor-`SFalse`, so calling `showsSingPrec 0 SFalse` yields `"SFalse"` (simiarly for-the `Show (Sing (SBool z))` instance).--Instance of `PShow`, `SShow`, `ShowSing`, 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.---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-* sections-* undefined-* error-* deriving `Eq`, `Ord`, `Show`, `Bounded`, and `Enum`-* 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-* higher-kinded type variables (see below)-* functional dependencies (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`, and `Enum`) 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.--The following constructs are supported for promotion but not singleton generation:--* scoped type variables-* 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.--The following constructs are not supported:--* list comprehensions-* do-* arithmetic sequences-* datatypes that store arrows, `Nat`, or `Symbol`-* literals (limited support)--Why are these out of reach? The first two depend on monads, which mention a-higher-kinded type variable. GHC did not support higher-sorted kind variables,-which are be necessary to promote/singletonize monads, and `singletons` has-not be rewritten to accommodate this new ability. [This bug-report](https://github.com/goldfirere/singletons/issues/184) is a feature request-looking for support for these constructs.--Arithmetic sequences are defined using `Enum` typeclass, which uses infinite-lists.--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.TypeRepStar` 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 :: Type -> Type where-      STypeRep :: TypeRep a -> Sing a-    ```--   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 `*`.+`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. -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.+`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). -Known bugs-----------+You may also be interested in the following related libraries: -* 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.+* 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`.
singletons.cabal view
@@ -1,143 +1,82 @@ name:           singletons-version:        2.4.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:     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.4.1-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/*.ghc84.template,-                    tests/compile-and-dump/InsertionSort/*.ghc84.template,-                    tests/compile-and-dump/Promote/*.ghc84.template,-                    tests/compile-and-dump/Singletons/*.ghc84.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:     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.4.1+  subdir:   singletons+  tag:      v3.0.2 +source-repository head+  type:     git+  location: https://github.com/goldfirere/singletons.git+  subdir:   singletons+  branch:   master+ library   hs-source-dirs:     src-  build-depends:      base >= 4.11 && < 4.12,-                      mtl >= 2.2.1,-                      ghc-boot-th,-                      template-haskell,-                      containers >= 0.5,-                      th-desugar >= 1.8 && < 1.9,-                      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.TypeRepStar-                      Data.Singletons.TH-                      Data.Singletons.Prelude-                      Data.Singletons.Prelude.Base-                      Data.Singletons.Prelude.Bool-                      Data.Singletons.Prelude.Either-                      Data.Singletons.Prelude.Enum-                      Data.Singletons.Prelude.Eq-                      Data.Singletons.Prelude.Function-                      Data.Singletons.Prelude.IsString-                      Data.Singletons.Prelude.Ord-                      Data.Singletons.Prelude.List-                      Data.Singletons.Prelude.List.NonEmpty-                      Data.Singletons.Prelude.Maybe-                      Data.Singletons.Prelude.Num-                      Data.Singletons.Prelude.Show-                      Data.Singletons.Prelude.Tuple-                      Data.Singletons.Prelude.Void-                      Data.Promotion.Prelude-                      Data.Promotion.TH-                      Data.Promotion.Prelude.Base-                      Data.Promotion.Prelude.Bool-                      Data.Promotion.Prelude.Either-                      Data.Promotion.Prelude.Eq-                      Data.Promotion.Prelude.Function-                      Data.Promotion.Prelude.IsString-                      Data.Promotion.Prelude.Ord-                      Data.Promotion.Prelude.Enum-                      Data.Promotion.Prelude.List-                      Data.Promotion.Prelude.List.NonEmpty-                      Data.Promotion.Prelude.Maybe-                      Data.Promotion.Prelude.Num-                      Data.Promotion.Prelude.Show-                      Data.Promotion.Prelude.Tuple-                      Data.Promotion.Prelude.Void-                      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.Ord-                      Data.Singletons.Deriving.Show-                      Data.Singletons.Internal-                      Data.Singletons.Prelude.List.NonEmpty.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.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:     src, tests-  ghc-options:        -Wall+  hs-source-dirs:     tests+  ghc-options:        -Wall -threaded   default-language:   Haskell2010   main-is:            SingletonsTestSuite.hs-  other-modules:      SingletonsTestSuiteUtils+  other-modules:      ByHand+                      ByHand2 -  build-depends:      base >= 4.11 && < 4.12,-                      filepath >= 1.3,-                      process >= 1.1,-                      singletons,-                      tasty >= 0.6,-                      tasty-golden >= 2.2,-                      directory >= 1+  build-depends:      base >= 4.9 && < 4.22,+                      singletons
− src/Data/Promotion/Prelude.hs 
@@ -1,186 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Mimics the Haskell Prelude, but with promoted types.----------------------------------------------------------------------------------{-# LANGUAGE ExplicitNamespaces #-}-module Data.Promotion.Prelude (-  -- * Standard types, classes and related functions-  -- ** Basic data types-  If, Not, type (&&), type (||), Otherwise,--  maybe_, Maybe_, either_, Either_,--  Symbol,--  Fst, Snd, Curry, Uncurry,--  -- * Error reporting-  Error, Undefined,--  -- * Promoted equality-  module Data.Promotion.Prelude.Eq,--  -- * Promoted comparisons-  module Data.Promotion.Prelude.Ord,--  -- * Promoted enumerations-  -- | As a matter of convenience, the promoted Prelude does /not/ export-  -- promoted @succ@ and @pred@, due to likely conflicts with-  -- unary numbers. Please import 'Data.Promotion.Prelude.Enum' directly if-  -- you want these.-  module Data.Promotion.Prelude.Enum,--  -- * Promoted numbers-  module Data.Promotion.Prelude.Num,-  type (^),--  -- * Promoted 'Show'-  PShow(..), ShowS, SChar, show_, type (<>), Shows, ShowChar, ShowString, ShowParen,--  -- ** Miscellaneous functions-  Id, Const, (:.), type ($), type ($!), Flip, AsTypeOf, Until, Seq,--  -- * List operations-  Map, type (++), Filter,-  Head, Last, Tail, Init, Null, Length, type (!!),-  Reverse,-  -- ** Reducing lists (folds)-  Foldl, Foldl1, Foldr, Foldr1,-  -- *** Special folds-  And, Or, Any, All,-  Sum, Product,-  Concat, ConcatMap,-  Maximum, Minimum,-  -- ** Building lists-  -- *** Scans-  Scanl, Scanl1, Scanr, Scanr1,-  -- *** Infinite lists-  Replicate,-  -- ** Sublists-  Take, Drop, SplitAt,-  TakeWhile, DropWhile, Span, Break,--  -- ** Searching lists-  Elem, NotElem, Lookup,-  -- ** Zipping and unzipping lists-  Zip, Zip3, ZipWith, ZipWith3, Unzip, Unzip3,-  -- ** Functions on 'Symbol's-  Unlines, Unwords,--  -- * 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, UndefinedSym0,--  type (^@#@$), type (^@#@$$), type (^@#@$$$),--  ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,-  Show_Sym0, Show_Sym1,-  ShowListSym0, ShowListSym1, ShowListSym2,-  type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),-  ShowsSym0, ShowsSym1, ShowsSym2,-  ShowCharSym0, ShowCharSym1, ShowCharSym2,-  ShowStringSym0, ShowStringSym1, ShowStringSym2,-  ShowParenSym0, ShowParenSym1, ShowParenSym2,--  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 (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1,-  TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1,--  FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,-  Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,-  FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,-  Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,--  ConcatSym0, ConcatSym1,-  ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,-  MaximumBySym0, MaximumBySym1, MaximumBySym2,-  MinimumBySym0, MinimumBySym1, MinimumBySym2,-  AndSym0, AndSym1, OrSym0, OrSym1,-  AnySym0, AnySym1, AnySym2,-  AllSym0, AllSym1, AllSym2,--  ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,-  Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,-  ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,-  Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,--  ElemSym0, ElemSym1, ElemSym2,-  NotElemSym0, NotElemSym1, NotElemSym2,--  ZipSym0, ZipSym1, ZipSym2,-  Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3,-  ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,-  ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3,-  UnzipSym0, UnzipSym1,--  UnlinesSym0, UnlinesSym1, UnwordsSym0, UnwordsSym1,--  UntilSym0, UntilSym1, UntilSym2, UntilSym3,-  LengthSym0, LengthSym1,-  SumSym0, SumSym1,-  ProductSym0, ProductSym1,-  ReplicateSym0, ReplicateSym1, ReplicateSym2,-  TakeSym0, TakeSym1, TakeSym2,-  DropSym0, DropSym1, DropSym2,-  SplitAtSym0, SplitAtSym1, SplitAtSym2,-  TakeWhileSym0, TakeWhileSym1, TakeWhileSym2,-  DropWhileSym0, DropWhileSym1, DropWhileSym2,-  SpanSym0, SpanSym1, SpanSym2,-  BreakSym0, BreakSym1, BreakSym2,-  LookupSym0, LookupSym1, LookupSym2,-  FilterSym0, FilterSym1, FilterSym2,-  type (!!@#@$), type (!!@#@$$), type (!!@#@$$$),-  ) where--import Data.Promotion.Prelude.Base-import Data.Promotion.Prelude.Bool-import Data.Promotion.Prelude.Either-import Data.Promotion.Prelude.List-import Data.Promotion.Prelude.Maybe-import Data.Promotion.Prelude.Tuple-import Data.Promotion.Prelude.Eq-import Data.Promotion.Prelude.Ord-import Data.Promotion.Prelude.Enum-  hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1)-import Data.Promotion.Prelude.Num-import Data.Promotion.Prelude.Show-import Data.Singletons.TypeLits
− src/Data/Promotion/Prelude/Base.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE TemplateHaskell, KindSignatures, PolyKinds, TypeOperators,-             DataKinds, ScopedTypeVariables, TypeFamilies, GADTs,-             UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.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 promoted 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 @Prelude@. Also, please excuse--- the apparent repeated variable names. This is due to an interaction--- between Template Haskell and Haddock.----------------------------------------------------------------------------------module Data.Promotion.Prelude.Base (-  -- * Promoted functions from @GHC.Base@-  Foldr, Map, type (++), Otherwise, Id, Const, (:.), type ($), type ($!),-  Flip, Until, AsTypeOf, Seq,--  -- * 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 ($!@#@$$$),-  FlipSym0, FlipSym1, FlipSym2, FlipSym3,-  UntilSym0, UntilSym1, UntilSym2, UntilSym3,-  AsTypeOfSym0, AsTypeOfSym1, AsTypeOfSym2,-  SeqSym0, SeqSym1, SeqSym2-  ) where--import Data.Singletons.TH-import Data.Singletons.Prelude.Base--$(promoteOnly [d|-  -- Does not singletoznize. See #30-  until                   :: (a -> Bool) -> (a -> a) -> a -> a-  until p f = go-    where-      go x | p x          = x-           | otherwise    = go (f x)- |])
− src/Data/Promotion/Prelude/Bool.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Bool--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to 'Bool',--- including a promoted 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.Promotion.Prelude.Bool (-  If,--  -- * Promoted functions from @Data.Bool@-  Bool_, bool_,-  -- | The preceding two definitions are derived from the function 'bool' in-  -- @Data.Bool@. The extra underscore is to avoid name clashes with the type-  -- 'Bool'.--  Not, type (&&), type (||), Otherwise,--  -- * 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.Prelude.Bool
− src/Data/Promotion/Prelude/Either.hs 
@@ -1,38 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Either--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  jan.stolarek@p.lodz.pl--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to 'Either',--- including a promoted 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.Promotion.Prelude.Either (-  -- * Promoted functions from @Data.Either@-  either_, Either_,-  -- | 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, Rights, PartitionEithers, IsLeft, IsRight,--  -- * 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.Either
− src/Data/Promotion/Prelude/Enum.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies,-             UndecidableInstances, GADTs #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.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------ Exports promoted versions of 'Enum' and 'Bounded'-----------------------------------------------------------------------------------module Data.Promotion.Prelude.Enum (-  PBounded(..), PEnum(..),--  -- ** Defunctionalization symbols-  MinBoundSym0,-  MaxBoundSym0,-  SuccSym0, SuccSym1,-  PredSym0, PredSym1,-  ToEnumSym0, ToEnumSym1,-  FromEnumSym0, FromEnumSym1,-  EnumFromToSym0, EnumFromToSym1, EnumFromToSym2,-  EnumFromThenToSym0, EnumFromThenToSym1, EnumFromThenToSym2,-  EnumFromThenToSym3-  ) where--import Data.Singletons.Prelude.Enum
− src/Data/Promotion/Prelude/Eq.hs 
@@ -1,21 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Eq--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Provided promoted definitions related to type-level equality.-----------------------------------------------------------------------------------{-# LANGUAGE ExplicitNamespaces #-}-module Data.Promotion.Prelude.Eq (-  PEq(..),-  type (==@#@$), type (==@#@$$), type (==@#@$$$),-  type (/=@#@$), type (/=@#@$$), type (/=@#@$$$)-  ) where--import Data.Singletons.Prelude.Eq
− src/Data/Promotion/Prelude/Function.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Function--- Copyright   :  (C) 2016 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions from @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 ExplicitNamespaces #-}--module Data.Promotion.Prelude.Function (-    -- * "Prelude" re-exports-    Id, Const, (:.), Flip, type ($)-    -- * Other combinators-  , type (&), On--    -- * 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.Function
− src/Data/Promotion/Prelude/IsString.hs 
@@ -1,22 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.IsString--- Copyright   :  (C) 2017 Ryan Scott--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines and exports a promoted version of the 'IsString'--- type class from "Data.String".-------------------------------------------------------------------------------module Data.Promotion.Prelude.IsString (-  PIsString(..),--  -- ** Defunctionalization symbols-  FromStringSym0, FromStringSym1-  ) where--import Data.Singletons.Prelude.IsString-import Data.Singletons.TypeLits ()   -- for the IsString instance!
− src/Data/Promotion/Prelude/List.hs 
@@ -1,309 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies,-             TemplateHaskell, GADTs, UndecidableInstances, RankNTypes,-             ScopedTypeVariables, MultiWayIf #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.List--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to 'List',--- including a promoted version of all 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.Promotion.Prelude.List (-  -- * Basic functions-  type (++), Head, Last, Tail, Init, Null, Length,--   -- * List transformations-  Map, Reverse, Intersperse, Intercalate, Transpose, Subsequences, Permutations,--  -- * Reducing lists (folds)-  Foldl, Foldl', Foldl1, Foldl1', Foldr, Foldr1,--  -- ** Special folds-  Concat, ConcatMap, And, Or, Any, All, Sum, Product, Maximum, Minimum,--  -- * Building lists--  -- ** Scans-  Scanl, Scanl1, Scanr, Scanr1,--  -- ** Accumulating maps-  MapAccumL, MapAccumR,--  -- ** Infinite lists-  Replicate,--  -- ** Unfolding-  Unfoldr,--  -- * Sublists--  -- ** Extracting sublists-  Take, Drop, SplitAt,-  TakeWhile, DropWhile, DropWhileEnd, Span, Break,-  StripPrefix,-  Group,-  Inits, Tails,--  -- ** Predicates-  IsPrefixOf, IsSuffixOf, IsInfixOf,--  -- * Searching lists--  -- ** Searching by equality-  Elem, NotElem, Lookup,--  -- ** Searching with a predicate-  Find, Filter, Partition,--  -- * Indexing lists-  type (!!), ElemIndex, ElemIndices, FindIndex, FindIndices,--  -- * Zipping and unzipping lists-  Zip, Zip3, Zip4, Zip5, Zip6, Zip7,-  ZipWith, ZipWith3, ZipWith4, ZipWith5, ZipWith6, ZipWith7,-  Unzip, Unzip3, Unzip4, Unzip5, Unzip6, Unzip7,--  -- * Special lists--  -- ** Functions on 'Symbol's-  Unlines, Unwords,--  -- ** \"Set\" operations-  Nub, Delete, type (\\), Union, Intersect,--  -- ** Ordered lists-  Sort, Insert,--  -- * Generalized functions--  -- ** The \"@By@\" operations-  -- *** User-supplied equality (replacing an @Eq@ context)-  NubBy, DeleteBy, DeleteFirstsBy, UnionBy, GroupBy, IntersectBy,--  -- *** User-supplied comparison (replacing an @Ord@ context)-  SortBy, InsertBy,-  MaximumBy, MinimumBy,--   -- ** The \"@generic@\" operations-  GenericLength, GenericTake, GenericDrop,-  GenericSplitAt, GenericIndex, GenericReplicate,--  -- * Defunctionalization symbols-  NilSym0,-  (:@#@$), (:@#@$$), (:@#@$$$),--  type (++@#@$$$), type (++@#@$$), type (++@#@$),-  HeadSym0, HeadSym1, LastSym0, LastSym1,-  TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1,--  MapSym0, MapSym1, MapSym2, ReverseSym0, ReverseSym1,-  IntersperseSym0, IntersperseSym1, IntersperseSym2,-  IntercalateSym0, IntercalateSym1, IntercalateSym2,-  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,--  ScanlSym0, ScanlSym1, ScanlSym2, ScanlSym3,-  Scanl1Sym0, Scanl1Sym1, Scanl1Sym2,-  ScanrSym0, ScanrSym1, ScanrSym2, ScanrSym3,-  Scanr1Sym0, Scanr1Sym1, Scanr1Sym2,--  MapAccumLSym0, MapAccumLSym1, MapAccumLSym2, MapAccumLSym3,-  MapAccumRSym0, MapAccumRSym1, MapAccumRSym2, MapAccumRSym3,--  UnfoldrSym0, UnfoldrSym1, UnfoldrSym2,--  InitsSym0, InitsSym1, TailsSym0, TailsSym1,--  IsPrefixOfSym0, IsPrefixOfSym1, IsPrefixOfSym2,-  IsSuffixOfSym0, IsSuffixOfSym1, IsSuffixOfSym2,-  IsInfixOfSym0, IsInfixOfSym1, IsInfixOfSym2,--  ElemSym0, ElemSym1, ElemSym2,-  NotElemSym0, NotElemSym1, NotElemSym2,--  ZipSym0, ZipSym1, ZipSym2,-  Zip3Sym0, Zip3Sym1, Zip3Sym2, Zip3Sym3,-  ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,-  ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4,-  UnzipSym0, UnzipSym1,-  Unzip3Sym0, Unzip3Sym1,-  Unzip4Sym0, Unzip4Sym1,-  Unzip5Sym0, Unzip5Sym1,-  Unzip6Sym0, Unzip6Sym1,-  Unzip7Sym0, Unzip7Sym1,--  DeleteSym0, DeleteSym1, DeleteSym2,-  type (\\@#@$), type (\\@#@$$), type (\\@#@$$$),-  IntersectSym0, IntersectSym1, IntersectSym2,--  InsertSym0, InsertSym1, InsertSym2,-  SortSym0, SortSym1,--  DeleteBySym0, DeleteBySym1, DeleteBySym2, DeleteBySym3,-  DeleteFirstsBySym0, DeleteFirstsBySym1, DeleteFirstsBySym2, DeleteFirstsBySym3,-  IntersectBySym0, IntersectBySym1, IntersectBySym2,--  SortBySym0, SortBySym1, SortBySym2,-  InsertBySym0, InsertBySym1, InsertBySym2, InsertBySym3,-  MaximumBySym0, MaximumBySym1, MaximumBySym2,-  MinimumBySym0, MinimumBySym1, MinimumBySym2,-  LengthSym0, LengthSym1,-  SumSym0, SumSym1, ProductSym0, ProductSym1,-  ReplicateSym0, ReplicateSym1, ReplicateSym2,-  TransposeSym0, TransposeSym1,-  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,-  MaximumSym0, MaximumSym1,-  MinimumSym0, MinimumSym1,-  GroupSym0, GroupSym1,-  GroupBySym0, GroupBySym1, GroupBySym2,-  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,--  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,--  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,--  UnlinesSym0, UnlinesSym1,-  UnwordsSym0, UnwordsSym1,--  NubSym0, NubSym1,-  NubBySym0, NubBySym1, NubBySym2,-  UnionSym0, UnionSym1, UnionSym2,-  UnionBySym0, UnionBySym1, UnionBySym2, UnionBySym3,--  GenericLengthSym0, GenericLengthSym1,-  GenericTakeSym0, GenericTakeSym1, GenericTakeSym2,-  GenericDropSym0, GenericDropSym1, GenericDropSym2,-  GenericSplitAtSym0, GenericSplitAtSym1, GenericSplitAtSym2,-  GenericIndexSym0, GenericIndexSym1, GenericIndexSym2,-  GenericReplicateSym0, GenericReplicateSym1, GenericReplicateSym2,--  ) where--import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.List-import Data.Singletons.Prelude.Maybe-import Data.Singletons.TH--$(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/Promotion/Prelude/List/NonEmpty.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.List.NonEmpty--- Copyright   :  (C) 2016 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines functions and datatypes relating to promoting 'NonEmpty',--- including promoted versions of many of the definitions in @Data.List.NonEmpty@.----------------------------------------------------------------------------------module Data.Promotion.Prelude.List.NonEmpty (--  -- * Non-empty stream transformations-  Map,-  Intersperse,-  Scanl,-  Scanr,-  Scanl1,-  Scanr1,-  Transpose,-  SortBy,-  SortWith,-  Length,-  Head,-  Tail,-  Last,-  Init,-  type (<|),-  Cons,-  Uncons,-  Unfoldr,-  Sort,-  Reverse,-  Inits,-  Tails,-  Unfold,-  Insert,-  Take,-  Drop,-  SplitAt,-  TakeWhile,-  DropWhile,-  Span,-  Break,-  Filter,-  Partition,-  Group,-  GroupBy,-  GroupWith,-  GroupAllWith,-  Group1,-  GroupBy1,-  GroupWith1,-  GroupAllWith1,-  IsPrefixOf,-  Nub,-  NubBy,-  type (!!),-  Zip,-  ZipWith,-  Unzip,-  FromList,-  ToList,-  NonEmpty_,-  Xor,--  -- * 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 Data.Singletons.Prelude.List.NonEmpty
− src/Data/Promotion/Prelude/Maybe.hs 
@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Maybe--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to 'Maybe',--- including a promoted 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.Promotion.Prelude.Maybe (-  -- * Promoted functions from @Data.Maybe@-  maybe_, Maybe_,-  -- | The preceding two definitions is derived from the function 'maybe' in-  -- @Data.Maybe@. The extra underscore is to avoid name clashes with the type-  -- 'Maybe'.--  IsJust, IsNothing, FromJust, FromMaybe, MaybeToList,-  ListToMaybe, CatMaybes, MapMaybe,--  -- * Defunctionalization symbols-  NothingSym0, JustSym0, JustSym1,--  Maybe_Sym0, Maybe_Sym1, Maybe_Sym2, Maybe_Sym3,-  IsJustSym0, IsJustSym1, IsNothingSym0, IsNothingSym1,-  FromJustSym0, FromJustSym1, FromMaybeSym0, FromMaybeSym1, FromMaybeSym2,-  MaybeToListSym0, MaybeToListSym1, ListToMaybeSym0, ListToMaybeSym1,-  CatMaybesSym0, CatMaybesSym1, MapMaybeSym0, MapMaybeSym1, MapMaybeSym2-  ) where--import Data.Singletons.Prelude.Maybe
− src/Data/Promotion/Prelude/Num.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Num--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines and exports promoted and singleton versions of definitions from--- GHC.Num.----------------------------------------------------------------------------------module Data.Promotion.Prelude.Num (-  PNum(..), Subtract,--  -- ** 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.Singletons.Prelude.Num-import Data.Singletons.TypeLits ()   -- for the Num instance!
− src/Data/Promotion/Prelude/Ord.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Ord--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Provides promoted definitions related to type-level comparisons.-----------------------------------------------------------------------------------module Data.Promotion.Prelude.Ord (-  POrd(..),--  Comparing,-  ThenCmp,--  -- ** 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-  ) where--import Data.Singletons.Prelude.Ord
− src/Data/Promotion/Prelude/Show.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Show--- 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------ Exports a promoted version of 'Show'-----------------------------------------------------------------------------------module Data.Promotion.Prelude.Show (-  PShow(..), SymbolS, SChar, show_, type (<>),-  Shows, ShowListWith, ShowChar, ShowString, ShowParen,-  ShowSpace, ShowCommaSpace, AppPrec, AppPrec1,--  -- * Defunctionalization symbols-  ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,-  Show_Sym0, Show_Sym1,-  ShowListSym0, ShowListSym1, ShowListSym2,-  type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),-  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.Singletons.Prelude.Show
− src/Data/Promotion/Prelude/Tuple.hs 
@@ -1,39 +0,0 @@--- |--- Module      :  Data.Promotion.Prelude.Tuple--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Jan Stolarek (jan.stolarek@p.lodz.pl)--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to tuples,--- including a promoted 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.Promotion.Prelude.Tuple (-  -- * Promoted functions from @Data.Tuple@-  Fst, Snd, Curry, Uncurry, Swap,--  -- * 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.Tuple
− src/Data/Promotion/Prelude/Void.hs 
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.Prelude.Void--- Copyright   :  (C) 2014 Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  jan.stolarek@p.lodz.pl--- Stability   :  experimental--- Portability :  non-portable------ Defines promoted functions and datatypes relating to 'Void',--- including a promoted 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.Promotion.Prelude.Void (-  -- * Promoted functions from from @Data.Void@-  Absurd,--  -- * Defunctionalization symbols-  AbsurdSym0, AbsurdSym1-  ) where--import Data.Singletons.Prelude.Void
− src/Data/Promotion/TH.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE ExplicitNamespaces #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Promotion.TH--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ This module contains everything you need to promote your own functions via--- Template Haskell.----------------------------------------------------------------------------------module Data.Promotion.TH (-  -- * Primary Template Haskell generation functions-  promote, promoteOnly, genDefunSymbols, genPromotions,--  -- ** Functions to generate @Eq@ instances-  promoteEqInstances, promoteEqInstance,--  -- ** Functions to generate @Ord@ instances-  promoteOrdInstances, promoteOrdInstance,--  -- ** Functions to generate @Bounded@ instances-  promoteBoundedInstances, promoteBoundedInstance,--  -- ** Functions to generate @Enum@ instances-  promoteEnumInstances, promoteEnumInstance,--  -- ** Functions to generate @Show@ instances-  promoteShowInstances, promoteShowInstance,--  -- ** defunctionalization-  TyFun, Apply, type (@@),--  -- * Auxiliary definitions-  -- | These definitions might be mentioned in code generated by Template Haskell,-  -- so they must be in scope.--  PEq(..), If, type (&&),-  POrd(..), ThenCmp, Foldl,-  PBounded(..),-  PEnum(FromEnum, ToEnum),-  PShow(..),-  ShowString, ShowParen, ShowSpace, ShowChar, ShowCommaSpace,-  (:.),-  Proxy(..),--  Error, ErrorSym0, ErrorSym1,-  Undefined, 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,-  type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),-  (:@#@$), (:@#@$$), (:@#@$$$),--  SuppressUnusedWarnings(..)-- ) where--import Data.Singletons.Internal-import Data.Singletons.Promote-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Show-import Data.Singletons.TypeLits-import Data.Singletons.SuppressUnusedWarnings
src/Data/Singletons.hs view
@@ -1,152 +1,1339 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeInType #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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.Promote-import Data.Singletons.Internal-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Num-import Data.Singletons.ShowSing----------------------------------------------------------------------------- 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)--instance ShowSing k => Show (SomeSing k) where-  showsPrec p (SomeSing s) =-    showParen (p > 10) $ showString "SomeSing " . showsSingPrec 11 s----------------------------------------------------------------------------- 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,145 +0,0 @@-{-# LANGUAGE DataKinds, TypeFamilies, KindSignatures, TemplateHaskell, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.CustomStar--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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 [] ctors-                         [DDerivClause Nothing (map DConPr [''Eq, ''Ord, ''Read, ''Show])]-  fakeCtors <- zipWithM (mkCtor False) names kinds-  let dataDecl = DataDecl Data repName [] fakeCtors-                          [DConPr ''Show, DConPr ''Read]-  -- 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) fakeCtors-  ordInst  <- mkOrdInstance Nothing (DConT repName) fakeCtors-  showInst <- mkShowInstance ForPromotion Nothing (DConT repName) fakeCtors-  (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 <- reifyWithWarning name-          dinfo <- dsInfo info-          case dinfo of-            DTyConI (DDataD _ (_:_) _ _ _ _) _ ->-               fail "Cannot make a representation of a constrainted data type"-            DTyConI (DDataD _ [] _ tvbs _ _) _ ->-               return $ map (fromMaybe DStarT . extractTvbKind) tvbs-            DTyConI (DTySynD _ tvbs _) _ ->-               return $ map (fromMaybe DStarT . extractTvbKind) tvbs-            DPrimTyConI _ n _ ->-               return $ replicate n DStarT-            _ -> 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))-                        Nothing-            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 n       `foldType` args-        kindToType args DArrowT      = return $ DArrowT       `foldType` args-        kindToType args k@(DLitT {}) = return $ k             `foldType` args-        kindToType args DWildCardT   = return $ DWildCardT    `foldType` args-        kindToType args DStarT       = return $ DConT repName `foldType` args
src/Data/Singletons/Decide.hs view
@@ -1,13 +1,22 @@-{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeOperators, TypeInType,-             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 -- Copyright   :  (C) 2013 Richard Eisenberg -- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)+-- Maintainer  :  Ryan Scott -- Stability   :  experimental -- Portability :  non-portable --@@ -20,11 +29,12 @@   SDecide(..),    -- * Supporting definitions-  (:~:)(..), Void, Refuted, Decision(..)+  (:~:)(..), Void, Refuted, Decision(..),+  decideEquality, decideCoercion   ) where  import Data.Kind-import Data.Singletons.Internal+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,57 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Bounded--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu--- 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 Control.Monad---- monadic only for failure and parallelism with other functions--- that make instances-mkBoundedInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl-mkBoundedInstance mb_ctxt ty 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_meths = [ (minBoundName, mk_rhs minRHS)-                                 , (maxBoundName, mk_rhs maxRHS) ] }
− src/Data/Singletons/Deriving/Enum.hs 
@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Enum--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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.Syntax-import Data.Singletons.Util-import Data.Singletons.Names-import Control.Monad-import Data.Maybe---- monadic for failure only-mkEnumInstance :: Quasi q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl-mkEnumInstance mb_ctxt ty cons = do-  when (null cons ||-        any (\(DCon tvbs cxt _ f rty) -> or [ not $ null $ tysOfConFields f-                                            , not $ null tvbs-                                            , not $ null cxt-                                            , isJust rty ]) 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_meths   = [ (singletonsToEnumName, to_enum)-                                  , (singletonsFromEnumName, from_enum) ] })
− src/Data/Singletons/Deriving/Infer.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Infer--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu--- 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 Data.Singletons.Util-import Data.List-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 mb_res_ty) = do-      let field_tys = tysOfConFields fields-      field_tys' <- case mb_res_ty of-                      Nothing -> pure field_tys-                      Just res_ty -> do-                        res_ty'  <- expandType res_ty-                        inst_ty' <- expandType inst_ty-                        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-      pure $ map (pr `DAppPr`) field_tys'---- 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,69 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Ord--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu--- 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.Syntax---- | Make a *non-singleton* Ord instance-mkOrdInstance :: DsMonad q => Maybe DCxt -> DType -> [DCon] -> q UInstDecl-mkOrdInstance mb_ctxt ty 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_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,205 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Deriving.Show--- Copyright   :  (C) 2017 Ryan Scott--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Implements deriving of Show instances---------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables #-}-module Data.Singletons.Deriving.Show (-    mkShowInstance-  , ShowMode(..)-  , mkShowContext-  ) 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.Maybe (fromMaybe)-import GHC.Lexeme (startsConSym, startsVarSym)-import GHC.Show (appPrec, appPrec1)--mkShowInstance :: DsMonad q-               => ShowMode -> Maybe DCxt -> DType -> [DCon]-               -> q UInstDecl-mkShowInstance mode mb_ctxt ty cons = do-  clauses <- mk_showsPrec mode cons-  constraints <- inferConstraintsDef (fmap (mkShowContext mode) mb_ctxt)-                                     (DConPr (mk_Show_name mode))-                                     ty cons-  return $ InstDecl { id_cxt = constraints-                    , id_name = mk_Show_name mode-                    , id_arg_tys = [ty]-                    , id_meths = [ (mk_showsPrec_name mode, UFunction clauses) ] }--mk_showsPrec :: DsMonad q => ShowMode -> [DCon] -> q [DClause]-mk_showsPrec mode 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 mode p) cons--mk_showsPrec_clause :: forall q. DsMonad q-                    => ShowMode -> Name -> DCon-                    -> q DClause-mk_showsPrec_clause mode p (DCon _ _ con_name con_fields _) = go con_fields-  where-    con_name' :: Name-    con_name' = case mode of-                  ForPromotion -> con_name-                  ForShowSing  -> singDataConName con_name--    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 tys@[_, _])-        -- Although the (:) constructor is infix, its singled counterpart SCons-        -- is not, which matters if we're deriving a ShowSing instance.-        -- Unless we remove this special case (see #234), we will simply-        -- shunt it along as if we were dealing with a prefix constructor.-      | ForShowSing <- mode-      , con_name == consName-      = go (DNormalC False tys)--      | otherwise-      = 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 mode (con_prec + 1) argL-                          `DAppE` (DVarE composeName-                                     `DAppE` infixOpE-                                     `DAppE` showsPrecE mode (con_prec + 1) argR))--    go (DNormalC _ tys) = do-      args <- mapM (const $ newUniqueName "arg") tys-      let show_args     = map (showsPrecE mode 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_name'    = case mode of-                                             ForPromotion -> arg_name-                                             ForShowSing  -> singValName arg_name-                            arg_nameBase = nameBase arg_name'-                            infix_rec    = showParen (isSym arg_nameBase)-                                                     (showString arg_nameBase) ""-                        in [ DVarE showStringName `DAppE` dStringE (infix_rec ++ " = ")-                           , showsPrecE mode 0 arg-                           , DVarE showCommaSpaceName-                           ])-                      (zip tys args)-          brace_comma_args =   (DVarE showCharName `DAppE` dCharE mode '{')-                             : take (length show_args - 1) show_args-          composed_args = foldr (\x y -> DVarE composeName `DAppE` x `DAppE` y)-                                (DVarE showCharName `DAppE` dCharE mode '}')-                                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 :: ShowMode -> Int -> Name -> DExp-showsPrecE mode prec n = DVarE (mk_showsPrec_name mode) `DAppE` dIntegerE prec `DAppE` DVarE n--dCharE :: ShowMode -> Char -> DExp-dCharE mode = DLitE . to_lit-  where-    to_lit :: Char -> Lit-    to_lit c = case mode of-                 ForPromotion -> StringL [c] -- There aren't type-level characters yet,-                                             -- so fake it with a string-                 ForShowSing  -> CharL c--dStringE :: String -> DExp-dStringE = DLitE . StringL--dIntegerE :: Int -> DExp-dIntegerE = DLitE . IntegerL . fromIntegral--isSym :: String -> Bool-isSym ""      = False-isSym (c : _) = startsVarSym c || startsConSym c---------- ShowMode---------- | Is a 'Show' instance being generated to be promoted/singled, or is it--- being generated to create a @ShowSing@/'Show' instance for a singleton type?-data ShowMode = ForPromotion -- ^ For promotion/singling-              | ForShowSing  -- ^ For a @ShowSing@/'Show' instance---- | Turn a context like @('Show' a, 'Show' b)@ into @('ShowSing' a, 'ShowSing' b)@.--- This is necessary for standalone-derived instances.-mkShowContext :: ShowMode -> DCxt -> DCxt-mkShowContext ForPromotion = id-mkShowContext ForShowSing  = map show_to_SingShow-  where-    show_to_SingShow :: DPred -> DPred-    show_to_SingShow = modifyConNameDPred $ \n ->-                         if n == showName-                            then showSingName-                            else n--mk_Show_name :: ShowMode -> Name-mk_Show_name ForPromotion = showName-mk_Show_name ForShowSing  = showSingName--mk_showsPrec_name :: ShowMode -> Name-mk_showsPrec_name ForPromotion = showsPrecName-mk_showsPrec_name ForShowSing  = showsSingPrecName
− src/Data/Singletons/Internal.hs 
@@ -1,428 +0,0 @@-{-# LANGUAGE MagicHash, RankNTypes, PolyKinds, GADTs, DataKinds,-             FlexibleContexts, FlexibleInstances,-             TypeFamilies, TypeOperators, TypeFamilyDependencies,-             UndecidableInstances, TypeInType, ConstraintKinds,-             ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes,-             PatternSynonyms, ViewPatterns #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Internal--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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-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 (a :: k)---- | 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 :: k) 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.-pattern Sing :: forall (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 :: *) | 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)--- @-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 (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 :: * -> * -> *---- | Something of kind `a ~> b` is a defunctionalized type function that is--- not necessarily generative or injective.-type a ~> b = TyFun a b -> *-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 (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 (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 @(KindOf a) @a)
− src/Data/Singletons/Names.hs 
@@ -1,336 +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.Monad--boolName, andName, tyEqName, compareName, minBoundName,-  maxBoundName, repName,-  nilName, consName, listName, tyFunName,-  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, showsSingPrecName,-  composeName, gtName, tyFromStringName, sFromStringName :: 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 = ''[]-tyFunName = ''TyFun-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"-showsSingPrecName = mk_name_v "Data.Singletons.ShowSing" "showsSingPrec"-composeName = '(.)-gtName = '(>)-showCommaSpaceName = 'showCommaSpace-tyFromStringName = mk_name_tc "Data.Singletons.Prelude.IsString" "FromString"-sFromStringName = mk_name_v "Data.Singletons.Prelude.IsString" "sFromString"--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 (!)]--    | 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)--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 = foldl DAppPr (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 (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,221 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Partition--- Copyright   :  (C) 2015 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu--- Stability   :  experimental--- Portability :  non-portable------ Partitions a list of declarations into its bits----------------------------------------------------------------------------------{-# 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.Show-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.List.NonEmpty (NonEmpty(..))-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_derived_eq_decs :: [DerivedEqDecl]-        , pd_derived_show_decs :: [DerivedShowDecl]-        }--instance Semigroup PartitionedDecs where-  PDecs a1 b1 c1 d1 e1 f1 <> PDecs a2 b2 c2 d2 e2 f2 =-    PDecs (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) (e1 <> e2) (f1 <> f2)--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 cons derivings) = do-  derived_decs-    <- mapM (\(strat, deriv_pred) -> partitionDeriving strat deriv_pred Nothing ty cons)-      $ concatMap flatten_clause derivings-  return $ mconcat $ data_dec : derived_decs-  where-    data_dec = mempty { pd_data_decs = [DataDecl nd name tvbs cons []] }-    ty = foldType (DConT name) (map tvbToType tvbs)--    flatten_clause :: DDerivClause -> [(Maybe DerivStrategy, DType)]-    flatten_clause (DDerivClause strat preds) =-      map (\p -> (strat, predToType p)) preds--partitionDec (DClassD cxt name tvbs fds decs) = do-  env <- concatMapM partitionClassDec decs-  return $ mempty { pd_class_decs = [ClassDecl { cd_cxt  = cxt-                                               , cd_name = name-                                               , cd_tvbs = tvbs-                                               , cd_fds  = fds-                                               , cd_lde  = env }] }-partitionDec (DInstanceD _ cxt ty decs) = do-  defns <- liftM catMaybes $ mapM 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_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 {})     = return mempty  -- ignore type synonyms;-                                               -- promotion is a no-op, and-                                               -- singling expands all syns-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 _ _ _ _ cons _) _) -> do-                partitionDeriving mb_strat cls_pred (Just ctxt) data_ty cons-              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-partitionClassDec (DLetDec (DSigD name ty)) = return $ typeBinding name ty-partitionClassDec (DLetDec (DValD (DVarPa name) exp)) =-  return $ valueBinding name (UValue exp)-partitionClassDec (DLetDec (DFunD name clauses)) =-  return $ valueBinding name (UFunction clauses)-partitionClassDec (DLetDec (DInfixD fixity name)) =-  return $ infixDecl fixity name-partitionClassDec (DLetDec (DPragmaD {})) = return mempty-partitionClassDec _ =-  fail "Only method declarations can be promoted within a class."--partitionInstanceDec :: Monad m => DDec -> m (Maybe (Name, ULetDecRHS))-partitionInstanceDec (DLetDec (DValD (DVarPa name) exp)) =-  return $ Just (name, UValue exp)-partitionInstanceDec (DLetDec (DFunD name clauses)) =-  return $ Just (name, UFunction clauses)-partitionInstanceDec (DLetDec (DPragmaD {})) = return Nothing-partitionInstanceDec _ =-  fail "Only method bodies can be promoted within an instance."--partitionDeriving :: DsMonad m => Maybe DerivStrategy -> DType -> Maybe DCxt -> DType -> [DCon]-                  -> m PartitionedDecs-partitionDeriving mb_strat deriv_pred mb_ctxt ty cons =-  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 AnyclassStrategy <- 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_meths   = [] }--       | Just NewtypeStrategy <- mb_strat-      -> do qReportWarning "GeneralizedNewtypeDeriving 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-       , deriv_name == ordName-      -> mk_derived_inst <$> mkOrdInstance mb_ctxt ty cons--       | stock_or_default-       , deriv_name == boundedName-      -> mk_derived_inst <$> mkBoundedInstance mb_ctxt ty cons--       | stock_or_default-       , deriv_name == enumName-      -> mk_derived_inst <$> mkEnumInstance mb_ctxt ty cons--         -- See Note [DerivedDecl] in Data.Singletons.Syntax-       | stock_or_default-       , deriv_name == eqName-      -> return $ mk_derived_eq_inst $ mk_derived_decl mb_ctxt ty cons--         -- See Note [DerivedDecl] in Data.Singletons.Syntax-       | stock_or_default-       , deriv_name == showName-      -> do -- This will become PShow/SShow instances...-            inst_for_promotion <- mkShowInstance ForPromotion mb_ctxt ty cons-            -- ...and this will become ShowSing/Show instances.-            let inst_for_ShowSing = mk_derived_decl mb_ctxt ty cons-            pure $ mempty { pd_instance_decs     = [inst_for_promotion]-                          , pd_derived_show_decs = [inst_for_ShowSing] }--         -- 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 StockStrategy <- 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_derived_inst    dec = mempty { pd_instance_decs   = [dec] }-      mk_derived_eq_inst dec = mempty { pd_derived_eq_decs = [dec] }-      mk_derived_decl mb_ctxt' ty' cons' = DerivedDecl { ded_mb_cxt = mb_ctxt'-                                                       , ded_type   = ty'-                                                       , ded_cons   = cons' }-      stock_or_default = isStockOrDefault mb_strat---- Is this being used with an explicit stock strategy, or no strategy at all?-isStockOrDefault :: Maybe DerivStrategy -> Bool-isStockOrDefault Nothing              = True-isStockOrDefault (Just StockStrategy) = True-isStockOrDefault (Just _)             = False
− src/Data/Singletons/Prelude.hs 
@@ -1,205 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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,-  Undefined, sUndefined,--  -- * Singleton equality-  module Data.Singletons.Prelude.Eq,--  -- * Singleton comparisons-  module Data.Singletons.Prelude.Ord,--  -- * 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, type (<>), (%<>),-  Shows, sShows, ShowChar, sShowChar, ShowString, sShowString, ShowParen, sShowParen,--  -- ** Miscellaneous functions-  Id, sId, Const, sConst, (:.), (%.), type ($), (%$), type ($!), (%$!),-  Flip, sFlip, AsTypeOf, sAsTypeOf,-  Seq, sSeq,--  -- * List operations-  Map, sMap, type (++), (%++), Head, sHead, Last, sLast, Tail, sTail,-  Init, sInit, Null, sNull, Reverse, sReverse,-  -- ** Reducing lists (folds)-  Foldl, sFoldl, Foldl1, sFoldl1, Foldr, sFoldr, Foldr1, sFoldr1,-  -- *** 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-  Elem, sElem, 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, UndefinedSym0,--  type (^@#@$), type (^@#@$$), type (^@#@$$$),--  ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,-  Show_Sym0, Show_Sym1,-  ShowListSym0, ShowListSym1, ShowListSym2,-  type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),-  ShowsSym0, ShowsSym1, ShowsSym2,-  ShowCharSym0, ShowCharSym1, ShowCharSym2,-  ShowStringSym0, ShowStringSym1, ShowStringSym2,-  ShowParenSym0, ShowParenSym1, ShowParenSym2,--  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 (++@#@$), HeadSym0, HeadSym1, LastSym0, LastSym1,-  TailSym0, TailSym1, InitSym0, InitSym1, NullSym0, NullSym1,--  FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,-  Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,-  FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,-  Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,--  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,--  ElemSym0, ElemSym1, ElemSym2,-  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.Base-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Either-import Data.Singletons.Prelude.List-import Data.Singletons.Prelude.Maybe-import Data.Singletons.Prelude.Tuple-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Enum-  hiding (Succ, Pred, SuccSym0, SuccSym1, PredSym0, PredSym1, sSucc, sPred)-import Data.Singletons.Prelude.Num-import Data.Singletons.Prelude.Show-import Data.Singletons.TypeLits
− src/Data/Singletons/Prelude/Base.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE TemplateHaskell, KindSignatures, PolyKinds, TypeOperators,-             DataKinds, 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 ($!), (%$), (%$!),-  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 ($!@#@$$$),-  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 $!--  -- 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`- |])
− src/Data/Singletons/Prelude/Bool.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, TypeFamilies, TypeOperators,-             GADTs, ScopedTypeVariables, DeriveDataTypeable, UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Bool--- Copyright   :  (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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 [''(&&)])---- | Disjunction of singletons-(%||) :: Sing a -> Sing b -> Sing (a || b)-SFalse %|| a = a-STrue  %|| _ = STrue-infixr 2 %||-$(genDefunSymbols [''(||)])---- | Negation of a singleton-sNot :: Sing a -> Sing (Not a)-sNot SFalse = STrue-sNot STrue  = SFalse-$(genDefunSymbols [''Not])---- | 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/Either.hs 
@@ -1,112 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, GADTs,-             DataKinds, PolyKinds, RankNTypes, UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Either--- Copyright   :  (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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.TH-import Data.Singletons.Prelude.Base---- 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, TypeInType,-             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,63 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TypeInType,-             RankNTypes, FlexibleContexts, TemplateHaskell,-             UndecidableInstances, GADTs, DefaultSignatures #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Eq--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Defines the SEq singleton version of the Eq type class.-----------------------------------------------------------------------------------module Data.Singletons.Prelude.Eq (-  PEq(..), SEq(..),-  type (==@#@$), type (==@#@$$), type (==@#@$$$),-  type (/=@#@$), type (/=@#@$$), type (/=@#@$$$)-  ) where--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 Data.Type.Equality.==---- | The promoted analogue of 'Eq'. If you supply no definition for '(==)',--- then it defaults to a use of '(DTE.==)', from "Data.Type.Equality".-class PEq a where-  type (==) (x :: a) (y :: a) :: Bool-  type (/=) (x :: a) (y :: a) :: Bool--  type (x :: a) == (y :: a) = x DTE.== y-  type (x :: a) /= (y :: a) = Not (x == y)--infix 4 ==-infix 4 /=--$(genDefunSymbols [''(==), ''(/=)])---- | 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)
− src/Data/Singletons/Prelude/Function.hs 
@@ -1,115 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Function--- Copyright   :  (C) 2016 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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, TypeInType, TypeFamilies,-             TypeOperators, UndecidableInstances, GADTs #-}--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 &-  |])
− 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 RankNTypes, TypeInType, 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,43 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.IsString--- Copyright   :  (C) 2017 Ryan Scott--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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.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-  |])---- 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,818 +0,0 @@-{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, TypeInType,-             TemplateHaskell, GADTs, UndecidableInstances, RankNTypes,-             ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-}-{-# OPTIONS_GHC -O0 #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.List--- Copyright   :  (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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, 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, ZipWith, sZipWith, ZipWith3, sZipWith3,-  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,--  -- * 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,-  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,-  ZipWithSym0, ZipWithSym1, ZipWithSym2, ZipWithSym3,-  ZipWith3Sym0, ZipWith3Sym1, ZipWith3Sym2, ZipWith3Sym3, ZipWith3Sym4,-  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-  ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Instances-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.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 list comprehensions, 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--  -- Relies on intersectBy, which does not singletonize-  intersect               :: (Eq a) => [a] -> [a] -> [a]-  intersect               =  intersectBy (==)---- Uses list comprehensions.---  intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]---  intersectBy _  [] []    =  []---  intersectBy _  [] (_:_) =  []---  intersectBy _  (_:_) [] =  []---  intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]--  intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]-  intersectBy _  []       []       =  []-  intersectBy _  []       (_:_)    =  []-  intersectBy _  (_:_)    []       =  []-  intersectBy eq xs@(_:_) ys@(_:_) =  filter (\x -> any (eq x) ys) xs--  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 list comprehensions---  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--  |])
− src/Data/Singletons/Prelude/List/NonEmpty.hs 
@@ -1,555 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, TypeOperators,-             TypeFamilies, GADTs, UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.List.NonEmpty--- Copyright   :  (C) 2016 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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 Data.List.NonEmpty-import Data.Singletons.Prelude.List.NonEmpty.Internal-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.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)--  -- | @since 4.9.0.0-  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/List/NonEmpty/Internal.hs 
@@ -1,133 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.List.NonEmpty.Internal--- Copyright   :  (C) 2016 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ Renames a bunch of List functions because singletons can't support qualified--- names. :(----------------------------------------------------------------------------------{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, TypeFamilies,-             UndecidableInstances, GADTs #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-}--module Data.Singletons.Prelude.List.NonEmpty.Internal where--import Data.Singletons.Single-import Data.Singletons.Prelude.List-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-  |])--$(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/Maybe.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeFamilies, TypeInType,-             DataKinds, PolyKinds, UndecidableInstances, GADTs, RankNTypes #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Maybe--- Copyright   :  (C) 2013-2014 Richard Eisenberg, Jan Stolarek--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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/Num.hs 
@@ -1,128 +0,0 @@-{-# LANGUAGE TemplateHaskell, PolyKinds, DataKinds, TypeFamilies, TypeInType,-             TypeOperators, GADTs, ScopedTypeVariables, UndecidableInstances,-             DefaultSignatures, FlexibleContexts-  #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Num--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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.Singletons.Single-import Data.Singletons.Internal-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-  |])---- 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,94 +0,0 @@-{-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, ScopedTypeVariables,-             TypeFamilies, TypeOperators, GADTs, UndecidableInstances,-             FlexibleContexts, DefaultSignatures, InstanceSigs, TypeInType #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Ord--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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),--  -- ** 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-  ) where--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)-  |])--$(singletons [d|-  thenCmp :: Ordering -> Ordering -> Ordering-  thenCmp EQ x = x-  thenCmp LT _ = LT-  thenCmp GT _ = GT-  |])--$(singOrdInstances basicTypes)
− src/Data/Singletons/Prelude/Show.hs 
@@ -1,194 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Show--- Copyright   :  (C) 2017 Ryan Scott--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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_,-  type (<>), (%<>),-  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,-  type (<>@#@$), type (<>@#@$$), type (<>@#@$$$),-  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.Proxy-import           Data.Singletons.Internal-import           Data.Singletons.Prelude.Base-import           Data.Singletons.Prelude.Instances-import           Data.Singletons.Prelude.List-import           Data.Singletons.Prelude.Ord-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-  |])--$(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)-  |])---- | Note that this instance is really, really slow, since it uses an inefficient,--- inductive definition of division behind the hood.-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/Tuple.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DataKinds, PolyKinds,-             RankNTypes, TypeFamilies, GADTs, UndecidableInstances, TypeInType #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Tuple--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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,54 +0,0 @@-{-# LANGUAGE EmptyCase #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.Prelude.Void--- Copyright   :  (C) 2017 Ryan Scott--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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,739 +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.Partition-import Data.Singletons.Util-import Data.Singletons.Syntax-import Prelude hiding (exp)-import Control.Applicative (Alternative(..))-import Control.Monad-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Trans.Maybe-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-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 reifyWithWarning 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 family-genDefunSymbols :: DsMonad q => [Name] -> q [Dec]-genDefunSymbols names = do-  checkForRep names-  infos <- mapM (dsInfo <=< reifyWithWarning) 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 ForPromotion) "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-  cons' <- concatMapM dsCon cons-  tvbs' <- mapM dsTvb tvbs-  kind <- promoteType (foldType (DConT name) (map tvbToType tvbs'))-  inst_decs <- mkEqTypeInstance kind cons'-  return $ decsToTH inst_decs--promoteInstance :: DsMonad q => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl)-                -> 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-  cons' <- concatMapM dsCon cons-  tvbs' <- mapM dsTvb tvbs-  raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType tvbs')) cons'-  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) :: TyFun 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_derived_eq_decs   = derived_eq_decs } <- partitionDecs decls--    -- promoteLetDecs returns LetBinds, which we don't need at top level-  _ <- promoteLetDecs noPrefix let_decs-  mapM_ promoteClassDec classes-  let all_meth_sigs = foldMap (lde_types . cd_lde) classes-  mapM_ (promoteInstanceDec all_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 _nd data_name tvbs cons _derivings) =-      let arg_ty = foldType (DConT data_name)-                            (map tvbToType 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 _nd name tvbs ctors _derivings) = do-  ctorSyms <- buildDefunSymsDataD name tvbs 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 TypeInType 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]-    cuskify :: DTyVarBndr -> DTyVarBndr-    cuskify (DPlainTV tvname) = DKindedTV tvname DStarT-    cuskify tv                = tv-    tvbs = map cuskify tvbs'-  let pClsName = promoteClassName cls_name-  pCxt <- mapM promote_superclass_pred cxt-  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 Nothing meth_sigs) defaults_list--  let infix_decls' = catMaybes $ map (uncurry promoteInfixDecl) 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-  return (decl { cd_lde = lde { lde_defns = Map.fromList defaults_list'-                              , lde_proms = Map.fromList proms } })-  where-    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-      emitDecsM $ defunctionalize proName (map Just argKs) (Just resK)--      return $ DOpenTypeFamilyD (DTypeFamilyHead proName-                                                 (zipWith DKindedTV args argKs)-                                                 (DKindSig resK)-                                                 Nothing)--    promote_superclass_pred :: DPred -> PrM DPred-    promote_superclass_pred = go-      where-      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 meth_sigs-                   decl@(InstDecl { id_name     = cls_name-                                  , id_arg_tys  = inst_tys-                                  , id_meths    = meths }) = do-  cls_tvb_names <- lookup_cls_tvb_names-  inst_kis <- mapM promoteType inst_tys-  let subst = Map.fromList $ zip cls_tvb_names inst_kis-  (meths', ann_rhss, _) <- mapAndUnzip3M (promoteMethod (Just subst) 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 :: 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 m_subst sigs_map (meth_name, meth_rhs) = do-  (arg_kis, res_ki) <- lookup_meth_ty-  ((_, _, _, eqns), _defuns, ann_rhs)-    <- promoteLetDecRHS (Just (arg_kis, res_ki)) sigs_map noPrefix meth_name meth_rhs-  meth_arg_tvs <- mapM (const $ qNewName "a") arg_kis-  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-      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-  emitDecs [DClosedTypeFamilyD (DTypeFamilyHead-                                  helperName-                                  (zipWith DKindedTV meth_arg_tvs meth_arg_kis')-                                  (DKindSig meth_res_ki')-                                  Nothing)-                               eqns]-  emitDecsM (defunctionalize helperName (map Just meth_arg_kis') (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 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--    default_to_star Nothing  = DStarT-    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 = infix_decls }) = do-  let infix_decls'  = catMaybes $ map (uncurry promoteInfixDecl) infix_decls--    -- 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 prefixes) names rhss--  emitDecs $ concat defun_decss-  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 = infix_decls-                               , lde_proms = Map.empty }  -- filled in promoteLetDecs--  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 :: Fixity -> Name -> Maybe DDec-promoteInfixDecl fixity name- | isDataConName name || not (isHsLetter (head (nameBase name)))- = Nothing -- No need to promote fixity declarations for constructor names or-           -- infix names, as those fixity declarations apply to both-           -- the value and type namespaces.- | otherwise- = Just $ DLetDec $ DInfixD fixity (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-                 -> (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 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-      (exp', ann_exp) <- promoteExp exp-      let proName = promoteValNameLhsPrefix prefixes name-      defuns <- defunctionalize proName (map (const Nothing) all_locals) res_kind-      return ( ( proName, map DPlainTV all_locals, 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 prefixes name-                       (UFunction [DClause pats (foldExp exp newArgs)])--promoteLetDecRHS m_rhs_ki type_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-  all_locals <- allLocals-  defun_decs <- defunctionalize proName-                (map (const Nothing) all_locals ++ m_argKs) m_resK-  let local_tvbs = map DPlainTV all_locals-  tyvarNames <- mapM (const $ qNewName "a") m_argKs-  expClauses <- mapM (etaExpand (ty_num_args - numArgs)) clauses-  (eqns, ann_clauses) <- mapAndUnzipM promoteClause expClauses-  prom_fun <- lookupVarE name-  let args     = zipWith inferMaybeKindTV tyvarNames m_argKs-      all_args = local_tvbs ++ args-  return ( (proName, all_args, m_resK, eqns)-         , defun_decs-         , AFunction prom_fun ty_num_args ann_clauses )--  where-    etaExpand :: Int -> DClause -> PrM DClause-    etaExpand n (DClause pats exp) = do-      names <- replicateM n (newUniqueName "a")-      let newPats = map DVarPa names-          newArgs = map DVarE  names-      return $ DClause (pats ++ newPats) (foldExp exp newArgs)--    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, new_vars) <- evalForPair $ mapM promotePat pats-  (ty, ann_exp) <- 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, new_vars) <- evalForPair $ promotePat pat-  (rhs, ann_exp) <- 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 VarPromotions PrM DType-promotePat (DLitPa lit) = do-  lit' <- promoteLitPat lit-  return lit'-promotePat (DVarPa name) = do-      -- term vars can be symbols... type vars can't!-  tyName <- mkTyName name-  addElement (name, tyName)-  return $ DVarT tyName-promotePat (DConPa name pats) = do-  types <- mapM promotePat pats-  let name' = unboxed_tuple_to_tuple name-  return $ foldType (DConT name') types-  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"-  promotePat pat-promotePat (DBangPa pat) = do-  qReportWarning "Strict pattern converted into regular pattern in promotion"-  promotePat pat-promotePat (DSigPa pat ty) = do-  promoted <- promotePat pat-  ki <- promoteType ty-  return $ DSigT promoted ki-promotePat DWildPa = return DWildCardT--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 (map (const Nothing) all_args) 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 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_cons = cons }) = do-  kind <- promoteType ty-  inst_decs <- mkEqTypeInstance kind cons-  emitDecs inst_decs
− src/Data/Singletons/Promote/Defun.hs 
@@ -1,194 +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.Util-import Control.Monad--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"--buildDefunSyms :: DDec -> PrM [DDec]-buildDefunSyms (DDataD _new_or_data _cxt tyName tvbs ctors _derivings) =-  buildDefunSymsDataD tyName tvbs ctors-buildDefunSyms (DClosedTypeFamilyD (DTypeFamilyHead name tvbs result_sig _) _) = do-  let arg_m_kinds = map extractTvbKind tvbs-  defunctionalize name arg_m_kinds (resultSigToMaybeKind result_sig)-buildDefunSyms (DOpenTypeFamilyD (DTypeFamilyHead name tvbs result_sig _)) = do-  let arg_kinds = map (default_to_star . extractTvbKind) tvbs-      res_kind  = default_to_star (resultSigToMaybeKind result_sig)-      default_to_star Nothing  = Just DStarT-      default_to_star (Just k) = Just k-  defunctionalize name arg_kinds res_kind-buildDefunSyms (DTySynD name tvbs _type) = do-  let arg_m_kinds = map extractTvbKind tvbs-  defunctionalize name arg_m_kinds Nothing-buildDefunSyms (DClassD _cxt name tvbs _fundeps _members) = do-  let arg_m_kinds = map extractTvbKind tvbs-  defunctionalize name arg_m_kinds (Just (DConT constraintName))-buildDefunSyms _ = fail $ "Defunctionalization symbols can only be built for " ++-                          "type families and data declarations"--buildDefunSymsDataD :: Name -> [DTyVarBndr] -> [DCon] -> PrM [DDec]-buildDefunSymsDataD tyName tvbs ctors = do-  let res_ty = foldType (DConT tyName) (map tvbToType tvbs)-  res_ki <- promoteType res_ty-  concatMapM (promoteCtor res_ki) ctors-  where-    promoteCtor :: DKind -> DCon -> PrM [DDec]-    promoteCtor promotedKind ctor = do-      let (name, arg_tys) = extractNameTypes ctor-      arg_kis <- mapM promoteType arg_tys-      defunctionalize name (map Just arg_kis) (Just promotedKind)---- 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.-defunctionalize :: Name -> [Maybe DKind] -> Maybe DKind -> PrM [DDec]-defunctionalize name m_arg_kinds' m_res_kind' = do-  let (m_arg_kinds, m_res_kind) = eta_expand (noExactTyVars m_arg_kinds')-                                             (noExactTyVars m_res_kind')-      num_args = length m_arg_kinds-      sat_name = promoteTySym name num_args-  tvbNames <- replicateM num_args $ qNewName "t"-  let  mk_rhs ns = foldType (DConT name) (map DVarT ns)-       sat_dec   = DTySynD sat_name (zipWith mk_tvb tvbNames m_arg_kinds) (mk_rhs tvbNames)-  other_decs <- go (num_args - 1) (reverse m_arg_kinds) 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 :: [Maybe DKind] -> Maybe DKind -> ([Maybe DKind], Maybe DKind)-    eta_expand m_arg_kinds Nothing = (m_arg_kinds, Nothing)-    eta_expand m_arg_kinds (Just res_kind) =-        let (_, _, argKs, resultK) = unravel res_kind-        in (m_arg_kinds ++ (map Just argKs), Just resultK)--    go :: Int -> [Maybe DKind] -> Maybe DKind-       -> ([Name] -> DType)  -- given the argument names, the RHS of the Apply instance-       -> PrM [DDec]-    go _ [] _ _ = return []-    go n (m_arg : m_args) m_result mk_rhs = do-      fst_name : rest_names <- replicateM (n + 1) (qNewName "l")-      extra_name <- qNewName "arg"-      let data_name   = promoteTySym name n-          next_name   = promoteTySym name (n+1)-          con_name    = prefixName "" ":" $ suffixName "KindInference" "###" data_name-          m_tyfun     = buildTyFun_maybe m_arg m_result-          arg_params  = zipWith mk_tvb rest_names (reverse m_args)-          tyfun_param = mk_tvb fst_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 [DPlainTV extra_name]-                             [con_eq_ct]-                             con_name-                             (DNormalC False [])-                             Nothing-          data_decl   = DDataD Data [] data_name params [con_decl] []-          app_eqn     = DTySynEqn [ foldType (DConT data_name)-                                             (map DVarT rest_names)-                                  , DVarT fst_name ]-                                  (mk_rhs (rest_names ++ [fst_name]))-          app_decl    = DTySynInstD applyName app_eqn-          suppress    = DInstanceD Nothing []-                          (DConT suppressClassName `DAppT` DConT data_name)-                          [DLetDec $ DFunD suppressMethodName-                                           [DClause []-                                                    ((DVarE 'snd) `DAppE`-                                                     mkTupleDExp [DConE con_name,-                                                                  mkTupleDExp []])]]--          mk_rhs' ns  = foldType (DConT data_name) (map DVarT ns)--      decls <- go (n - 1) m_args (addStar_maybe (buildTyFun_maybe m_arg m_result)) mk_rhs'-      return $ suppress : data_decl : app_decl : decls--buildTyFun :: DKind -> DKind -> DKind-buildTyFun k1 k2 = DConT tyFunName `DAppT` k1 `DAppT` k2--buildTyFun_maybe :: Maybe DKind -> Maybe DKind -> Maybe DKind-buildTyFun_maybe m_k1 m_k2 = do-  k1 <- m_k1-  k2 <- m_k2-  return $ DConT tyFunName `DAppT` k1 `DAppT` k2---- Counts the arity of type level function represented with TyFun constructors-tyFunArity :: DKind -> Int-tyFunArity (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` b) `DAppT` DStarT)-  | tyFunName == tyFunNm-  = 1 + tyFunArity b-tyFunArity _ = 0---- Checks if type is (TyFun a b -> *)-isTyFun :: DKind -> Bool-isTyFun (DArrowT `DAppT` (DConT tyFunNm `DAppT` _ `DAppT` _) `DAppT` DStarT)-  | tyFunName == tyFunNm-  = True-isTyFun _ = False---- Build TyFun kind from the list of kinds-ravelTyFun :: [DKind] -> DKind-ravelTyFun []    = error "Internal error: TyFun raveling nil"-ravelTyFun [k]   = k-ravelTyFun kinds = go tailK (buildTyFun k2 k1)-    where (k1 : k2 : tailK) = reverse kinds-          go []     acc = addStar acc-          go (k:ks) acc = go ks (buildTyFun k (addStar acc))
− 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,113 +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-  ) where--import Control.Monad.Reader-import Control.Monad.Writer-import qualified Data.Map.Strict as Map-import Data.Map.Strict ( Map )-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_local_decls  :: [Dec]-        }--emptyPrEnv :: PrEnv-emptyPrEnv = PrEnv { pr_lambda_bound = Map.empty-                   , pr_let_bound    = Map.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--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
− src/Data/Singletons/Promote/Type.hs 
@@ -1,65 +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 DStarT-      | name == stringName                = return $ DConT symbolName-      | nameBase name == nameBase repName = return DStarT-    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 $ addStar (DConT tyFunName `DAppT` k1 `DAppT` k2)-    go _ (DLitT _) = fail "Cannot promote a type-level literal"--    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,117 +1,319 @@-{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeInType #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE QuantifiedConstraints #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +#if __GLASGOW_HASKELL__ >= 810+{-# LANGUAGE StandaloneKindSignatures #-}+#endif+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Singletons.ShowSing -- Copyright   :  (C) 2017 Ryan Scott -- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)+-- Maintainer  :  Ryan Scott -- Stability   :  experimental -- Portability :  non-portable ----- Defines the class 'ShowSing', allowing for conversion of 'Sing' values to--- readable 'String's.+-- 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 (-  -- * The 'ShowSing' class-  ShowSing(..),-  ) where--import Data.Singletons.Internal-import Data.Singletons.Prelude.Instances-import Data.Singletons.Single-import Data.Singletons.TypeLits.Internal-import Data.Singletons.Util+#if __GLASGOW_HASKELL__ >= 806+  -- * The 'ShowSing' type+  ShowSing, -import GHC.Show (appPrec, appPrec1)-import GHC.TypeLits (symbolVal)-import qualified GHC.TypeNats as TN (natVal)+  -- * Internal utilities+  ShowSing'+#endif+  ) where ---------------------------------------------------------------------------- ShowSing -------------------------------------------------------------------------------------------------------------------------------+#if __GLASGOW_HASKELL__ >= 806+import Data.Kind+import Data.Singletons+import Text.Show --- | Members of the 'ShowSing' kind class can have their 'Sing' values--- converted to 'String's in a fashion similar to that of the 'Show' class.--- (In fact, this class only exists because one cannot write 'Show' instances--- for 'Sing's of the form--- @instance (forall z. Show (Sing (z :: k))) => Show (Sing (x :: [k]))@.)+-- | In addition to the promoted and singled versions of the 'Show' class that+-- @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+-- that's where 'ShowSing' comes into play. ----- This class should not be confused with the promoted or singled versions of--- 'Show' from "Data.Singletons.Prelude.Show" (@PShow@ and @SShow@, respectively).--- The output of 'ShowSing' is intended to reflect the singleton type, whereas--- the output of @PShow@ and @SShow@ reflects the original type. That is, showing--- @SFalse@ with 'ShowSing' would yield @\"SFalse\"@, whereas @PShow@ and @SShow@--- would yield @\"False\"@.+-- As an example, let's consider the singleton type for lists. We want to write+-- an instance with the following shape: ----- Instances of this class are generated alongside singleton definitions for--- datatypes that derive a 'Show' instance. Moreover, having a 'ShowSing'--- instances makes it simple to define a 'Show' instance. For instance:+-- @+-- 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+-- 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@.+-- This lets us write something closer to this:+-- -- @--- instance 'ShowSing' a => 'ShowSing' [a] where---   'showsSingPrec' = ...--- instance 'ShowSing' a => 'Show' ('Sing' (x :: [a])) where---   'showsPrec' = 'showsSingPrec'+-- instance (forall a. 'Show' ('Sing' (a :: k))) => 'SList' ('Sing' (z :: [k])) where ... -- @ ----- As a result, singleton definitions for datatypes that derive a 'Show'--- instance also get a 'Show' instance for the singleton type as well--- (in addition to promoted and singled 'Show' instances).+-- The 'ShowSing' class is a thin wrapper around+-- @(forall a. 'Show' ('Sing' (a :: k)))@. With 'ShowSing', our final instance+-- declaration becomes this: ----- To recap: 'singletons' will give you all of these for a datatype that derives--- a 'Show' instance:+-- @+-- instance 'ShowSing' k => 'Show' ('SList' (z :: [k])) where ...+-- @ --+-- 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-th@ a derived 'Show' instance, then+-- you'll receive the following in return:+-- -- * A promoted (@PShow@) instance -- * A singled (@SShow@) instance--- * A 'ShowSing' instance for the singleton type -- * A 'Show' instance for the singleton type -- -- What a bargain!-class ShowSing k where-  -- | @'showsSingPrec' p s@ convert a 'Sing' value @p@ to a readable 'String'-  -- with precedence @p@.-  showsSingPrec :: Int -> Sing (a :: k) -> ShowS ---------------------------------------------------------------- TypeLits instances-------------------------------------------------------------+-- 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) --- 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.)+-- | 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) -instance ShowSing Nat where-  showsSingPrec p n@SNat-    = showParen (p > appPrec)-      ( showString "SNat @"-        . showsPrec appPrec1 (TN.natVal n)-      )-instance Show (SNat n) where-  showsPrec = showsSingPrec+{-+Note [Define ShowSing as a class, not a type synonym]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In an ideal world, we would simply define ShowSing like this: -instance ShowSing Symbol where-  showsSingPrec p s@SSym-    = showParen (p > appPrec)-      ( showString "SSym @"-        . showsPrec appPrec1 (symbolVal s)-      )-instance Show (SSymbol s) where-  showsPrec = showsSingPrec+  type ShowSing k = (forall (z :: k). ShowSing' z) :: Constraint) +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.+Consider the following example (from #371):++  $(singletons [d|+    data X a = X1 | X2 (Y a) deriving Show+    data Y a = Y1 | Y2 (X a) deriving Show+    |])++This will generate the following instances:++  deriving instance ShowSing (Y a) => Show (Sing (z :: X a))+  deriving instance ShowSing (X a) => Show (Sing (z :: Y a))++So far, so good. Now, suppose you try to actually `show` a singleton for X.+For example:++  show (sing @(X1 :: X Bool))++Somewhat surprisingly, this will be rejected by the typechecker with the+following error:++    • Reduction stack overflow; size = 201+      When simplifying the following type: Show (Sing z)++To see why this happens, observe what goes on if we expand the occurrences of+the ShowSing type synonym in the generated instances:++  deriving instance (forall z. 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 `ShowSing' (X1 :: X Bool)` constraint, it+chooses the appropriate instance and emits a Wanted+`forall z. ShowSing' (z :: Y Bool)` constraint (from the instance context).+GHC skolemizes the `z` to `z1` and tries to solve a Wanted+`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+`ShowSing' (z2 :: X Bool)` constraint... we repeat the process and find+ourselves in an infinite loop that eventually overflows the reduction stack.+Eep.++Until Trac #15888 is fixed, there are two possible ways to work around this+problem:++1. Make derived instances' type inference more clever. If you look closely,+   you'll notice that the `ShowSing (X a)`/`ShowSing (Y a)` constraints in+   the generated instances are entirely redundant and could safely be left+   off. But determining this would require significantly improving singletons-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+   synonym. `ShowSing`-as-a-class ties the recursive knot during instance+   resolution and thus avoids the problems that the type synonym version+   currently suffers from.++Given the two options, (2) is by far the easier option, so that is what we+ultimately went with.+-}+ --------------------------------------------------------------- Template Haskell-generated instances+-- (S)WrappedSing instances ------------------------------------------------------------ -$(showSingInstances basicTypes)+-- 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)++showsWrappedSingPrec :: ShowSing k => Int -> WrappedSing (a :: k) -> ShowS+showsWrappedSingPrec p (WrapSing s) = showParen (p >= 11) $+  showString "WrapSing {unwrapSing = " . showsPrec 0 s . showChar '}'++deriving instance ShowSing k => Show (SWrappedSing (ws :: WrappedSing (a :: k)))+#endif
src/Data/Singletons/Sigma.hs view
@@ -1,17 +1,36 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# 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 -- Copyright   :  (C) 2017 Ryan Scott -- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)+-- Maintainer  :  Ryan Scott -- Stability   :  experimental -- Portability :  non-portable --@@ -20,38 +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++#if __GLASGOW_HASKELL__ >= 806+      -- * Internal utilities+      -- $internalutilities+    , ShowApply,  ShowSingApply+    , ShowApply', ShowSingApply'+#endif     ) where  import Data.Kind-import Data.Singletons.Internal+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--- We can't define defunctionalization symbols for this at the moment due--- to #216+#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 @@ -66,3 +162,87 @@          -> Sigma a p -> Sigma b q -> Sigma c r zipSigma f g ((a :: Sing (fstA :: a)) :&: p) ((b :: Sing (fstB :: b)) :&: q) =   (f @@ a @@ b) :&: (g @fstA @fstB p q)++-- | 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,682 +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 (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.Util-import Data.Singletons.Promote-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.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 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 <=< reifyWithWarning) 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-  singDecs <- wrapDesugar singTopLevelDecs decs-  return (decs ++ 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-  dcons <- concatMapM dsCon 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 ForPromotion) "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 'ShowSing' for the given type------ (Not to be confused with 'singShowInstance'.)---- (We can't simply use singInstance to create ShowSing instances, because--- there's no promoted counterpart. So we use this instead.)-showSingInstance :: DsMonad q => Name -> q [Dec]-showSingInstance name = do-  (tvbs, cons) <- getDataD ("I cannot make an instance of ShowSing for it.") name-  dtvbs <- mapM dsTvb tvbs-  dcons <- concatMapM dsCon cons-  let tyvars = map (DVarT . extractTvbName) dtvbs-      kind = foldType (DConT name) tyvars-      deriv_show_decl = DerivedDecl { ded_mb_cxt = Nothing-                                    , ded_type   = kind-                                    , ded_cons   = dcons }-  (show_insts, _) <- singM [] $ singDerivedShowDecs deriv_show_decl-  pure $ decsToTH show_insts---- | Create instances of 'ShowSing' for the given types------ (Not to be confused with 'singShowInstances'.)-showSingInstances :: DsMonad q => [Name] -> q [Dec]-showSingInstances = concatMapM showSingInstance--singInstance :: DsMonad q-             => (Maybe DCxt -> DType -> [DCon] -> q UInstDecl)-             -> 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-  dcons <- concatMapM dsCon cons-  raw_inst <- mk_inst Nothing (foldType (DConT name) (map tvbToType dtvbs)) dcons-  (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_derived_eq_decs   = derivedEqDecs-        , pd_derived_show_decs = derivedShowDecs } <- partitionDecs decls--  ((letDecEnv, classes', insts'), promDecls) <- promoteM locals $ do-    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, 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) ++ newDecls---- see comment at top of file-buildDataLets :: DataDecl -> [(Name, DExp)]-buildDataLets (DataDecl _nd _name _tvbs cons _derivings) =-  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 } }) = do-  (sing_sigs, _, tyvar_names, res_kis)-    <- unzip4 <$> zipWithM (singTySig no_meth_defns meth_sigs)-                           meth_names (map promoteValRhs meth_names)-  let default_sigs = catMaybes $ zipWith3 mk_default_sig meth_names sing_sigs 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)-                                             res_ki_map))-                     (Map.toList default_defns)-  fixities' <- traverse (uncurry singInfixDecl) 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) (Just res_ki) =-      DDefaultSigD s_name <$> add_constraints meth_name sty res_ki-    mk_default_sig _ _ _ = error "Internal error: a singled signature isn't a signature."--    add_constraints meth_name sty res_ki = do  -- Maybe monad-      prom_dflt <- Map.lookup meth_name promoted_defaults-      let default_pred = foldl DAppPr (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-        tvs                    = map tvbToType tvbs---singInstD :: AInstDecl -> SgM DDec-singInstD (InstDecl { id_cxt = cxt, id_name = inst_name-                    , id_arg_tys = inst_tys, id_meths = ann_meths }) = 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)-      (s_ty, tyvar_names, m_res_ki) <- case mb_s_info of-        Just (DVarI _ (DForallT cls_tvbs _cls_pred s_ty) _) -> do-          let (sing_tvbs, _pred, _args, res_ty) = unravel s_ty-          inst_kis <- mapM promoteType inst_tys-          let subst = Map.fromList (zip (map extractTvbName cls_tvbs)-                                        inst_kis)-              m_res_ki = case res_ty of-                _sing `DAppT` (_prom_func `DSigT` res_ki) -> Just (substKind subst res_ki)-                _                                         -> Nothing--          return (substType subst s_ty, map extractTvbName sing_tvbs, m_res_ki)-        _ -> do-          mb_info <- dsReify name-          case mb_info of-            Just (DVarI _ (DForallT cls_tvbs _cls_pred inner_ty) _) -> do-              let subst = Map.fromList (zip (map extractTvbName cls_tvbs)-                                            inst_tys)-              -- 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, res_ki) <- singType (promoteValRhs name)-                                                                 (substType subst raw_ty)-              return (s_ty, tyvar_names, Just 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)-                             kind_map name rhs-      return $ map DLetDec [DSigD (singValName name) s_ty, meth']--singLetDecEnv :: ALetDecEnv -> SgM a -> SgM ([DLetDec], a)-singLetDecEnv (LetDecEnv { lde_defns = defns-                         , lde_types = types-                         , lde_infix = infix_decls-                         , lde_proms = proms })-              thing_inside = do-  let prom_list = Map.toList proms-  (typeSigs, letBinds, tyvarNames, res_kis)-    <- unzip4 <$> mapM (uncurry (singTySig defns types)) prom_list-  infix_decls' <- traverse (uncurry singInfixDecl) 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) res_ki_map))-                     (Map.toList defns)-    thing <- thing_inside-    return (infix_decls' ++ typeSigs ++ let_decs, thing)--singTySig :: Map Name ALetDecRHS  -- definitions-          -> Map Name DType       -- type signatures-          -> 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-                 , Maybe DKind           -- the result kind in the tysig-                 )-singTySig defns types 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-      return ( DSigD sName sty-             , (name, wrapSingFun num_args prom_ty (DVarE sName))-             , (name, tyvar_names)-             , Nothing )-    Just ty -> do-      (sty, num_args, tyvar_names, res_ki) <- singType prom_ty ty-      return ( DSigD sName sty-             , (name, wrapSingFun num_args prom_ty (DVarE sName))-             , (name, tyvar_names)-             , Just res_ki )-  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--      -- 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 DKind   -- result kind (might not be known)-              -> Name -> ALetDecRHS -> SgM DLetDec-singLetDecRHS _bound_names res_kis name (AValue prom num_arrows exp) =-  DValD (DVarPa (singValName name)) <$>-  (wrapUnSingFun num_arrows prom <$> singExp exp (Map.lookup name res_kis))-singLetDecRHS bound_names res_kis name (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 <- 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 sBody'--singPat :: Map Name Name   -- from term-level names to type-level names-        -> DPat-        -> SgM DPat-singPat _var_proms (DLitPa _lit) =-  fail "Singling of literal patterns not yet supported"-singPat var_proms (DVarPa name) = do-  tyname <- case Map.lookup name var_proms of-              Nothing     ->-                fail "Internal error: unknown variable when singling pattern"-              Just tyname -> return tyname-  return $ DVarPa (singValName name) `DSigPa` (singFamily `DAppT` DVarT tyname)-singPat var_proms (DConPa name pats) = do-  pats' <- mapM (singPat var_proms) pats-  return $ DConPa (singDataConName name) pats'-singPat var_proms (DTildePa pat) = do-  qReportWarning-    "Lazy pattern converted into regular pattern during singleton generation."-  singPat var_proms pat-singPat var_proms (DBangPa pat) = do-  pat' <- singPat var_proms pat-  return $ DBangPa pat'-singPat _var_proms (DSigPa _pat _ty) = error "TODO: Handle SigPa. See Issue #183."-singPat _var_proms DWildPa = return DWildPa----- 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.--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 =-  uncurry DLetE <$> singLetDecEnv env (singExp exp res_ki)-singExp (ADSigE {}) _ =-  fail "Singling of explicit type annotations not yet supported."---- See Note [DerivedDecl]-singDerivedEqDecs :: DerivedEqDecl -> SgM [DDec]-singDerivedEqDecs (DerivedDecl { ded_mb_cxt = mb_ctxt-                               , ded_type   = ty-                               , ded_cons   = 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_cons   = cons }) = do-    -- First, generate the ShowSing instance.-    show_sing_inst <- mkShowInstance ForShowSing mb_cxt ty cons-    z <- qNewName "z"-    -- Next, the Show instance for the singleton type, like this:-    ---    --   instance (ShowSing a, ShowSing b) => Sing (Sing (z :: Either a b)) where-    --     showsPrec = showsSingPrec-    ---    -- Be careful: we want to generate an instance context that uses ShowSing,-    -- not Show, because we are reusing the ShowSing instance.-    show_cxt <- inferConstraintsDef (fmap (mkShowContext ForShowSing) mb_cxt)-                                    (DConPr showSingName)-                                    ty cons-    let show_inst = DInstanceD Nothing show_cxt-                               (DConT showName `DAppT` (singFamily `DAppT` DSigT (DVarT z) ty))-                               [DLetDec (DFunD showsPrecName-                                               [DClause [] (DVarE showsSingPrecName)])]-    pure [toInstanceD show_sing_inst, show_inst]-  where-    toInstanceD :: UInstDecl -> DDec-    toInstanceD (InstDecl { id_cxt = cxt, id_name = inst_name-                     , id_arg_tys = inst_tys, id_meths = ann_meths }) =-      DInstanceD Nothing cxt (foldType (DConT inst_name) inst_tys)-                         (map (DLetDec . toFunD) ann_meths)--    toFunD :: (Name, ULetDecRHS) -> DLetDec-    toFunD (fun_name, UFunction clauses) = DFunD fun_name clauses-    toFunD (val_name, UValue rhs)        = DValD (DVarPa val_name) rhs--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 <- singPat (Map.fromList var_proms) pat-  sExp <- singExp exp res_ki-  return $ DMatch sPat 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,179 +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.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---- We wish to consider the promotion of "Rep" to be *--- not a promoted data constructor.-singDataD :: DataDecl -> SgM [DDec]-singDataD (DataDecl _nd name tvbs ctors _derivings) = do-  aName <- qNewName "z"-  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 -> *-  let kindedSynInst =-        DTySynD (singTyConName name)-                []-                (singFamily `DSigT` (DArrowT `DAppT` k `DAppT` DStarT))--  return $ (DDataInstD Data [] singFamilyName [DSigT (DVarT aName) k] 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 (filter (not . isEqPred) 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-  args <- zipWithM buildArgType types indices-  let tvbs = zipWith DKindedTV indexNames kinds-      kindedIndices = zipWith DSigT indices kinds--  -- SingI instance-  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))]]--  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-                (Just (DConT singFamilyName `DAppT` foldType pCon indices))-  where buildArgType :: DType -> DType -> SgM DType-        buildArgType ty index = do-          (ty', _, _, _) <- singType index ty-          return ty'--        isEqPred :: DPred -> Bool-        isEqPred (DAppPr f _) = isEqPred f-        isEqPred (DSigPr p _) = isEqPred p-        isEqPred (DVarPr _)   = False-        isEqPred (DConPr n)   = n == equalityName-        isEqPred DWildCardPr  = False
− 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 => Fixity -> Name -> q DLetDec-singInfixDecl fixity name = 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 fixity name]--singFixityDeclarations :: DsMonad q => [Name] -> q [DDec]-singFixityDeclarations = concatMapM trySingFixityDeclaration-  where-    trySingFixityDeclaration name =-      qRecover (return []) (singFixityDeclaration name)
− src/Data/Singletons/Single/Monad.hs 
@@ -1,156 +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, 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_local_decls :: [Dec]-        }--emptySgEnv :: SgEnv-emptySgEnv = SgEnv { sg_let_binds   = Map.empty-                   , 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-  qAddForeignFile     = liftSgM `comp2` qAddForeignFile-  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 })--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
− src/Data/Singletons/Single/Type.hs 
@@ -1,55 +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--singType :: 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-                , DKind )  -- the kind of the result type-singType 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'-  let ty' = DForallT (zipWith DKindedTV arg_names prom_args)-                     cxt' tau-  return (ty', num_args, arg_names, prom_res)--singPred :: DPred -> SgM DPred-singPred = singPredRec []--singPredRec :: [DType] -> DPred -> SgM DPred-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 $ foldl DAppPr (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,181 +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-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.Semigroup (Semigroup(..))--type VarPromotions = [(Name, Name)]  -- from term-level name to type-level name--  -- the relevant part of declarations-data DataDecl      = DataDecl NewOrData Name [DTyVarBndr] [DCon] [DPred]--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_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 and lambda 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 ADExp DType--data ADMatch = ADMatch VarPromotions DPat ADExp-data ADClause = ADClause VarPromotions-                         [DPat] 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 (ann :: AnnotationFlag)-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 :: [(Fixity, Name)] -- infix declarations-                   , lde_proms :: IfAnn ann (Map Name DType) () -- possibly, promotions-                   }-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 [] ()-  mappend = (<>)--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 = [(f,n)] }--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_cons   :: [DCon]-  }--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 constructors (ded_cons)--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 ShowSing/Sing 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 ShowSing/Show-  instances.--}
− src/Data/Singletons/TH.hs 
@@ -1,172 +0,0 @@-{-# LANGUAGE ExplicitNamespaces, CPP #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TH--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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, Foldl, sFoldl,-  SDecide(..), (:~:)(..), Void, Refuted, Decision(..),-  PBounded(..), SBounded(..),-  PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum),-  PShow(..), SShow(..),-  ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace,-  ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace,-  (:.), (%.),-  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,-  type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),-  (:@#@$), (:@#@$$), (:@#@$$$),--  SuppressUnusedWarnings(..)-- ) where--import Data.Singletons-import Data.Singletons.Single-import Data.Singletons.Promote-import Data.Singletons.Prelude.Base-import Data.Singletons.Prelude.Instances-import Data.Singletons.Prelude.Bool-import Data.Singletons.Prelude.Enum-import Data.Singletons.Prelude.Eq-import Data.Singletons.Prelude.Ord-import Data.Singletons.Prelude.Show-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/TypeLits.hs 
@@ -1,193 +0,0 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeInType, ConstraintKinds,-             GADTs, TypeFamilies, UndecidableInstances #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeLits--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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,-  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, 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 ShowSing/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---- | 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--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])--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])--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])--$(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,201 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeLits.Internal--- Copyright   :  (C) 2014 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- 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,-             TypeInType, TemplateHaskell, StandaloneDeriving #-}-{-# OPTIONS_GHC -Wno-orphans #-}--module Data.Singletons.TypeLits.Internal (-  Sing(..),--  Nat, Symbol,-  SNat, SSymbol, withKnownNat, withKnownSymbol,-  Error, sError,-  Undefined, sUndefined,-  KnownNat, TN.natVal, KnownSymbol, symbolVal,-  type (^), (%^),-  type (<>), (%<>),--  -- * Defunctionalization symbols-  ErrorSym0, ErrorSym1, 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-import Data.Singletons.Decide-import Data.Singletons.Prelude.Bool-import GHC.TypeLits as TL-import qualified GHC.TypeNats as TN-import Data.Monoid ((<>))-import qualified Data.Type.Equality as DTE-import Data.Type.Equality ((:~:)(..))-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)-    | TN.natVal (Proxy :: Proxy n) == TN.natVal (Proxy :: Proxy m)-    = Proved $ unsafeCoerce Refl-    | otherwise-    = Disproved (\_ -> error errStr)-    where errStr = "Broken Nat singletons"--instance SDecide Symbol where-  (SSym :: Sing n) %~ (SSym :: Sing m)-    | symbolVal (Proxy :: Proxy n) == symbolVal (Proxy :: Proxy m)-    = Proved $ unsafeCoerce Refl-    | otherwise-    = Disproved (\_ -> error errStr)-    where errStr = "Broken Symbol singletons"---- PEq instances-instance PEq Nat where-  type (a :: Nat) == (b :: Nat) = a DTE.== b-instance PEq Symbol where-  type (a :: Symbol) == (b :: Symbol) = a DTE.== b---- need SEq instances for TypeLits kinds-instance SEq Nat where-  a %== b-    | fromSing a == fromSing b    = unsafeCoerce STrue-    | otherwise                   = unsafeCoerce SFalse--instance SEq Symbol where-  a %== b-    | fromSing a == fromSing b    = unsafeCoerce STrue-    | otherwise                   = 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])---- | The singleton for 'error'-sError :: Sing (str :: Symbol) -> a-sError sstr = error (T.unpack (fromSing sstr))---- | The promotion of 'undefined'.-type family Undefined :: k where {}-$(genDefunSymbols [''Undefined])---- | The singleton for 'undefined'.-sUndefined :: a-sUndefined = undefined---- | The singleton analogue of '(TL.^)' 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 [''(^)])---- | The promoted analogue of '(<>)' for 'Symbol's. This uses the special--- 'TL.AppendSymbol' type family from "GHC.TypeLits".-type a <> b = TL.AppendSymbol a b-infixr 6 <>---- | The singleton analogue of '(<>)' for 'Symbol's.-(%<>) :: Sing a -> Sing b -> Sing (a <> b)-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)-infixr 6 %<>--$(genDefunSymbols [''(<>)])
− src/Data/Singletons/TypeRepStar.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE RankNTypes, TypeFamilies, KindSignatures, FlexibleInstances,-             GADTs, UndecidableInstances, ScopedTypeVariables, DataKinds,-             MagicHash, TypeOperators #-}-{-# OPTIONS_GHC -Wno-orphans #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Singletons.TypeRepStar--- Copyright   :  (C) 2013 Richard Eisenberg--- License     :  BSD-style (see LICENSE)--- Maintainer  :  Richard Eisenberg (rae@cs.brynmawr.edu)--- Stability   :  experimental--- Portability :  non-portable------ This module defines singleton instances making 'TypeRep' the singleton for--- the kind @*@. The definitions don't fully line up with what is expected--- within the singletons library, so expect unusual results!----------------------------------------------------------------------------------module Data.Singletons.TypeRepStar (-  Sing(STypeRep),-  -- | Here is the definition of the singleton for @*@:-  ---  -- > newtype instance Sing :: Type -> Type where-  -- >   STypeRep :: TypeRep a -> Sing a-  ---  -- Instances for 'SingI', 'SingKind', 'SEq', 'SDecide', and 'TestCoercion' are-  -- also supplied.--  SomeTypeRepStar(..)-  ) where--import Data.Singletons.Prelude.Instances-import Data.Singletons.Internal-import Data.Singletons.Prelude.Eq-import Data.Singletons.Decide-import Data.Singletons.ShowSing-import Type.Reflection-import Type.Reflection.Unsafe-import Unsafe.Coerce--import Data.Kind-import Data.Type.Equality ((:~:)(..))--newtype instance Sing :: Type -> Type where-  STypeRep :: TypeRep a -> Sing a-    deriving (Eq, Ord, Show)---- | A variant of 'SomeTypeRep' whose underlying 'TypeRep' is restricted to--- kind @*@.-data SomeTypeRepStar where-  SomeTypeRepStar :: forall (a :: *). !(TypeRep a) -> SomeTypeRepStar--instance Eq SomeTypeRepStar where-  SomeTypeRepStar a == SomeTypeRepStar b =-    case eqTypeRep a b of-      Just HRefl -> True-      Nothing    -> False--instance Ord SomeTypeRepStar where-  SomeTypeRepStar a `compare` SomeTypeRepStar b =-    typeRepFingerprint a `compare` typeRepFingerprint b--instance Show SomeTypeRepStar where-  showsPrec p (SomeTypeRepStar ty) = showsPrec p ty--instance Typeable a => SingI (a :: *) where-  sing = STypeRep typeRep-instance SingKind Type where-  type Demote Type = SomeTypeRepStar-  fromSing (STypeRep tr) = SomeTypeRepStar tr-  toSing (SomeTypeRepStar tr) = SomeSing $ STypeRep tr--instance PEq Type where-  type (a :: *) == (b :: *) = EqType a b--type family EqType (a :: Type) (b :: Type) where-  EqType a a = 'True-  EqType a b = 'False--instance SEq Type 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 where-  STypeRep tra %~ STypeRep trb =-    case eqTypeRep tra trb of-      Just HRefl -> Proved Refl-      Nothing    -> Disproved (\Refl -> error "Type.Reflection.eqTypeRep failed")--instance ShowSing Type where-  showsSingPrec = showsPrec
− src/Data/Singletons/Util.hs 
@@ -1,519 +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 Data.Foldable-import Data.Traversable-import Data.Generics-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 =-            [  ''(,)-            , ''(,,)-            , ''(,,,)-            , ''(,,,,)-            , ''(,,,,,)-            , ''(,,,,,,)-            ] ++ enumBasicTypes--enumBasicTypes :: [Name]-enumBasicTypes = [ ''Bool, ''Ordering, ''() ]---- 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---- Get argument types from an arrow type. Removing ForallT is an--- important preprocessing step required by promoteType.-unravel :: DType -> ([DTyVarBndr], [DPred], [DType], DType)-unravel (DForallT tvbs cxt ty) =-  let (tvbs', cxt', tys, res) = unravel ty in-  (tvbs ++ tvbs', cxt ++ cxt', tys, res)-unravel (DAppT (DAppT DArrowT t1) t2) =-  let (tvbs, cxt, tys, res) = unravel t2 in-  (tvbs, cxt, t1 : tys, res)-unravel t = ([], [], [], t)---- 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 (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--    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))--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-substType _ ty@DStarT     = ty--substPred :: Map Name DType -> DPred -> DPred-substPred subst pred | Map.null subst = pred-substPred subst (DAppPr pred ty) =-  DAppPr (substPred subst pred) (substType subst ty)-substPred subst (DSigPr pred ki) = DSigPr (substPred subst pred) ki-substPred _ pred@(DVarPr {}) = pred-substPred _ pred@(DConPr {}) = pred-substPred _ pred@DWildCardPr = pred--substKindInPred :: Map Name DKind -> DPred -> DPred-substKindInPred subst pred | Map.null subst = pred-substKindInPred subst (DAppPr pred ty) =-  DAppPr (substKindInPred subst pred) (substType subst ty)-substKindInPred subst (DSigPr pred ki) = DSigPr (substKindInPred subst pred)-                                                (substKind subst ki)-substKindInPred _ pred@(DVarPr {}) = pred-substKindInPred _ pred@(DConPr {}) = pred-substKindInPred _ pred@DWildCardPr = pred--substKindInTvb :: Map Name DKind -> DTyVarBndr -> DTyVarBndr-substKindInTvb _ tvb@(DPlainTV _) = tvb-substKindInTvb subst (DKindedTV n ki) = DKindedTV n (substKind subst ki)--addStar :: DKind -> DKind-addStar t = DAppT (DAppT DArrowT t) DStarT--addStar_maybe :: Maybe DKind -> Maybe DKind-addStar_maybe = fmap addStar---- apply a type to a list of types-foldType :: DType -> [DType] -> DType-foldType = foldl DAppT---- | 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---- 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-  qAddForeignFile     = lift `comp2` qAddForeignFile-  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
@@ -0,0 +1,1088 @@+{- ByHand.hs++(c) Richard Eisenberg 2012+rae@cs.brynmawr.edu++Shows the derivations for the singleton definitions done by hand.+This file is a great way to understand the singleton encoding better.++-}++{-# OPTIONS_GHC -Wno-unticked-promoted-constructors -Wno-orphans #-}++{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures, GADTs,+             FlexibleInstances, FlexibleContexts, UndecidableInstances,+             RankNTypes, TypeOperators, MultiParamTypeClasses,+             FunctionalDependencies, ScopedTypeVariables,+             LambdaCase, EmptyCase,+             TypeApplications, EmptyCase, CPP #-}++#if __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif++#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 ------------------+-----------------------------------++#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif+data Nat where+  Zero :: Nat+  Succ :: Nat -> Nat+  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++-----------------------------------+-- 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 %/=++#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++sIf :: Sing a -> Sing b -> Sing c -> Sing (If a b c)+sIf STrue b _ = b+sIf SFalse _ c = c++-----------------------------------+-- Auto-generated code ------------+-----------------------------------++-- Nat++#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++#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+instance PEq Nat where+  type a == b = EqualsNat a b++instance SEq Nat where+  SZero %== SZero = STrue+  SZero %== (SSucc _) = SFalse+  (SSucc _) %== SZero = SFalse+  (SSucc n) %== (SSucc n') = n %== n'++instance SDecide Nat where+  SZero %~ SZero = Proved Refl+  (SSucc m) %~ (SSucc n) =+    case m %~ n of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)+  SZero %~ (SSucc _) = Disproved (\case)+  (SSucc _) %~ SZero = Disproved (\case)++instance SingI Zero where+  sing = SZero+instance SingI n => SingI (Succ n) where+  sing = SSucc sing+instance SingI1 Succ where+  liftSing = SSucc+instance SingKind Nat where+  type Demote Nat = Nat+  fromSing SZero = Zero+  fromSing (SSucc n) = Succ (fromSing n)+  toSing Zero = SomeSing SZero+  toSing (Succ n) = withSomeSing n (\n' -> SomeSing $ SSucc n')++-- Bool++#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++(%&&) :: forall (a :: Bool) (b :: Bool). Sing a -> Sing b -> Sing (a && b)+SFalse %&& SFalse = SFalse+SFalse %&& STrue = SFalse+STrue %&& SFalse = SFalse+STrue %&& STrue = STrue++instance SingI False where+  sing = SFalse+instance SingI True where+  sing = STrue+instance SingKind Bool where+  type Demote Bool = Bool+  fromSing SFalse = False+  fromSing STrue = True+  toSing False = SomeSing SFalse+  toSing True  = SomeSing STrue++-- Maybe++#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++#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+instance PEq a => PEq (Maybe a) where+  type m1 == m2 = EqualsMaybe m1 m2++instance SDecide k => SDecide (Maybe k) where+  SNothing %~ SNothing = Proved Refl+  (SJust x) %~ (SJust y) =+    case x %~ y of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)+  SNothing %~ (SJust _) = Disproved (\case)+  (SJust _) %~ SNothing = Disproved (\case)++instance SEq k => SEq (Maybe k) where+  SNothing %== SNothing = STrue+  SNothing %== (SJust _) = SFalse+  (SJust _) %== SNothing = SFalse+  (SJust a) %== (SJust a') = a %== a'++instance SingI (Nothing :: Maybe k) where+  sing = SNothing+instance SingI a => SingI (Just (a :: k)) where+  sing = SJust sing+instance SingI1 Just where+  liftSing = SJust+instance SingKind k => SingKind (Maybe k) where+  type Demote (Maybe k) = Maybe (Demote k)+  fromSing SNothing = Nothing+  fromSing (SJust a) = Just (fromSing a)+  toSing Nothing = SomeSing SNothing+  toSing (Just x) =+    case toSing x :: SomeSing k of+      SomeSing x' -> SomeSing $ SJust x'++-- List++#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++#if __GLASGOW_HASKELL__ >= 810+type NilSym0 :: List a+#endif+type family NilSym0 :: List a where+  NilSym0 = Nil++#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+type instance Apply (ConsSym1 a) b = Cons a b++#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+instance PEq a => PEq (List a) where+  type l1 == l2 = EqualsList l1 l2++instance SEq k => SEq (List k) where+  SNil %== SNil = STrue+  SNil %== (SCons _ _) = SFalse+  (SCons _ _) %== SNil = SFalse+  (SCons a b) %== (SCons a' b') = (a %== a') %&& (b %== b')++instance SDecide k => SDecide (List k) where+  SNil %~ SNil = Proved Refl+  (SCons h1 t1) %~ (SCons h2 t2) =+    case (h1 %~ h2, t1 %~ t2) of+      (Proved Refl, Proved Refl) -> Proved Refl+      (Disproved contra, _) -> Disproved (\Refl -> contra Refl)+      (_, Disproved contra) -> Disproved (\Refl -> contra Refl)+  SNil %~ (SCons _ _) = Disproved (\case)+  (SCons _ _) %~ SNil = Disproved (\case)++instance SingI Nil where+  sing = SNil+instance (SingI h, SingI t) =>+           SingI (Cons (h :: k) (t :: List k)) where+  sing = SCons sing sing+instance 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+  fromSing (SCons h t) = Cons (fromSing h) (fromSing t)+  toSing Nil = SomeSing SNil+  toSing (Cons h t) =+    case ( toSing h :: SomeSing k+         , toSing t :: SomeSing (List k) ) of+      (SomeSing h', SomeSing t') -> SomeSing $ SCons h' t'++-- Either++#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)+  fromSing (SRight x) = Right (fromSing x)+  toSing (Left x) =+    case toSing x :: SomeSing k1 of+      SomeSing x' -> SomeSing $ SLeft x'+  toSing (Right x) =+    case toSing x :: SomeSing k2 of+      SomeSing x' -> SomeSing $ SRight x'++instance (SDecide k1, SDecide k2) => SDecide (Either k1 k2) where+  (SLeft x) %~ (SLeft y) =+    case x %~ y of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)+  (SRight x) %~ (SRight y) =+    case x %~ y of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)+  (SLeft _) %~ (SRight _) = Disproved (\case)+  (SRight _) %~ (SLeft _) = Disproved (\case)++-- Composite++#if __GLASGOW_HASKELL__ >= 810+type Composite :: Type -> Type -> Type+#endif+data Composite :: Type -> Type -> Type where+  MkComp :: Either (Maybe a) b -> Composite a b++#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)+  fromSing (SMkComp x) = MkComp (fromSing x)+  toSing (MkComp x) =+    case toSing x :: SomeSing (Either (Maybe k1) k2) of+      SomeSing x' -> SomeSing $ SMkComp x'++instance (SDecide k1, SDecide k2) => SDecide (Composite k1 k2) where+  (SMkComp x) %~ (SMkComp y) =+    case x %~ y of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)++-- Empty++#if __GLASGOW_HASKELL__ >= 810+type Empty :: Type+#endif+data Empty++#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+  toSing x = SomeSing (case x of)++-- 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++#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++  fromSing SNat = Nat+  fromSing (SMaybe a) = Maybe (fromSing a)+  fromSing (SVec a n) = Vec (fromSing a) (fromSing n)++  toSing Nat = SomeSing SNat+  toSing (Maybe a) =+    case toSing a :: SomeSing Type of+      SomeSing a' -> SomeSing $ SMaybe a'+  toSing (Vec a n) =+    case ( toSing a :: SomeSing Type+         , toSing n :: SomeSing Nat) of+      (SomeSing a', SomeSing n') -> SomeSing $ SVec a' n'++instance SDecide Type where+  SNat %~ SNat = Proved Refl+  SNat %~ (SMaybe {}) = Disproved (\case)+  SNat %~ (SVec {}) = Disproved (\case)+  (SMaybe {}) %~ SNat = Disproved (\case)+  (SMaybe a) %~ (SMaybe b) =+    case a %~ b of+      Proved Refl -> Proved Refl+      Disproved contra -> Disproved (\Refl -> contra Refl)+  (SMaybe {}) %~ (SVec {}) = Disproved (\case)+  (SVec {}) %~ SNat = Disproved (\case)+  (SVec {}) %~ (SMaybe {}) = Disproved (\case)+  (SVec a1 n1) %~ (SVec a2 n2) =+    case (a1 %~ a2, n1 %~ n2) of+      (Proved Refl, Proved Refl) -> Proved Refl+      (Disproved contra, _) -> Disproved (\Refl -> contra Refl)+      (_, Disproved contra) -> Disproved (\Refl -> contra Refl)++#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+  type a == b = EqualsType a b++instance SEq Type where+  a %== b =+    case a %~ b of+      Proved Refl -> STrue+      Disproved _ -> unsafeCoerce SFalse++-----------------------------------+-- Some example functions ---------+-----------------------------------++isJust :: Maybe a -> Bool+isJust Nothing = False+isJust (Just _) = True++#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+#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)+sIsJust SNothing = SFalse+sIsJust (SJust _) = STrue++pred :: Nat -> Nat+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++sPred :: forall (t :: Nat). Sing t -> Sing (Pred t)+sPred SZero = SZero+sPred (SSucc n) = n++map :: (a -> b) -> List a -> List b+map _ Nil = Nil+map f (Cons h t) = Cons (f h) (map f t)++#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+#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)+sMap _ SNil = SNil+sMap f (SCons h t) = SCons (f Proxy h) (sMap f t)++-- Alternative implementation of sMap with Proxy outside of callback.+-- Not generated by the library.+sMap2 :: forall k1 k2 (a :: List k1) (f :: k1 ~> k2). Proxy f ->+       (forall b. Sing b -> Sing (Apply f b)) -> Sing a -> Sing (Map f a)+sMap2 _ _ SNil = SNil+sMap2 p f (SCons h t) = SCons (f h) (sMap2 p f t)++-- test sMap+foo :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil))+foo = sMap (\(_ :: Proxy (TyCon1 Succ)) -> SSucc) (SCons (SSucc SZero) (SCons SZero SNil))++-- test sMap2+bar :: Sing (Cons (Succ (Succ Zero)) (Cons (Succ Zero) Nil))+bar = sMap2 (Proxy :: Proxy SuccSym0) (SSucc) (SCons (SSucc SZero) (SCons SZero SNil))++baz :: Sing (Cons Zero (Cons Zero Nil))+baz = sMap2 (Proxy :: Proxy PredSym0) (sPred) (SCons (SSucc SZero) (SCons SZero SNil))++zipWith :: (a -> b -> c) -> 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++#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++#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).+  (forall (t1 :: a). Proxy k1 -> Sing t1 -> forall (t2 :: b). Sing t2 -> Sing (Apply (Apply k1 t1) t2))+  -> Sing k2 -> Sing k3 -> Sing (ZipWith k1 k2 k3)+sZipWith f (SCons x xs) (SCons y ys) = SCons (f Proxy x y) (sZipWith f xs ys)+sZipWith _ SNil (SCons _ _) = SNil+sZipWith _ (SCons _ _) SNil = SNil+sZipWith _ SNil        SNil = SNil++either :: (a -> c) -> (b -> c) -> Either a b -> c+either l _ (Left x) = l x+either _ r (Right x) = r x++#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+#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)+                  (r :: b ~> c)+                  (e :: Either a b).+           (forall n. Proxy l -> Sing n -> Sing (Apply l n)) ->+           (forall n. Proxy r -> Sing n -> Sing (Apply r n)) ->+           Sing e -> Sing (Either_ l r e)+sEither l _ (SLeft x) = l Proxy x+sEither _ r (SRight x) = r Proxy x++-- Alternative implementation of sEither with Proxy outside of callbacks.+-- Not generated by the library.+sEither2 :: forall a b c+                   (l :: a ~> c)+                   (r :: b ~> c)+                   (e :: Either a b).+           Proxy l -> Proxy r ->+           (forall n. Sing n -> Sing (Apply l n)) ->+           (forall n. Sing n -> Sing (Apply r n)) ->+           Sing e -> Sing (Either_ l r e)+sEither2 _ _ l _ (SLeft  x) = l x+sEither2 _ _ _ r (SRight x) = r x++eitherFoo :: Sing (Succ (Succ Zero))+eitherFoo = sEither (\(_ :: Proxy SuccSym0) -> SSucc)+                    (\(_ :: Proxy PredSym0)     -> sPred) (SLeft (SSucc SZero))++eitherBar :: Sing Zero+eitherBar = sEither2 (Proxy :: Proxy SuccSym0)+                     (Proxy :: Proxy PredSym0)+                     SSucc+                     sPred (SRight (SSucc SZero))++eitherToNat :: Either Nat Nat -> Nat+eitherToNat (Left  x) = x+eitherToNat (Right x) = x++#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++sEitherToNat :: Sing a -> Sing (EitherToNat a)+sEitherToNat (SLeft x) = x+sEitherToNat (SRight x) = x++liftMaybe :: (a -> b) -> Maybe a -> Maybe b+liftMaybe _ Nothing = Nothing+liftMaybe f (Just a) = Just (f a)++#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)++#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)) ->+                Sing x -> Sing (LiftMaybe f x)+sLiftMaybe _ SNothing = SNothing+sLiftMaybe f (SJust a) = SJust (f Proxy a)++(+) :: Nat -> Nat -> Nat+Zero + x = x+(Succ x) + y = Succ (x + y)++#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+#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+(SSucc x) %+ y = SSucc (x %+ y)++(-) :: Nat -> Nat -> Nat+Zero - _ = Zero+(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++#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+(SSucc x) %- SZero = SSucc x+(SSucc x) %- (SSucc y) = x %- y++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++#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)++#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 =>+             forall (a :: k). Sing a ->+             forall (list :: List k). Sing list -> Sing (Contains a list)+sContains _ SNil = SFalse+sContains elt (SCons h t) = (elt %== h) %|| (sContains elt t)+-}++sContains :: forall a (t1 :: a) (t2 :: List a). SEq a => Sing t1+          -> Sing t2 -> Sing (Contains t1 t2)+sContains _ SNil =+  let lambda :: forall wild. Sing (Contains wild Nil)+      lambda = SFalse+  in+  lambda+sContains elt (SCons h t) =+  let lambda :: forall elt h t. (elt ~ t1, (Cons h t) ~ t2) => Sing elt -> Sing h -> Sing t -> Sing (Contains elt (Cons h t))+      lambda elt' h' t' = (elt' %== h') %|| sContains elt' t'+  in+  lambda elt h t++cont :: Eq a => a -> List a -> Bool+cont = \elt list -> case list of+  Nil -> False+  Cons h t -> (elt == h) || cont elt t++#if __GLASGOW_HASKELL__ >= 810+type Cont :: a ~> List a ~> Bool+#endif+type family Cont :: a ~> List a ~> Bool where+  Cont = Lambda10Sym0++data Lambda10Sym0 f where+  KindInferenceLambda10Sym0 :: (Lambda10Sym0 @@ arg) ~ Lambda10Sym1 arg+                            => Proxy arg+                            -> Lambda10Sym0 f+type instance Lambda10Sym0 `Apply` x = Lambda10Sym1 x++data Lambda10Sym1 a f where+  KindInferenceLambda10Sym1 :: (Lambda10Sym1 a @@ arg) ~ Lambda10Sym2 a arg+                            => Proxy arg+                            -> Lambda10Sym1 a f+type instance (Lambda10Sym1 a) `Apply` b = Lambda10Sym2 a b++type Lambda10Sym2 a b = Lambda10 a b++type family Lambda10 a b where+  Lambda10 elt list = Case10 elt list list++type family Case10 a b scrut where+  Case10 elt list Nil = False+  Case10 elt list (Cons h t) = (||@#@$) @@ ((==@#@$) @@ elt @@ h) @@ (Cont @@ elt @@ t)++data (==@#@$) f where+  (:###==@#@$) :: ((==@#@$) @@ arg) ~ (==@#@$$) arg+               => Proxy arg+               -> (==@#@$) f+type instance (==@#@$) `Apply` x = (==@#@$$) x++data (==@#@$$) a f where+  (:###==@#@$$) :: ((==@#@$$) x @@ arg) ~ (==@#@$$$) x arg+                => Proxy arg+                -> (==@#@$$) x y+type instance (==@#@$$) a `Apply` b = (==) a b++type family (==@#@$$$) a b where+  (==@#@$$$) a b = (==) a b+++impNat :: forall m n. SingI n => Proxy n -> Sing m -> Sing (n + m)+impNat _ sm = (sing :: Sing n) %+ sm++callImpNat :: forall n m. Sing n -> Sing m -> Sing (n + m)+callImpNat sn sm = withSingI sn (impNat (Proxy :: Proxy n) sm)++instance Show (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++#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++type family Let123Loop p ls (arg1 :: Nat) (arg2 :: List a) :: List Nat where+  Let123Loop p ls z Nil = Nil+  Let123Loop p ls n (x `Cons` xs) = Case123 p ls n x xs (p @@ x)++type family Case123 p ls n x xs scrut where+  Case123 p ls n x xs True = n `Cons` ((Let123LoopSym2 p ls) @@ (Succ n) @@ xs)+  Case123 p ls n x xs False = (Let123LoopSym2 p ls) @@ (Succ n) @@ xs++data Let123LoopSym2 a b c where+  Let123LoopSym2KindInfernece :: ((Let123LoopSym2 a b @@ z) ~ Let123LoopSym3 a b z)+                              => Proxy z+                              -> Let123LoopSym2 a b c+type instance Apply (Let123LoopSym2 a b) c = Let123LoopSym3 a b c++data Let123LoopSym3 a b c d where+  KindInferenceLet123LoopSym3 :: ((Let123LoopSym3 a b c @@ z) ~ Let123LoopSym4 a b c z)+                              => Proxy z+                              -> Let123LoopSym3 a b c d+type instance Apply (Let123LoopSym3 a b c) d = 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+                               => Proxy z+                               -> FindIndicesSym0 a+type instance Apply FindIndicesSym0 a = FindIndicesSym1 a++data FindIndicesSym1 a b where+  KindInferenceFindIndicesSym1 :: (FindIndicesSym1 a @@ z) ~ FindIndicesSym2 a z+                               => Proxy z+                               -> FindIndicesSym1 a b+type instance Apply (FindIndicesSym1 a) b = 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) (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+        STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@+                   ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs)+        SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs+  in+  (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs+++fI :: forall a. (a -> Bool) -> [a] -> [Nat]+fI = \p ls ->+  let loop :: Nat -> [a] -> [Nat]+      loop _ [] = []+      loop n (x:xs) = case p x of+                        True -> n : loop (Succ n) xs+                        False -> loop (Succ n) xs+  in+  loop Zero ls++type FI = Lambda22Sym0++type FISym0 = FI++type family Lambda22 p ls where+  Lambda22 p ls = (Let123LoopSym2 p ls) @@ Zero @@ ls++data Lambda22Sym0 a where+  KindInferenceLambda22Sym0 :: (Lambda22Sym0 @@ z) ~ Lambda22Sym1 z+                            => Proxy z+                            -> Lambda22Sym0 a+type instance Apply Lambda22Sym0 a = Lambda22Sym1 a++data Lambda22Sym1 a b where+  KindInferenceLambda22Sym1 :: (Lambda22Sym1 a @@ z) ~ Lambda22Sym2 a z+                            => Proxy z+                            -> Lambda22Sym1 a b+type instance Apply (Lambda22Sym1 a) b = 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+    -> Sing t2+    -> Sing (FISym0 @@ t1 @@ t2)+sFI = unSingFun2 (singFun2 @FI (\p ls ->+    let lambda :: forall {-(t1 :: a ~> Bool)-} t1 t2. Sing t1 -> Sing t2 -> Sing (Lambda22Sym0 @@ t1 @@ t2)+        lambda sP sLs =+          let sLoop :: (Lambda22Sym0 @@ t1 @@ t2) ~ (Let123LoopSym2 t1 t2 @@ Zero @@ t2) => forall (u1 :: Nat). Sing u1+                    -> forall {-(u2 :: List a)-} u2. Sing u2+                    -> Sing ((Let123LoopSym2 t1 t2) @@ u1 @@ u2)+              sLoop _ SNil = SNil+              sLoop sN (sX `SCons` sXs) =  case sP @@ sX of+                STrue -> (singFun2 @ConsSym0 SCons) @@ sN @@+                     ((singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs)+                SFalse -> (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ ((singFun1 @SuccSym0 SSucc) @@ sN) @@ sXs+          in+          (singFun2 @(Let123LoopSym2 t1 t2) sLoop) @@ SZero @@ sLs+    in+    lambda p ls+  ))+-}++------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 810+type G :: Type -> Type+#endif+data G :: Type -> Type where+  MkG :: G Bool++#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
@@ -0,0 +1,302 @@+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators,+             DefaultSignatures, ScopedTypeVariables, InstanceSigs,+             MultiParamTypeClasses, FunctionalDependencies,+             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 Data.Kind+import Data.Singletons (Sing)++#if __GLASGOW_HASKELL__ >= 810+type Nat :: Type+#endif+data Nat = Zero | Succ Nat++#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++{-+type Bool :: Type+data Bool = False | 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++{-+type Ordering :: Type+data Ordering = LT | EQ | GT+-}++#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++{-+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++sNot :: Sing b -> Sing (Not b)+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++  type x == y = Not (x /= y)+  type x /= y = Not (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)++  default (%==) :: ((x == y) ~ (Not (x /= y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x == y)+  x %== y = sNot (x %/= y)++  default (%/=) :: ((x /= y) ~ (Not (x == y))) => Sing (x :: a) -> Sing (y :: a) -> Sing (x /= y)+  x %/= y = sNot (x %== y)++instance 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+  SSucc _ %== SZero   = SFalse+  SZero   %== SSucc _ = SFalse+  SSucc x %== SSucc y = x %== y++{-+instance Eq Ordering where+  LT == LT = True+  LT == EQ = False+  LT == GT = False+  EQ == LT = False+  EQ == EQ = True+  EQ == GT = False+  GT == LT = False+  GT == EQ = False+  GT == GT = True+-}++instance PEq Ordering where+  type 'LT == 'LT = 'True+  type 'LT == 'EQ = 'False+  type 'LT == 'GT = 'False+  type 'EQ == 'LT = 'False+  type 'EQ == 'EQ = 'True+  type 'EQ == 'GT = 'False+  type 'GT == 'LT = 'False+  type 'GT == 'EQ = 'False+  type 'GT == 'GT = 'True++instance SEq Ordering where+  SLT %== SLT = STrue+  SLT %== SEQ = SFalse+  SLT %== SGT = SFalse+  SEQ %== SLT = SFalse+  SEQ %== SEQ = STrue+  SEQ %== SGT = SFalse+  SGT %== SLT = SFalse+  SGT %== SEQ = SFalse+  SGT %== SGT = STrue++{-+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)++  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)++instance Pointed Nat where+  point = Zero++instance PPointed Nat where+  type Point = 'Zero++instance SPointed Nat where+  sPoint = SZero++--------------------------------++#if __GLASGOW_HASKELL__ >= 810+type FD :: Type -> Type -> Constraint+#endif+class FD a b | a -> b where+  meth :: a -> a+  l2r  :: a -> b++instance FD Bool Nat where+  meth = not+  l2r False = Zero+  l2r True = Succ Zero++t1 = meth True+t2 = l2r False++#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++instance PFD Bool Nat where+  type Meth a = Not a+  type L2r 'False = 'Zero+  type L2r 'True = 'Succ 'Zero++type T1 = Meth 'True++#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)++instance SFD Bool Nat where+  sMeth x = sNot x+  sL2r SFalse = SZero+  sL2r STrue = SSucc SZero++sT1 = sMeth STrue+sT2 :: Sing T2+sT2 = sL2r SFalse
tests/SingletonsTestSuite.hs view
@@ -1,103 +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 "T163"-    , compileAndDumpStdTest "T166"-    , compileAndDumpStdTest "T172"-    , compileAndDumpStdTest "T175"-    , compileAndDumpStdTest "T176"-    , compileAndDumpStdTest "T178"-    , compileAndDumpStdTest "T187"-    , compileAndDumpStdTest "T190"-    , compileAndDumpStdTest "ShowDeriving"-    , compileAndDumpStdTest "EmptyShowDeriving"-    , compileAndDumpStdTest "StandaloneDeriving"-    , compileAndDumpStdTest "T197"-    , compileAndDumpStdTest "T197b"-    , compileAndDumpStdTest "T200"-    , compileAndDumpStdTest "T206"-    , compileAndDumpStdTest "T209"-    , compileAndDumpStdTest "T226"-    , compileAndDumpStdTest "T229"-    , compileAndDumpStdTest "T249"-    , compileAndDumpStdTest "OverloadedStrings"-    , compileAndDumpStdTest "T271"-    ],-    testCompileAndDumpGroup "Promote"-    [ compileAndDumpStdTest "Constructors"-    , compileAndDumpStdTest "GenDefunSymbols"-    , compileAndDumpStdTest "Newtypes"-    , compileAndDumpStdTest "Pragmas"-    , compileAndDumpStdTest "Prelude"-    , compileAndDumpStdTest "T180"-    ],-    testGroup "Database client"-    [ compileAndDumpTest "GradingClient/Database" ghcOpts-    , compileAndDumpTest "GradingClient/Main"     ghcOpts-    ],-    testCompileAndDumpGroup "InsertionSort"-    [ compileAndDumpStdTest "InsertionSortImp"-    ]-  ]+main = pure ()
− tests/SingletonsTestSuiteUtils.hs 
@@ -1,245 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}-module SingletonsTestSuiteUtils (-   compileAndDumpTest- , compileAndDumpStdTest- , testCompileAndDumpGroup- , ghcOpts- , cleanFiles- ) where--import Control.Exception  ( Exception, throw                    )-import Control.Monad      ( liftM                               )-import Data.List          ( intercalate, find, isPrefixOf       )-import Data.Typeable      ( Typeable                            )-import System.Exit        ( ExitCode(..)                        )-import System.FilePath    ( takeBaseName, pathSeparator         )-import System.IO          ( IOMode(..), hGetContents, openFile  )-import System.IO.Unsafe   ( unsafePerformIO                     )-import System.Process     ( CreateProcess(..), StdStream(..)-                          , createProcess, proc, waitForProcess-                          , callCommand                         )-import System.Directory   ( doesFileExist                       )-import Test.Tasty         ( TestTree, testGroup                 )-import Test.Tasty.Golden  ( goldenVsFileDiff                    )--#ifndef CURRENT_PACKAGE_KEY-#include "../dist/build/autogen/cabal_macros.h"-#endif---- Some infractructure for handling external process errors-data ProcessException = ProcessException String deriving (Typeable)--instance Exception ProcessException--instance Show ProcessException where-    show (ProcessException msg) = msg--- GHC executable name (if on path) or full path-ghcPath :: FilePath-ghcPath = "ghc"---- directory storing compile-and-run tests and golden files-goldenPath :: FilePath-goldenPath = "tests/compile-and-dump/"---- path containing compiled *.hi files. Relative to goldenPath.--- See Note [-package-name hack]-includePath :: FilePath-includePath = "../../dist/build"--ghcVersion :: String-ghcVersion = ".ghc84"---- If a cabal sandbox is present, use its package database instead of the global one.-extraOpts :: [String]-extraOpts = unsafePerformIO $ do-   sandboxed <- doesFileExist "cabal.sandbox.config"-   if sandboxed-   then do-     let prefix = "package-db: "-         opts_from_config config =-           case find (prefix `isPrefixOf`) $ lines config of-             Nothing -> []-             Just db_line -> let package_db = drop (length prefix) db_line in-                             [ "-no-user-package-db"-                             , "-package-db " ++ package_db ]-     opts_from_config `liftM` readFile "cabal.sandbox.config"-   else return []---- GHC options used when running the tests-ghcOpts :: [String]-ghcOpts = extraOpts ++ [-    "-v0"-  , "-c"-  , "-this-unit-id " ++ CURRENT_PACKAGE_KEY -- See Note [-this-unit-id hack]-  , "-ddump-splices"-  , "-dsuppress-uniques"-  , "-fforce-recomp"-  , "-fprint-explicit-kinds"-  , "-O0"-  , "-i" ++ includePath   -- necessary because some tests use these modules-  , "-itests/compile-and-dump"-  , "-XTemplateHaskell"-  , "-XDataKinds"-  , "-XKindSignatures"-  , "-XTypeFamilies"-  , "-XTypeOperators"-  , "-XMultiParamTypeClasses"-  , "-XGADTs"-  , "-XFlexibleInstances"-  , "-XUndecidableInstances"-  , "-XRankNTypes"-  , "-XScopedTypeVariables"-  , "-XPolyKinds"-  , "-XFlexibleContexts"-  , "-XIncoherentInstances"-  , "-XLambdaCase"-  , "-XUnboxedTuples"-  , "-XInstanceSigs"-  , "-XDefaultSignatures"-  , "-XCPP"-  , "-XTypeInType"-  , "-XStandaloneDeriving"-  , "-XTypeApplications"-  , "-XEmptyCase"-  ]---- Note [-this-unit-id hack]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ We want to avoid installing singletons package before running the--- testsuite, because in this way we prevent double compilation of the--- library. To do this we pass -this-unit-id option to GHC to convince--- it that the test files are actually part of the current--- package. This means that library doesn't have to be installed--- globally and interface files generated during library compilation--- can be used when compiling test cases. We use "-i" option to point--- GHC to directory containing compiled interface files.---- 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'"-  , file-  ]--buildGoldenFile :: FilePath -> FilePath -> IO ()-buildGoldenFile templateFilePath goldenFilePath = do-  hGoldenFile <- openFile goldenFilePath WriteMode-  runProcessWithOpts (UseHandle hGoldenFile) "awk"-            [ "-f", "tests/compile-and-dump/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 tests/compile-and-dump/*/*.{hi,o}"
− tests/compile-and-dump/GradingClient/Database.ghc84.template 
@@ -1,2563 +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 (t :: Nat) = Succ t-    instance SuppressUnusedWarnings SuccSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.())-    data SuccSym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = Succ l-    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 (t :: Nat) (t :: Nat) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                          -> Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (z :: Nat)-      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 (TyFun Nat Ordering-                                                            -> Type)-                                                 -> 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-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 GHC.Types.[]) = True-    attrNotIn (Attr name u) (Sch (Attr name' _ GHC.Types.: t))-      = ((name /= name') && ((attrNotIn ((Attr name) u)) (Sch t)))-    disjoint :: Schema -> Schema -> Bool-    disjoint (Sch GHC.Types.[]) _ = True-    disjoint (Sch (h GHC.Types.: t)) s-      = (((attrNotIn h) s) && ((disjoint (Sch t)) s))-    occurs :: [AChar] -> Schema -> Bool-    occurs _ (Sch GHC.Types.[]) = False-    occurs name (Sch (Attr name' _ GHC.Types.: attrs))-      = ((name == name') || ((occurs name) (Sch attrs)))-    lookup :: [AChar] -> Schema -> U-    lookup _ (Sch GHC.Types.[]) = undefined-    lookup name (Sch (Attr name' u GHC.Types.: attrs))-      = if (name == name') then u else (lookup name) (Sch attrs)-    type BOOLSym0 = BOOL-    type STRINGSym0 = STRING-    type NATSym0 = NAT-    type VECSym2 (t :: U) (t :: Nat) = VEC t t-    instance SuppressUnusedWarnings VECSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) VECSym1KindInference) GHC.Tuple.())-    data VECSym1 (l :: U) (l :: TyFun Nat U)-      = forall arg. SameKind (Apply (VECSym1 l) arg) (VECSym2 l arg) =>-        VECSym1KindInference-    type instance Apply (VECSym1 l) l = VEC l l-    instance SuppressUnusedWarnings VECSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) VECSym0KindInference) GHC.Tuple.())-    data VECSym0 (l :: TyFun U (TyFun Nat U -> Type))-      = forall arg. SameKind (Apply VECSym0 arg) (VECSym1 arg) =>-        VECSym0KindInference-    type instance Apply VECSym0 l = VECSym1 l-    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 (t :: [AChar]) (t :: U) = Attr t t-    instance SuppressUnusedWarnings AttrSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AttrSym1KindInference) GHC.Tuple.())-    data AttrSym1 (l :: [AChar]) (l :: TyFun U Attribute)-      = forall arg. SameKind (Apply (AttrSym1 l) arg) (AttrSym2 l arg) =>-        AttrSym1KindInference-    type instance Apply (AttrSym1 l) l = Attr l l-    instance SuppressUnusedWarnings AttrSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AttrSym0KindInference) GHC.Tuple.())-    data AttrSym0 (l :: TyFun [AChar] (TyFun U Attribute -> Type))-      = forall arg. SameKind (Apply AttrSym0 arg) (AttrSym1 arg) =>-        AttrSym0KindInference-    type instance Apply AttrSym0 l = AttrSym1 l-    type SchSym1 (t :: [Attribute]) = Sch t-    instance SuppressUnusedWarnings SchSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SchSym0KindInference) GHC.Tuple.())-    data SchSym0 (l :: TyFun [Attribute] Schema)-      = forall arg. SameKind (Apply SchSym0 arg) (SchSym1 arg) =>-        SchSym0KindInference-    type instance Apply SchSym0 l = Sch l-    type Let0123456789876543210Scrutinee_0123456789876543210Sym4 t t t t =-        Let0123456789876543210Scrutinee_0123456789876543210 t t t t-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym4 l l l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym3KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l-    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 (t :: [AChar]) (t :: Schema) = Lookup t t-    instance SuppressUnusedWarnings LookupSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LookupSym1KindInference) GHC.Tuple.())-    data LookupSym1 (l :: [AChar]) (l :: TyFun Schema U)-      = forall arg. SameKind (Apply (LookupSym1 l) arg) (LookupSym2 l arg) =>-        LookupSym1KindInference-    type instance Apply (LookupSym1 l) l = Lookup l l-    instance SuppressUnusedWarnings LookupSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LookupSym0KindInference) GHC.Tuple.())-    data LookupSym0 (l :: TyFun [AChar] (TyFun Schema U -> Type))-      = forall arg. SameKind (Apply LookupSym0 arg) (LookupSym1 arg) =>-        LookupSym0KindInference-    type instance Apply LookupSym0 l = LookupSym1 l-    type OccursSym2 (t :: [AChar]) (t :: Schema) = Occurs t t-    instance SuppressUnusedWarnings OccursSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) OccursSym1KindInference) GHC.Tuple.())-    data OccursSym1 (l :: [AChar]) (l :: TyFun Schema Bool)-      = forall arg. SameKind (Apply (OccursSym1 l) arg) (OccursSym2 l arg) =>-        OccursSym1KindInference-    type instance Apply (OccursSym1 l) l = Occurs l l-    instance SuppressUnusedWarnings OccursSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) OccursSym0KindInference) GHC.Tuple.())-    data OccursSym0 (l :: TyFun [AChar] (TyFun Schema Bool -> Type))-      = forall arg. SameKind (Apply OccursSym0 arg) (OccursSym1 arg) =>-        OccursSym0KindInference-    type instance Apply OccursSym0 l = OccursSym1 l-    type AttrNotInSym2 (t :: Attribute) (t :: Schema) = AttrNotIn t t-    instance SuppressUnusedWarnings AttrNotInSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AttrNotInSym1KindInference) GHC.Tuple.())-    data AttrNotInSym1 (l :: Attribute) (l :: TyFun Schema Bool)-      = forall arg. SameKind (Apply (AttrNotInSym1 l) arg) (AttrNotInSym2 l arg) =>-        AttrNotInSym1KindInference-    type instance Apply (AttrNotInSym1 l) l = AttrNotIn l l-    instance SuppressUnusedWarnings AttrNotInSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AttrNotInSym0KindInference) GHC.Tuple.())-    data AttrNotInSym0 (l :: TyFun Attribute (TyFun Schema Bool-                                              -> Type))-      = forall arg. SameKind (Apply AttrNotInSym0 arg) (AttrNotInSym1 arg) =>-        AttrNotInSym0KindInference-    type instance Apply AttrNotInSym0 l = AttrNotInSym1 l-    type DisjointSym2 (t :: Schema) (t :: Schema) = Disjoint t t-    instance SuppressUnusedWarnings DisjointSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DisjointSym1KindInference) GHC.Tuple.())-    data DisjointSym1 (l :: Schema) (l :: TyFun Schema Bool)-      = forall arg. SameKind (Apply (DisjointSym1 l) arg) (DisjointSym2 l arg) =>-        DisjointSym1KindInference-    type instance Apply (DisjointSym1 l) l = Disjoint l l-    instance SuppressUnusedWarnings DisjointSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DisjointSym0KindInference) GHC.Tuple.())-    data DisjointSym0 (l :: TyFun Schema (TyFun Schema Bool -> Type))-      = forall arg. SameKind (Apply DisjointSym0 arg) (DisjointSym1 arg) =>-        DisjointSym0KindInference-    type instance Apply DisjointSym0 l = DisjointSym1 l-    type AppendSym2 (t :: Schema) (t :: Schema) = Append t t-    instance SuppressUnusedWarnings AppendSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AppendSym1KindInference) GHC.Tuple.())-    data AppendSym1 (l :: Schema) (l :: TyFun Schema Schema)-      = forall arg. SameKind (Apply (AppendSym1 l) arg) (AppendSym2 l arg) =>-        AppendSym1KindInference-    type instance Apply (AppendSym1 l) l = Append l l-    instance SuppressUnusedWarnings AppendSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) AppendSym0KindInference) GHC.Tuple.())-    data AppendSym0 (l :: TyFun Schema (TyFun Schema Schema -> Type))-      = forall arg. SameKind (Apply AppendSym0 arg) (AppendSym1 arg) =>-        AppendSym0KindInference-    type instance Apply AppendSym0 l = AppendSym1 l-    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 (t :: GHC.Types.Nat) (t :: U) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: U) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun U (TyFun Symbol Symbol-                                                                               -> Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun U (TyFun Symbol Symbol-                                                                               -> Type)-                                                                      -> Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: AChar) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: AChar) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun AChar (TyFun Symbol Symbol-                                                                                   -> Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun AChar (TyFun Symbol Symbol-                                                                                   -> Type)-                                                                      -> Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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)-    data instance Sing (z :: U)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing U)) (toSing b :: SomeSing Nat)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SVEC c) c) }-    data instance Sing (z :: AChar)-      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 (z :: Attribute)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing [AChar]))-                (toSing b :: SomeSing U)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SAttr c) c) }-    data instance Sing (z :: Schema)-      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 (TyFun U (TyFun Symbol Symbol-                                                                                           -> Type)-                                                                                  -> Type)-                                                             -> 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 (TyFun AChar (TyFun Symbol Symbol-                                                                                               -> Type)-                                                                                  -> Type)-                                                             -> 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 (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of-            GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl-            GHC.Tuple.(,) (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,) _ (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-    instance (Data.Singletons.ShowSing.ShowSing U,-              Data.Singletons.ShowSing.ShowSing Nat) =>-             Data.Singletons.ShowSing.ShowSing U where-      Data.Singletons.ShowSing.showsSingPrec _ SBOOL = showString "SBOOL"-      Data.Singletons.ShowSing.showsSingPrec _ SSTRING-        = showString "SSTRING"-      Data.Singletons.ShowSing.showsSingPrec _ SNAT = showString "SNAT"-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SVEC arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SVEC "))-               (((.)-                   ((Data.Singletons.ShowSing.showsSingPrec 11)-                      arg_0123456789876543210))-                  (((.) GHC.Show.showSpace)-                     ((Data.Singletons.ShowSing.showsSingPrec 11)-                        arg_0123456789876543210))))-    instance (Data.Singletons.ShowSing.ShowSing U,-              Data.Singletons.ShowSing.ShowSing Nat) =>-             Show (Sing (z :: U)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance Data.Singletons.ShowSing.ShowSing AChar where-      Data.Singletons.ShowSing.showsSingPrec _ SCA = showString "SCA"-      Data.Singletons.ShowSing.showsSingPrec _ SCB = showString "SCB"-      Data.Singletons.ShowSing.showsSingPrec _ SCC = showString "SCC"-      Data.Singletons.ShowSing.showsSingPrec _ SCD = showString "SCD"-      Data.Singletons.ShowSing.showsSingPrec _ SCE = showString "SCE"-      Data.Singletons.ShowSing.showsSingPrec _ SCF = showString "SCF"-      Data.Singletons.ShowSing.showsSingPrec _ SCG = showString "SCG"-      Data.Singletons.ShowSing.showsSingPrec _ SCH = showString "SCH"-      Data.Singletons.ShowSing.showsSingPrec _ SCI = showString "SCI"-      Data.Singletons.ShowSing.showsSingPrec _ SCJ = showString "SCJ"-      Data.Singletons.ShowSing.showsSingPrec _ SCK = showString "SCK"-      Data.Singletons.ShowSing.showsSingPrec _ SCL = showString "SCL"-      Data.Singletons.ShowSing.showsSingPrec _ SCM = showString "SCM"-      Data.Singletons.ShowSing.showsSingPrec _ SCN = showString "SCN"-      Data.Singletons.ShowSing.showsSingPrec _ SCO = showString "SCO"-      Data.Singletons.ShowSing.showsSingPrec _ SCP = showString "SCP"-      Data.Singletons.ShowSing.showsSingPrec _ SCQ = showString "SCQ"-      Data.Singletons.ShowSing.showsSingPrec _ SCR = showString "SCR"-      Data.Singletons.ShowSing.showsSingPrec _ SCS = showString "SCS"-      Data.Singletons.ShowSing.showsSingPrec _ SCT = showString "SCT"-      Data.Singletons.ShowSing.showsSingPrec _ SCU = showString "SCU"-      Data.Singletons.ShowSing.showsSingPrec _ SCV = showString "SCV"-      Data.Singletons.ShowSing.showsSingPrec _ SCW = showString "SCW"-      Data.Singletons.ShowSing.showsSingPrec _ SCX = showString "SCX"-      Data.Singletons.ShowSing.showsSingPrec _ SCY = showString "SCY"-      Data.Singletons.ShowSing.showsSingPrec _ SCZ = showString "SCZ"-    instance Show (Sing (z :: AChar)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    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 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 n => SingI (Sch (n :: [Attribute])) where-      sing = SSch sing-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--$(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.ghc84.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.ghc84.template 
@@ -1,177 +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 (t :: Nat) = Succ t-    instance SuppressUnusedWarnings SuccSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.())-    data SuccSym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = Succ l-    data instance Sing (z :: Nat)-      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-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 GHC.Types.[] = [n]-    insert n (h GHC.Types.: t)-      = if (leq n) h then-            (n GHC.Types.: (h GHC.Types.: t))-        else-            (h GHC.Types.: ((insert n) t))-    insertionSort :: [Nat] -> [Nat]-    insertionSort GHC.Types.[] = []-    insertionSort (h GHC.Types.: t) = (insert h) (insertionSort t)-    type Let0123456789876543210Scrutinee_0123456789876543210Sym3 t t t =-        Let0123456789876543210Scrutinee_0123456789876543210 t t t-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym3 l l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym2KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l-    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 (t :: Nat) (t :: Nat) = Leq t t-    instance SuppressUnusedWarnings LeqSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LeqSym1KindInference) GHC.Tuple.())-    data LeqSym1 (l :: Nat) (l :: TyFun Nat Bool)-      = forall arg. SameKind (Apply (LeqSym1 l) arg) (LeqSym2 l arg) =>-        LeqSym1KindInference-    type instance Apply (LeqSym1 l) l = Leq l l-    instance SuppressUnusedWarnings LeqSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LeqSym0KindInference) GHC.Tuple.())-    data LeqSym0 (l :: TyFun Nat (TyFun Nat Bool -> Type))-      = forall arg. SameKind (Apply LeqSym0 arg) (LeqSym1 arg) =>-        LeqSym0KindInference-    type instance Apply LeqSym0 l = LeqSym1 l-    type InsertSym2 (t :: Nat) (t :: [Nat]) = Insert t t-    instance SuppressUnusedWarnings InsertSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) InsertSym1KindInference) GHC.Tuple.())-    data InsertSym1 (l :: Nat) (l :: TyFun [Nat] [Nat])-      = forall arg. SameKind (Apply (InsertSym1 l) arg) (InsertSym2 l arg) =>-        InsertSym1KindInference-    type instance Apply (InsertSym1 l) l = Insert l l-    instance SuppressUnusedWarnings InsertSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) InsertSym0KindInference) GHC.Tuple.())-    data InsertSym0 (l :: TyFun Nat (TyFun [Nat] [Nat] -> Type))-      = forall arg. SameKind (Apply InsertSym0 arg) (InsertSym1 arg) =>-        InsertSym0KindInference-    type instance Apply InsertSym0 l = InsertSym1 l-    type InsertionSortSym1 (t :: [Nat]) = InsertionSort t-    instance SuppressUnusedWarnings InsertionSortSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) InsertionSortSym0KindInference) GHC.Tuple.())-    data InsertionSortSym0 (l :: TyFun [Nat] [Nat])-      = forall arg. SameKind (Apply InsertionSortSym0 arg) (InsertionSortSym1 arg) =>-        InsertionSortSym0KindInference-    type instance Apply InsertionSortSym0 l = InsertionSort l-    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)
− 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.ghc84.template 
@@ -1,70 +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 (:+@#@$$$) (t :: Foo) (t :: Foo) = (:+) t t-    instance SuppressUnusedWarnings (:+@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+@#@$$###)) GHC.Tuple.())-    data (:+@#@$$) (l :: Foo) (l :: TyFun Foo Foo)-      = forall arg. SameKind (Apply ((:+@#@$$) l) arg) ((:+@#@$$$) l arg) =>-        (::+@#@$$###)-    type instance Apply ((:+@#@$$) l) l = (:+) l l-    instance SuppressUnusedWarnings (:+@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+@#@$###)) GHC.Tuple.())-    data (:+@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>-        (::+@#@$###)-    type instance Apply (:+@#@$) l = (:+@#@$$) l-    type BarSym5 (t :: Bar) (t :: Bar) (t :: Bar) (t :: Bar) (t :: Foo) =-        Bar t t t t t-    instance SuppressUnusedWarnings BarSym4 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym4KindInference) GHC.Tuple.())-    data BarSym4 (l :: Bar) (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Foo Bar)-      = forall arg. SameKind (Apply (BarSym4 l l l l) arg) (BarSym5 l l l l arg) =>-        BarSym4KindInference-    type instance Apply (BarSym4 l l l l) l = Bar l l l l l-    instance SuppressUnusedWarnings BarSym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym3KindInference) GHC.Tuple.())-    data BarSym3 (l :: Bar) (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Foo Bar-                                                                   -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BarSym3 l l l) arg) (BarSym4 l l l arg) =>-        BarSym3KindInference-    type instance Apply (BarSym3 l l l) l = BarSym4 l l l l-    instance SuppressUnusedWarnings BarSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym2KindInference) GHC.Tuple.())-    data BarSym2 (l :: Bar) (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Foo Bar-                                                                   -> GHC.Types.Type)-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BarSym2 l l) arg) (BarSym3 l l arg) =>-        BarSym2KindInference-    type instance Apply (BarSym2 l l) l = BarSym3 l l l-    instance SuppressUnusedWarnings BarSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.())-    data BarSym1 (l :: Bar) (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar-                                                                   -> GHC.Types.Type)-                                                        -> GHC.Types.Type)-                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) =>-        BarSym1KindInference-    type instance Apply (BarSym1 l) l = BarSym2 l l-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun Bar (TyFun Bar (TyFun Bar (TyFun Bar (TyFun Foo Bar-                                                                   -> GHC.Types.Type)-                                                        -> GHC.Types.Type)-                                             -> GHC.Types.Type)-                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 l
− tests/compile-and-dump/Promote/Constructors.hs 
@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,47 +0,0 @@-Promote/GenDefunSymbols.hs:0:0:: Splicing declarations-    genDefunSymbols [''LiftMaybe, ''NatT, ''(:+)]-  ======>-    type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210-                             -> Type) (t :: Maybe a0123456789876543210) =-        LiftMaybe t t-    instance SuppressUnusedWarnings LiftMaybeSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.())-    data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210-                             -> Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210))-      = forall arg. Data.Singletons.Internal.SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) =>-        LiftMaybeSym1KindInference-    type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l-    instance SuppressUnusedWarnings LiftMaybeSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.())-    data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                                    -> Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)-                                              -> Type))-      = forall arg. Data.Singletons.Internal.SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>-        LiftMaybeSym0KindInference-    type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l-    type ZeroSym0 = Zero-    type SuccSym1 (t :: NatT) = Succ t-    instance SuppressUnusedWarnings SuccSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.())-    data SuccSym0 (l :: TyFun NatT NatT)-      = forall arg. Data.Singletons.Internal.SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = Succ l-    type (:+@#@$$$) (t :: Nat) (t :: Nat) = (:+) t t-    instance SuppressUnusedWarnings (:+@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+@#@$$###)) GHC.Tuple.())-    data (:+@#@$$) (l :: Nat) l-      = forall arg. Data.Singletons.Internal.SameKind (Apply ((:+@#@$$) l) arg) ((:+@#@$$$) l arg) =>-        (::+@#@$$###)-    type instance Apply ((:+@#@$$) l) l = (:+) l l-    instance SuppressUnusedWarnings (:+@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+@#@$###)) GHC.Tuple.())-    data (:+@#@$) l-      = forall arg. Data.Singletons.Internal.SameKind (Apply (:+@#@$) arg) ((:+@#@$$) arg) =>-        (::+@#@$###)-    type instance Apply (:+@#@$) l = (:+@#@$$) l
− tests/compile-and-dump/Promote/GenDefunSymbols.hs 
@@ -1,19 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--module Promote.GenDefunSymbols where--import Data.Singletons (Apply, TyFun)-import Data.Singletons.Promote-import Data.Singletons.SuppressUnusedWarnings-import GHC.TypeLits hiding (type (*))-import Data.Kind--type family LiftMaybe (f :: TyFun 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.ghc84.template 
@@ -1,42 +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 (t :: Bar) = UnBar t-    instance SuppressUnusedWarnings UnBarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) UnBarSym0KindInference) GHC.Tuple.())-    data UnBarSym0 (l :: TyFun Bar Nat)-      = forall arg. SameKind (Apply UnBarSym0 arg) (UnBarSym1 arg) =>-        UnBarSym0KindInference-    type instance Apply UnBarSym0 l = UnBar l-    type family UnBar (a :: Bar) :: Nat where-      UnBar (Bar field) = field-    type FooSym1 (t :: Nat) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun Nat Foo)-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    type BarSym1 (t :: Nat) = Bar t-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun Nat Bar)-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = Bar l
− tests/compile-and-dump/Promote/Newtypes.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.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.Promotion.Prelude--$(promote [d|-  {-# INLINE foo #-}-  foo :: Bool-  foo = True- |])
− tests/compile-and-dump/Promote/Prelude.ghc84.template 
@@ -1,17 +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 (t :: Nat) = Odd t-    instance SuppressUnusedWarnings OddSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) OddSym0KindInference) GHC.Tuple.())-    data OddSym0 (l :: TyFun Nat Bool)-      = forall arg. Data.Singletons.Internal.SameKind (Apply OddSym0 arg) (OddSym1 arg) =>-        OddSym0KindInference-    type instance Apply OddSym0 l = Odd l-    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.Promotion.TH-import Data.Promotion.Prelude-import Data.Promotion.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.ghc84.template 
@@ -1,48 +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 t = Z t-    instance SuppressUnusedWarnings ZSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ZSym0KindInference) GHC.Tuple.())-    data ZSym0 l-      = forall arg. SameKind (Apply ZSym0 arg) (ZSym1 arg) =>-        ZSym0KindInference-    type instance Apply ZSym0 l = Z l-    type family Z a where-      Z (X1 x) = x-      Z (X2 x) = x-    type YSym1 (t :: X) = Y t-    instance SuppressUnusedWarnings YSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) YSym0KindInference) GHC.Tuple.())-    data YSym0 (l :: TyFun X Symbol)-      = forall arg. SameKind (Apply YSym0 arg) (YSym1 arg) =>-        YSym0KindInference-    type instance Apply YSym0 l = Y l-    type family Y (a :: X) :: Symbol where-      Y (X1 field) = field-      Y (X2 field) = field-    type X1Sym1 (t :: Symbol) = X1 t-    instance SuppressUnusedWarnings X1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) X1Sym0KindInference) GHC.Tuple.())-    data X1Sym0 (l :: TyFun Symbol X)-      = forall arg. SameKind (Apply X1Sym0 arg) (X1Sym1 arg) =>-        X1Sym0KindInference-    type instance Apply X1Sym0 l = X1 l-    type X2Sym1 (t :: Symbol) = X2 t-    instance SuppressUnusedWarnings X2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) X2Sym0KindInference) GHC.Tuple.())-    data X2Sym0 (l :: TyFun Symbol X)-      = forall arg. SameKind (Apply X2Sym0 arg) (X2Sym1 arg) =>-        X2Sym0KindInference-    type instance Apply X2Sym0 l = X2 l
− 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/Singletons/AsPattern.ghc84.template 
@@ -1,352 +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@GHC.Types.[] = p-    foo p@[_] = p-    foo p@(_ GHC.Types.: (_ GHC.Types.: _)) = p-    type BazSym3 (t :: Nat) (t :: Nat) (t :: Nat) = Baz t t t-    instance SuppressUnusedWarnings BazSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BazSym2KindInference) GHC.Tuple.())-    data BazSym2 (l :: Nat) (l :: Nat) (l :: TyFun Nat Baz)-      = forall arg. SameKind (Apply (BazSym2 l l) arg) (BazSym3 l l arg) =>-        BazSym2KindInference-    type instance Apply (BazSym2 l l) l = Baz l l l-    instance SuppressUnusedWarnings BazSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BazSym1KindInference) GHC.Tuple.())-    data BazSym1 (l :: Nat) (l :: TyFun Nat (TyFun Nat Baz-                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BazSym1 l) arg) (BazSym2 l arg) =>-        BazSym1KindInference-    type instance Apply (BazSym1 l) l = BazSym2 l l-    instance SuppressUnusedWarnings BazSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.())-    data BazSym0 (l :: TyFun Nat (TyFun Nat (TyFun Nat Baz-                                             -> GHC.Types.Type)-                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) =>-        BazSym0KindInference-    type instance Apply BazSym0 l = BazSym1 l-    type Let0123456789876543210PSym0 = Let0123456789876543210P-    type family Let0123456789876543210P where-      Let0123456789876543210P = '[]-    type Let0123456789876543210PSym1 t = Let0123456789876543210P t-    instance SuppressUnusedWarnings Let0123456789876543210PSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>-        Let0123456789876543210PSym0KindInference-    type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210P l-    type family Let0123456789876543210P wild_0123456789876543210 where-      Let0123456789876543210P wild_0123456789876543210 = Apply (Apply (:@#@$) wild_0123456789876543210) '[]-    type Let0123456789876543210PSym3 t t t =-        Let0123456789876543210P t t t-    instance SuppressUnusedWarnings Let0123456789876543210PSym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym2 l l l-      = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) =>-        Let0123456789876543210PSym2KindInference-    type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l-    instance SuppressUnusedWarnings Let0123456789876543210PSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) =>-        Let0123456789876543210PSym1KindInference-    type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l-    instance SuppressUnusedWarnings Let0123456789876543210PSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>-        Let0123456789876543210PSym0KindInference-    type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l-    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 t t = Let0123456789876543210P t t-    instance SuppressUnusedWarnings Let0123456789876543210PSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) =>-        Let0123456789876543210PSym1KindInference-    type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210P l l-    instance SuppressUnusedWarnings Let0123456789876543210PSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>-        Let0123456789876543210PSym0KindInference-    type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l-    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 t t t =-        Let0123456789876543210P t t t-    instance SuppressUnusedWarnings Let0123456789876543210PSym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym2KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym2 l l l-      = forall arg. SameKind (Apply (Let0123456789876543210PSym2 l l) arg) (Let0123456789876543210PSym3 l l arg) =>-        Let0123456789876543210PSym2KindInference-    type instance Apply (Let0123456789876543210PSym2 l l) l = Let0123456789876543210P l l l-    instance SuppressUnusedWarnings Let0123456789876543210PSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210PSym1 l) arg) (Let0123456789876543210PSym2 l arg) =>-        Let0123456789876543210PSym1KindInference-    type instance Apply (Let0123456789876543210PSym1 l) l = Let0123456789876543210PSym2 l l-    instance SuppressUnusedWarnings Let0123456789876543210PSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210PSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210PSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210PSym0 arg) (Let0123456789876543210PSym1 arg) =>-        Let0123456789876543210PSym0KindInference-    type instance Apply Let0123456789876543210PSym0 l = Let0123456789876543210PSym1 l-    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 t = Let0123456789876543210X t-    instance SuppressUnusedWarnings Let0123456789876543210XSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210XSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) =>-        Let0123456789876543210XSym0KindInference-    type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l-    type family Let0123456789876543210X wild_0123456789876543210 where-      Let0123456789876543210X wild_0123456789876543210 = Apply JustSym0 wild_0123456789876543210-    type Let0123456789876543210PSym0 = Let0123456789876543210P-    type family Let0123456789876543210P where-      Let0123456789876543210P = NothingSym0-    type FooSym1 (t :: [Nat]) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun [Nat] [Nat])-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    type TupSym1 (t :: (Nat, Nat)) = Tup t-    instance SuppressUnusedWarnings TupSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) TupSym0KindInference) GHC.Tuple.())-    data TupSym0 (l :: TyFun (Nat, Nat) (Nat, Nat))-      = forall arg. SameKind (Apply TupSym0 arg) (TupSym1 arg) =>-        TupSym0KindInference-    type instance Apply TupSym0 l = Tup l-    type Baz_Sym1 (t :: Maybe Baz) = Baz_ t-    instance SuppressUnusedWarnings Baz_Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Baz_Sym0KindInference) GHC.Tuple.())-    data Baz_Sym0 (l :: TyFun (Maybe Baz) (Maybe Baz))-      = forall arg. SameKind (Apply Baz_Sym0 arg) (Baz_Sym1 arg) =>-        Baz_Sym0KindInference-    type instance Apply Baz_Sym0 l = Baz_ l-    type BarSym1 (t :: Maybe Nat) = Bar t-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun (Maybe Nat) (Maybe Nat))-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = Bar l-    type MaybePlusSym1 (t :: Maybe Nat) = MaybePlus t-    instance SuppressUnusedWarnings MaybePlusSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MaybePlusSym0KindInference) GHC.Tuple.())-    data MaybePlusSym0 (l :: TyFun (Maybe Nat) (Maybe Nat))-      = forall arg. SameKind (Apply MaybePlusSym0 arg) (MaybePlusSym1 arg) =>-        MaybePlusSym0KindInference-    type instance Apply MaybePlusSym0 l = MaybePlus l-    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-    data instance Sing (z :: Baz)-      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-              ((GHC.Tuple.(,,) (toSing b :: SomeSing Nat))-                 (toSing b :: SomeSing Nat))-                (toSing b :: SomeSing Nat)-          of {-            GHC.Tuple.(,,) (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
− 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.ghc84.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.ghc84.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.ghc84.template 
@@ -1,229 +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 (t :: a0123456789876543210) = Foo3 t-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789876543210 (Foo3 a0123456789876543210))-      = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3 l-    type Foo41Sym0 = Foo41-    type Foo42Sym0 = Foo42-    type PairSym2 (t :: Bool) (t :: Bool) = Pair t t-    instance SuppressUnusedWarnings PairSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.())-    data PairSym1 (l :: Bool) (l :: TyFun Bool Pair)-      = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = Pair l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.())-    data PairSym0 (l :: TyFun Bool (TyFun Bool Pair -> Type))-      = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>-        PairSym0KindInference-    type instance Apply PairSym0 l = PairSym1 l-    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 (z :: Foo1) 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 (z :: Foo2)-      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 (z :: Foo3 a)-      where SFoo3 :: forall (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 (z :: Foo4 a b)-      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 (z :: Pair)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing Bool))-                (toSing b :: SomeSing Bool)-          of {-            GHC.Tuple.(,) (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 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
− 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--$(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.ghc84.template 
@@ -1,42 +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 (t :: a0123456789876543210) = FBox t-    instance SuppressUnusedWarnings FBoxSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FBoxSym0KindInference) GHC.Tuple.())-    data FBoxSym0 (l :: TyFun a0123456789876543210 (Box a0123456789876543210))-      = forall arg. SameKind (Apply FBoxSym0 arg) (FBoxSym1 arg) =>-        FBoxSym0KindInference-    type instance Apply FBoxSym0 l = FBox l-    type UnBoxSym1 (t :: Box a0123456789876543210) = UnBox t-    instance SuppressUnusedWarnings UnBoxSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) UnBoxSym0KindInference) GHC.Tuple.())-    data UnBoxSym0 (l :: TyFun (Box a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply UnBoxSym0 arg) (UnBoxSym1 arg) =>-        UnBoxSym0KindInference-    type instance Apply UnBoxSym0 l = UnBox l-    type family UnBox (a :: Box a) :: a where-      UnBox (FBox a) = a-    sUnBox ::-      forall (t :: Box a). Sing t -> Sing (Apply UnBoxSym0 t :: a)-    sUnBox (SFBox (sA :: Sing a)) = sA-    data instance Sing (z :: Box a)-      where SFBox :: forall (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
− tests/compile-and-dump/Singletons/BoxUnBox.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,273 +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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type family Case_0123456789876543210 x t where-      Case_0123456789876543210 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y-    type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) =>-        Let0123456789876543210ZSym1KindInference-    type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l-    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 t t =-        Let0123456789876543210Scrutinee_0123456789876543210 t t-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym2 l arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym1KindInference-    type instance Apply (Let0123456789876543210Scrutinee_0123456789876543210Sym1 l) l = Let0123456789876543210Scrutinee_0123456789876543210 l l-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210Sym1 l-    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 t =-        Let0123456789876543210Scrutinee_0123456789876543210 t-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l-    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 (t :: a0123456789876543210) = Foo5 t-    instance SuppressUnusedWarnings Foo5Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.())-    data Foo5Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5 l-    type Foo4Sym1 (t :: a0123456789876543210) = Foo4 t-    instance SuppressUnusedWarnings Foo4Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.())-    data Foo4Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4 l-    type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo3 t t-    instance SuppressUnusedWarnings Foo3Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.())-    data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) =>-        Foo3Sym1KindInference-    type instance Apply (Foo3Sym1 l) l = Foo3 l l-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 l-    type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) =-        Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) =-        Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    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 (t :: a). Sing t -> Sing (Apply Foo5Sym0 t :: a)-    sFoo4 :: forall (t :: a). Sing t -> Sing (Apply Foo4Sym0 t :: a)-    sFoo3 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a)-    sFoo2 ::-      forall (t :: a) (t :: Maybe a).-      Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-    sFoo1 ::-      forall (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)
− tests/compile-and-dump/Singletons/CaseExpressions.hs 
@@ -1,67 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,533 +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 (t :: Foo) (t :: Foo) = FooCompare t t-    instance SuppressUnusedWarnings FooCompareSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooCompareSym1KindInference) GHC.Tuple.())-    data FooCompareSym1 (l :: Foo) (l :: TyFun Foo Ordering)-      = forall arg. SameKind (Apply (FooCompareSym1 l) arg) (FooCompareSym2 l arg) =>-        FooCompareSym1KindInference-    type instance Apply (FooCompareSym1 l) l = FooCompare l l-    instance SuppressUnusedWarnings FooCompareSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooCompareSym0KindInference) GHC.Tuple.())-    data FooCompareSym0 (l :: TyFun Foo (TyFun Foo Ordering-                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply FooCompareSym0 arg) (FooCompareSym1 arg) =>-        FooCompareSym0KindInference-    type instance Apply FooCompareSym0 l = FooCompareSym1 l-    type ConstSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Const t t-    instance SuppressUnusedWarnings ConstSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ConstSym1KindInference) GHC.Tuple.())-    data ConstSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (ConstSym1 l) arg) (ConstSym2 l arg) =>-        ConstSym1KindInference-    type instance Apply (ConstSym1 l) l = Const l l-    instance SuppressUnusedWarnings ConstSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ConstSym0KindInference) GHC.Tuple.())-    data ConstSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply ConstSym0 arg) (ConstSym1 arg) =>-        ConstSym0KindInference-    type instance Apply ConstSym0 l = ConstSym1 l-    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 (t :: a0123456789876543210) (t :: a0123456789876543210) =-        Mycompare t t-    instance SuppressUnusedWarnings MycompareSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MycompareSym1KindInference) GHC.Tuple.())-    data MycompareSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering)-      = forall arg. SameKind (Apply (MycompareSym1 l) arg) (MycompareSym2 l arg) =>-        MycompareSym1KindInference-    type instance Apply (MycompareSym1 l) l = Mycompare l l-    instance SuppressUnusedWarnings MycompareSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MycompareSym0KindInference) GHC.Tuple.())-    data MycompareSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering-                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply MycompareSym0 arg) (MycompareSym1 arg) =>-        MycompareSym0KindInference-    type instance Apply MycompareSym0 l = MycompareSym1 l-    type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) =-        (<=>) t t-    instance SuppressUnusedWarnings (<=>@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.())-    data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering)-      = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) =>-        (:<=>@#@$$###)-    type instance Apply ((<=>@#@$$) l) l = (<=>) l l-    instance SuppressUnusedWarnings (<=>@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.())-    data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>-        (:<=>@#@$###)-    type instance Apply (<=>@#@$) l = (<=>@#@$$) l-    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 (t :: a0123456789876543210) (t :: a0123456789876543210) =-        TFHelper_0123456789876543210 t t-    instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data TFHelper_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering)-      = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) =>-        TFHelper_0123456789876543210Sym1KindInference-    type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l-    instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data TFHelper_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering-                                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>-        TFHelper_0123456789876543210Sym0KindInference-    type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l-    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 (t :: Nat) (t :: Nat) =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    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 (t :: ()) (t :: ()) =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: ()) (l :: TyFun () Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun () (TyFun () Ordering-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    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 (t :: Foo) (t :: Foo) =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: Foo) (l :: TyFun Foo Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo (TyFun Foo Ordering-                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    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 (t :: Foo2) (t :: Foo2) =-        TFHelper_0123456789876543210 t t-    instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data TFHelper_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Bool)-      = forall arg. SameKind (Apply (TFHelper_0123456789876543210Sym1 l) arg) (TFHelper_0123456789876543210Sym2 l arg) =>-        TFHelper_0123456789876543210Sym1KindInference-    type instance Apply (TFHelper_0123456789876543210Sym1 l) l = TFHelper_0123456789876543210 l l-    instance SuppressUnusedWarnings TFHelper_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) TFHelper_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data TFHelper_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Bool-                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply TFHelper_0123456789876543210Sym0 arg) (TFHelper_0123456789876543210Sym1 arg) =>-        TFHelper_0123456789876543210Sym0KindInference-    type instance Apply TFHelper_0123456789876543210Sym0 l = TFHelper_0123456789876543210Sym1 l-    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 (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-    data instance Sing (z :: Foo)-      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 (z :: Foo2)-      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-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 (t :: Foo2) (t :: Foo2) =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering-                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    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 (t :: Foo2) (t :: Foo2) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Foo2) (l :: TyFun Foo2 Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Foo2 (TyFun Foo2 Ordering-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: Nat') = Succ' t-    instance SuppressUnusedWarnings Succ'Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Succ'Sym0KindInference) GHC.Tuple.())-    data Succ'Sym0 (l :: TyFun Nat' Nat')-      = forall arg. SameKind (Apply Succ'Sym0 arg) (Succ'Sym1 arg) =>-        Succ'Sym0KindInference-    type instance Apply Succ'Sym0 l = Succ' l-    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 (t :: Nat') (t :: Nat') =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: Nat') (l :: TyFun Nat' Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun Nat' (TyFun Nat' Ordering-                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    instance PMyOrd Nat' where-      type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a-    data instance Sing (z :: Nat')-      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' (TyFun Nat' Ordering-                                                               -> GHC.Types.Type)-                                                   -> 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
− 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.ghc84.template 
@@ -1,86 +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 (t :: NatFoo) = SuccFoo t-    instance SuppressUnusedWarnings SuccFooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccFooSym0KindInference) GHC.Tuple.())-    data SuccFooSym0 (l :: TyFun NatFoo NatFoo)-      = forall arg. SameKind (Apply SuccFooSym0 arg) (SuccFooSym1 arg) =>-        SuccFooSym0KindInference-    type instance Apply SuccFooSym0 l = SuccFoo l-    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 (t :: NatFoo) (t :: NatFoo) =-        Mycompare_0123456789876543210 t t-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym1 (l :: NatFoo) (l :: TyFun NatFoo Ordering)-      = forall arg. SameKind (Apply (Mycompare_0123456789876543210Sym1 l) arg) (Mycompare_0123456789876543210Sym2 l arg) =>-        Mycompare_0123456789876543210Sym1KindInference-    type instance Apply (Mycompare_0123456789876543210Sym1 l) l = Mycompare_0123456789876543210 l l-    instance SuppressUnusedWarnings Mycompare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Mycompare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Mycompare_0123456789876543210Sym0 (l :: TyFun NatFoo (TyFun NatFoo Ordering-                                                               -> GHC.Types.Type))-      = forall arg. SameKind (Apply Mycompare_0123456789876543210Sym0 arg) (Mycompare_0123456789876543210Sym1 arg) =>-        Mycompare_0123456789876543210Sym0KindInference-    type instance Apply Mycompare_0123456789876543210Sym0 l = Mycompare_0123456789876543210Sym1 l-    instance PMyOrd NatFoo where-      type Mycompare a a = Apply (Apply Mycompare_0123456789876543210Sym0 a) a-    data instance Sing (z :: NatFoo)-      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 (TyFun NatFoo Ordering-                                                                 -> GHC.Types.Type)-                                                   -> 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
− 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.ghc84.template 
@@ -1,41 +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 _ GHC.Types.[] = False-    contains elt (h GHC.Types.: t) = ((elt == h) || ((contains elt) t))-    type ContainsSym2 (t :: a0123456789876543210) (t :: [a0123456789876543210]) =-        Contains t t-    instance SuppressUnusedWarnings ContainsSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ContainsSym1KindInference) GHC.Tuple.())-    data ContainsSym1 (l :: a0123456789876543210) (l :: TyFun [a0123456789876543210] Bool)-      = forall arg. SameKind (Apply (ContainsSym1 l) arg) (ContainsSym2 l arg) =>-        ContainsSym1KindInference-    type instance Apply (ContainsSym1 l) l = Contains l l-    instance SuppressUnusedWarnings ContainsSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ContainsSym0KindInference) GHC.Tuple.())-    data ContainsSym0 (l :: TyFun a0123456789876543210 (TyFun [a0123456789876543210] Bool-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply ContainsSym0 arg) (ContainsSym1 arg) =>-        ContainsSym0KindInference-    type instance Apply ContainsSym0 l = ContainsSym1 l-    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 (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)
− 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.ghc84.template 
@@ -1,187 +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 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Pair t t-    instance SuppressUnusedWarnings PairSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.())-    data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = Pair l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.())-    data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>-        PairSym0KindInference-    type instance Apply PairSym0 l = PairSym1 l-    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 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol-                                                                                                                              -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol-                                                                                                                              -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (z :: Pair a b)-      where-        SPair :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (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 (TyFun (Pair a b) (TyFun Symbol Symbol-                                                                                                    -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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-    instance (Data.Singletons.ShowSing.ShowSing a,-              Data.Singletons.ShowSing.ShowSing b) =>-             Data.Singletons.ShowSing.ShowSing (Pair a b) where-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SPair arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SPair "))-               (((.)-                   ((Data.Singletons.ShowSing.showsSingPrec 11)-                      arg_0123456789876543210))-                  (((.) GHC.Show.showSpace)-                     ((Data.Singletons.ShowSing.showsSingPrec 11)-                        arg_0123456789876543210))))-    instance (Data.Singletons.ShowSing.ShowSing a,-              Data.Singletons.ShowSing.ShowSing b) =>-             Show (Sing (z :: Pair a b)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where-      sing = (SPair sing) sing
− 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.ghc84.template 
@@ -1,10 +0,0 @@-Singletons/Empty.hs:(0,0)-(0,0): Splicing declarations-    singletons [d| data Empty |]-  ======>-    data Empty-    data instance Sing (z :: Empty)-    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.ghc84.template 
@@ -1,74 +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 (t :: GHC.Types.Nat) (t :: Foo) (t :: GHC.Types.Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                 -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    instance PShow Foo where-      type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a-    data instance Sing (z :: Foo)-    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 (TyFun Foo (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                             -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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-    instance Data.Singletons.ShowSing.ShowSing Foo where-      Data.Singletons.ShowSing.showsSingPrec _ v_0123456789876543210-        = case v_0123456789876543210 of-    instance Show (Sing (z :: Foo)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec
− 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.ghc84.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 (t :: GHC.Types.Nat) =-        ToEnum_0123456789876543210 t-    instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Foo)-      = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>-        ToEnum_0123456789876543210Sym0KindInference-    type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l-    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 (t :: Foo) =-        FromEnum_0123456789876543210 t-    instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FromEnum_0123456789876543210Sym0 (l :: TyFun Foo GHC.Types.Nat)-      = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>-        FromEnum_0123456789876543210Sym0KindInference-    type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l-    instance PEnum Foo where-      type ToEnum a = Apply ToEnum_0123456789876543210Sym0 a-      type FromEnum a = Apply FromEnum_0123456789876543210Sym0 a-    data instance Sing (z :: Foo)-      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 (z :: Quux)-      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 (t :: GHC.Types.Nat) =-        ToEnum_0123456789876543210 t-    instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat Quux)-      = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>-        ToEnum_0123456789876543210Sym0KindInference-    type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l-    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 (t :: Quux) =-        FromEnum_0123456789876543210 t-    instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FromEnum_0123456789876543210Sym0 (l :: TyFun Quux GHC.Types.Nat)-      = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>-        FromEnum_0123456789876543210Sym0KindInference-    type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l-    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.ghc84.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.ghc84.template 
@@ -1,24 +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 GHC.Types.: _) = a-    head GHC.Types.[] = error "Data.Singletons.List.head: empty list"-    type HeadSym1 (t :: [a0123456789876543210]) = Head t-    instance SuppressUnusedWarnings HeadSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) HeadSym0KindInference) GHC.Tuple.())-    data HeadSym0 (l :: TyFun [a0123456789876543210] a0123456789876543210)-      = forall arg. SameKind (Apply HeadSym0 arg) (HeadSym1 arg) =>-        HeadSym0KindInference-    type instance Apply HeadSym0 l = Head l-    type family Head (a :: [a]) :: a where-      Head ((:) a _) = a-      Head '[] = Apply ErrorSym0 "Data.Singletons.List.head: empty list"-    sHead :: forall (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")
− 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)-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.ghc84.template 
@@ -1,66 +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 (====@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) =-        (====) t t-    instance SuppressUnusedWarnings (====@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:====@#@$$###)) GHC.Tuple.())-    data (====@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply ((====@#@$$) l) arg) ((====@#@$$$) l arg) =>-        (:====@#@$$###)-    type instance Apply ((====@#@$$) l) l = (====) l l-    instance SuppressUnusedWarnings (====@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:====@#@$###)) GHC.Tuple.())-    data (====@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210-                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply (====@#@$) arg) ((====@#@$$) arg) =>-        (:====@#@$###)-    type instance Apply (====@#@$) l = (====@#@$$) l-    type family (====) (a :: a) (a :: a) :: a where-      (====) a _ = a-    type (<=>@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) =-        (<=>) t t-    instance SuppressUnusedWarnings (<=>@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<=>@#@$$###)) GHC.Tuple.())-    data (<=>@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 Ordering)-      = forall arg. SameKind (Apply ((<=>@#@$$) l) arg) ((<=>@#@$$$) l arg) =>-        (:<=>@#@$$###)-    type instance Apply ((<=>@#@$$) l) l = (<=>) l l-    instance SuppressUnusedWarnings (<=>@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<=>@#@$###)) GHC.Tuple.())-    data (<=>@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 Ordering-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (<=>@#@$) arg) ((<=>@#@$$) arg) =>-        (:<=>@#@$###)-    type instance Apply (<=>@#@$) l = (<=>@#@$$) l-    class PMyOrd (a :: GHC.Types.Type) where-      type (<=>) (arg :: a) (arg :: a) :: Ordering-    infix 4 %====-    infix 4 %<=>-    (%====) ::-      forall (t :: a) (t :: a).-      Sing t -> Sing t -> Sing (Apply (Apply (====@#@$) t) t :: a)-    (%====) (sA :: Sing a) _ = sA-    class SMyOrd a where-      (%<=>) ::-        forall (t :: a) (t :: a).-        Sing t -> Sing t -> Sing (Apply (Apply (<=>@#@$) t) t :: Ordering)
− 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.ghc84.template 
@@ -1,86 +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 (t :: a0123456789876543210) = Meth t-    instance SuppressUnusedWarnings MethSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.())-    data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) =>-        MethSym0KindInference-    type instance Apply MethSym0 l = Meth l-    type L2rSym1 (t :: a0123456789876543210) = L2r t-    instance SuppressUnusedWarnings L2rSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) L2rSym0KindInference) GHC.Tuple.())-    data L2rSym0 (l :: TyFun a0123456789876543210 b0123456789876543210)-      = forall arg. SameKind (Apply L2rSym0 arg) (L2rSym1 arg) =>-        L2rSym0KindInference-    type instance Apply L2rSym0 l = L2r l-    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 (t :: Bool) =-        Meth_0123456789876543210 t-    instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) =>-        Meth_0123456789876543210Sym0KindInference-    type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l-    type family L2r_0123456789876543210 (a :: Bool) :: Nat where-      L2r_0123456789876543210 False = FromInteger 0-      L2r_0123456789876543210 True = FromInteger 1-    type L2r_0123456789876543210Sym1 (t :: Bool) =-        L2r_0123456789876543210 t-    instance SuppressUnusedWarnings L2r_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) L2r_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data L2r_0123456789876543210Sym0 (l :: TyFun Bool Nat)-      = forall arg. SameKind (Apply L2r_0123456789876543210Sym0 arg) (L2r_0123456789876543210Sym1 arg) =>-        L2r_0123456789876543210Sym0KindInference-    type instance Apply L2r_0123456789876543210Sym0 l = L2r_0123456789876543210 l-    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)
− 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/HigherOrder.ghc84.template 
@@ -1,424 +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 _ GHC.Types.[] = []-    map f (h GHC.Types.: t) = ((f h) GHC.Types.: ((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 GHC.Types.: xs) (y GHC.Types.: ys)-      = (((f x) y) GHC.Types.: (((zipWith f) xs) ys))-    zipWith _ GHC.Types.[] GHC.Types.[] = []-    zipWith _ (_ GHC.Types.: _) GHC.Types.[] = []-    zipWith _ GHC.Types.[] (_ GHC.Types.: _) = []-    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 (t :: a0123456789876543210) = Left t-    instance SuppressUnusedWarnings LeftSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LeftSym0KindInference) GHC.Tuple.())-    data LeftSym0 (l :: TyFun a0123456789876543210 (Either a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply LeftSym0 arg) (LeftSym1 arg) =>-        LeftSym0KindInference-    type instance Apply LeftSym0 l = Left l-    type RightSym1 (t :: b0123456789876543210) = Right t-    instance SuppressUnusedWarnings RightSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) RightSym0KindInference) GHC.Tuple.())-    data RightSym0 (l :: TyFun b0123456789876543210 (Either a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply RightSym0 arg) (RightSym1 arg) =>-        RightSym0KindInference-    type instance Apply RightSym0 l = Right l-    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 t t t t =-        Lambda_0123456789876543210 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t t =-        Lambda_0123456789876543210 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type FooSym3 (t :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                              -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type) (t :: TyFun a0123456789876543210 b0123456789876543210-                                                -> GHC.Types.Type) (t :: a0123456789876543210) =-        Foo t t t-    instance SuppressUnusedWarnings FooSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym2KindInference) GHC.Tuple.())-    data FooSym2 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                              -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210-                                                -> GHC.Types.Type) (l :: TyFun a0123456789876543210 b0123456789876543210)-      = forall arg. SameKind (Apply (FooSym2 l l) arg) (FooSym3 l l arg) =>-        FooSym2KindInference-    type instance Apply (FooSym2 l l) l = Foo l l l-    instance SuppressUnusedWarnings FooSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.())-    data FooSym1 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                              -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                  -> GHC.Types.Type)-                       -> GHC.Types.Type) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                                                       -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) =>-        FooSym1KindInference-    type instance Apply (FooSym1 l) l = FooSym2 l l-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun (TyFun (TyFun a0123456789876543210 b0123456789876543210-                                     -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                         -> GHC.Types.Type)-                              -> GHC.Types.Type) (TyFun (TyFun a0123456789876543210 b0123456789876543210-                                                         -> GHC.Types.Type) (TyFun a0123456789876543210 b0123456789876543210-                                                                             -> GHC.Types.Type)-                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    type ZipWithSym3 (t :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210-                                                       -> GHC.Types.Type)-                           -> GHC.Types.Type) (t :: [a0123456789876543210]) (t :: [b0123456789876543210]) =-        ZipWith t t t-    instance SuppressUnusedWarnings ZipWithSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ZipWithSym2KindInference) GHC.Tuple.())-    data ZipWithSym2 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210-                                                       -> GHC.Types.Type)-                           -> GHC.Types.Type) (l :: [a0123456789876543210]) (l :: TyFun [b0123456789876543210] [c0123456789876543210])-      = forall arg. SameKind (Apply (ZipWithSym2 l l) arg) (ZipWithSym3 l l arg) =>-        ZipWithSym2KindInference-    type instance Apply (ZipWithSym2 l l) l = ZipWith l l l-    instance SuppressUnusedWarnings ZipWithSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ZipWithSym1KindInference) GHC.Tuple.())-    data ZipWithSym1 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210-                                                       -> GHC.Types.Type)-                           -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210]-                                                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ZipWithSym1 l) arg) (ZipWithSym2 l arg) =>-        ZipWithSym1KindInference-    type instance Apply (ZipWithSym1 l) l = ZipWithSym2 l l-    instance SuppressUnusedWarnings ZipWithSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ZipWithSym0KindInference) GHC.Tuple.())-    data ZipWithSym0 (l :: TyFun (TyFun a0123456789876543210 (TyFun b0123456789876543210 c0123456789876543210-                                                              -> GHC.Types.Type)-                                  -> GHC.Types.Type) (TyFun [a0123456789876543210] (TyFun [b0123456789876543210] [c0123456789876543210]-                                                                                    -> GHC.Types.Type)-                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ZipWithSym0 arg) (ZipWithSym1 arg) =>-        ZipWithSym0KindInference-    type instance Apply ZipWithSym0 l = ZipWithSym1 l-    type SplungeSym2 (t :: [Nat]) (t :: [Bool]) = Splunge t t-    instance SuppressUnusedWarnings SplungeSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SplungeSym1KindInference) GHC.Tuple.())-    data SplungeSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat])-      = forall arg. SameKind (Apply (SplungeSym1 l) arg) (SplungeSym2 l arg) =>-        SplungeSym1KindInference-    type instance Apply (SplungeSym1 l) l = Splunge l l-    instance SuppressUnusedWarnings SplungeSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SplungeSym0KindInference) GHC.Tuple.())-    data SplungeSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat]-                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply SplungeSym0 arg) (SplungeSym1 arg) =>-        SplungeSym0KindInference-    type instance Apply SplungeSym0 l = SplungeSym1 l-    type EtadSym2 (t :: [Nat]) (t :: [Bool]) = Etad t t-    instance SuppressUnusedWarnings EtadSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) EtadSym1KindInference) GHC.Tuple.())-    data EtadSym1 (l :: [Nat]) (l :: TyFun [Bool] [Nat])-      = forall arg. SameKind (Apply (EtadSym1 l) arg) (EtadSym2 l arg) =>-        EtadSym1KindInference-    type instance Apply (EtadSym1 l) l = Etad l l-    instance SuppressUnusedWarnings EtadSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) EtadSym0KindInference) GHC.Tuple.())-    data EtadSym0 (l :: TyFun [Nat] (TyFun [Bool] [Nat]-                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply EtadSym0 arg) (EtadSym1 arg) =>-        EtadSym0KindInference-    type instance Apply EtadSym0 l = EtadSym1 l-    type LiftMaybeSym2 (t :: TyFun a0123456789876543210 b0123456789876543210-                             -> GHC.Types.Type) (t :: Maybe a0123456789876543210) =-        LiftMaybe t t-    instance SuppressUnusedWarnings LiftMaybeSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LiftMaybeSym1KindInference) GHC.Tuple.())-    data LiftMaybeSym1 (l :: TyFun a0123456789876543210 b0123456789876543210-                             -> GHC.Types.Type) (l :: TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210))-      = forall arg. SameKind (Apply (LiftMaybeSym1 l) arg) (LiftMaybeSym2 l arg) =>-        LiftMaybeSym1KindInference-    type instance Apply (LiftMaybeSym1 l) l = LiftMaybe l l-    instance SuppressUnusedWarnings LiftMaybeSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LiftMaybeSym0KindInference) GHC.Tuple.())-    data LiftMaybeSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                                    -> GHC.Types.Type) (TyFun (Maybe a0123456789876543210) (Maybe b0123456789876543210)-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply LiftMaybeSym0 arg) (LiftMaybeSym1 arg) =>-        LiftMaybeSym0KindInference-    type instance Apply LiftMaybeSym0 l = LiftMaybeSym1 l-    type MapSym2 (t :: TyFun a0123456789876543210 b0123456789876543210-                       -> GHC.Types.Type) (t :: [a0123456789876543210]) =-        Map t t-    instance SuppressUnusedWarnings MapSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MapSym1KindInference) GHC.Tuple.())-    data MapSym1 (l :: TyFun a0123456789876543210 b0123456789876543210-                       -> GHC.Types.Type) (l :: TyFun [a0123456789876543210] [b0123456789876543210])-      = forall arg. SameKind (Apply (MapSym1 l) arg) (MapSym2 l arg) =>-        MapSym1KindInference-    type instance Apply (MapSym1 l) l = Map l l-    instance SuppressUnusedWarnings MapSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MapSym0KindInference) GHC.Tuple.())-    data MapSym0 (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                              -> GHC.Types.Type) (TyFun [a0123456789876543210] [b0123456789876543210]-                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply MapSym0 arg) (MapSym1 arg) =>-        MapSym0KindInference-    type instance Apply MapSym0 l = MapSym1 l-    type family Foo (a :: TyFun (TyFun a b-                                 -> GHC.Types.Type) (TyFun a b -> GHC.Types.Type)-                          -> GHC.Types.Type) (a :: TyFun a b-                                                   -> GHC.Types.Type) (a :: a) :: b where-      Foo f g a = Apply (Apply f g) a-    type family ZipWith (a :: TyFun a (TyFun b c -> GHC.Types.Type)-                              -> GHC.Types.Type) (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 :: TyFun a b-                                -> GHC.Types.Type) (a :: Maybe a) :: Maybe b where-      LiftMaybe f (Just x) = Apply JustSym0 (Apply f x)-      LiftMaybe _ Nothing = NothingSym0-    type family Map (a :: TyFun a b-                          -> GHC.Types.Type) (a :: [a]) :: [b] where-      Map _ '[] = '[]-      Map f ((:) h t) = Apply (Apply (:@#@$) (Apply f h)) (Apply (Apply MapSym0 f) t)-    sFoo ::-      forall (t :: TyFun (TyFun a b -> GHC.Types.Type) (TyFun a b-                                                        -> GHC.Types.Type)-                   -> GHC.Types.Type)-             (t :: TyFun a b -> GHC.Types.Type)-             (t :: a).-      Sing t-      -> Sing t-         -> Sing t -> Sing (Apply (Apply (Apply FooSym0 t) t) t :: b)-    sZipWith ::-      forall (t :: TyFun a (TyFun b c -> GHC.Types.Type)-                   -> GHC.Types.Type)-             (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 (t :: TyFun a b -> GHC.Types.Type) (t :: Maybe a).-      Sing t-      -> Sing t -> Sing (Apply (Apply LiftMaybeSym0 t) t :: Maybe b)-    sMap ::-      forall (t :: TyFun a b -> GHC.Types.Type) (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 (GHC.Tuple.(,) sN) sB of {-                             GHC.Tuple.(,) (_ :: 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 (GHC.Tuple.(,) sN) sB of {-                             GHC.Tuple.(,) (_ :: 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)-    data instance Sing (z :: Either a b)-      where-        SLeft :: forall (n :: a). (Sing (n :: a)) -> Sing (Left n)-        SRight :: forall (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 n => SingI (Right (n :: b)) where-      sing = SRight sing
− 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.ghc84.template 
@@ -1,221 +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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t =-        Lambda_0123456789876543210 t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type Foo3Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo3 t t-    instance SuppressUnusedWarnings Foo3Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym1KindInference) GHC.Tuple.())-    data Foo3Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo3Sym1 l) arg) (Foo3Sym2 l arg) =>-        Foo3Sym1KindInference-    type instance Apply (Foo3Sym1 l) l = Foo3 l l-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3Sym1 l-    type Foo2Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) =-        Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789876543210) (t :: Maybe a0123456789876543210) =-        Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun (Maybe a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun (Maybe a0123456789876543210) a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    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 (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo3Sym0 t) t :: a)-    sFoo2 ::-      forall (t :: a) (t :: Maybe a).-      Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-    sFoo1 ::-      forall (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
− 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.ghc84.template 
@@ -1,704 +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 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo t t-    instance SuppressUnusedWarnings FooSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym1KindInference) GHC.Tuple.())-    data FooSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply (FooSym1 l) arg) (FooSym2 l arg) =>-        FooSym1KindInference-    type instance Apply (FooSym1 l) l = Foo l l-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)-                                                   -> GHC.Types.Type))-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = FooSym1 l-    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 t t =-        Lambda_0123456789876543210 t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t t =-        Lambda_0123456789876543210 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type family Lambda_0123456789876543210 a b t where-      Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x-    type Lambda_0123456789876543210Sym3 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type family Lambda_0123456789876543210 x y t where-      Lambda_0123456789876543210 x y x = x-    type Lambda_0123456789876543210Sym3 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t t t =-        Lambda_0123456789876543210 t t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym4 l l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) =>-        Lambda_0123456789876543210Sym4KindInference-    type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type family Lambda_0123456789876543210 x t where-      Lambda_0123456789876543210 x y = y-    type Lambda_0123456789876543210Sym2 t t =-        Lambda_0123456789876543210 t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where-      Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x-    type Lambda_0123456789876543210Sym4 t t t t =-        Lambda_0123456789876543210 t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type Foo8Sym1 (t :: Foo a0123456789876543210 b0123456789876543210) =-        Foo8 t-    instance SuppressUnusedWarnings Foo8Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.())-    data Foo8Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>-        Foo8Sym0KindInference-    type instance Apply Foo8Sym0 l = Foo8 l-    type Foo7Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo7 t t-    instance SuppressUnusedWarnings Foo7Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo7Sym1KindInference) GHC.Tuple.())-    data Foo7Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210)-      = forall arg. SameKind (Apply (Foo7Sym1 l) arg) (Foo7Sym2 l arg) =>-        Foo7Sym1KindInference-    type instance Apply (Foo7Sym1 l) l = Foo7 l l-    instance SuppressUnusedWarnings Foo7Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.())-    data Foo7Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>-        Foo7Sym0KindInference-    type instance Apply Foo7Sym0 l = Foo7Sym1 l-    type Foo6Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo6 t t-    instance SuppressUnusedWarnings Foo6Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo6Sym1KindInference) GHC.Tuple.())-    data Foo6Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo6Sym1 l) arg) (Foo6Sym2 l arg) =>-        Foo6Sym1KindInference-    type instance Apply (Foo6Sym1 l) l = Foo6 l l-    instance SuppressUnusedWarnings Foo6Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.())-    data Foo6Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>-        Foo6Sym0KindInference-    type instance Apply Foo6Sym0 l = Foo6Sym1 l-    type Foo5Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo5 t t-    instance SuppressUnusedWarnings Foo5Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo5Sym1KindInference) GHC.Tuple.())-    data Foo5Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210)-      = forall arg. SameKind (Apply (Foo5Sym1 l) arg) (Foo5Sym2 l arg) =>-        Foo5Sym1KindInference-    type instance Apply (Foo5Sym1 l) l = Foo5 l l-    instance SuppressUnusedWarnings Foo5Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.())-    data Foo5Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5Sym1 l-    type Foo4Sym3 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) =-        Foo4 t t t-    instance SuppressUnusedWarnings Foo4Sym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo4Sym2KindInference) GHC.Tuple.())-    data Foo4Sym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo4Sym2 l l) arg) (Foo4Sym3 l l arg) =>-        Foo4Sym2KindInference-    type instance Apply (Foo4Sym2 l l) l = Foo4 l l l-    instance SuppressUnusedWarnings Foo4Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo4Sym1KindInference) GHC.Tuple.())-    data Foo4Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210-                                                                                -> GHC.Types.Type))-      = forall arg. SameKind (Apply (Foo4Sym1 l) arg) (Foo4Sym2 l arg) =>-        Foo4Sym1KindInference-    type instance Apply (Foo4Sym1 l) l = Foo4Sym2 l l-    instance SuppressUnusedWarnings Foo4Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.())-    data Foo4Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 a0123456789876543210-                                                                                -> GHC.Types.Type)-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4Sym1 l-    type Foo3Sym1 (t :: a0123456789876543210) = Foo3 t-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3 l-    type Foo2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo2 t t-    instance SuppressUnusedWarnings Foo2Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym1KindInference) GHC.Tuple.())-    data Foo2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo2Sym1 l) arg) (Foo2Sym2 l arg) =>-        Foo2Sym1KindInference-    type instance Apply (Foo2Sym1 l) l = Foo2 l l-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2Sym1 l-    type Foo1Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo1 t t-    instance SuppressUnusedWarnings Foo1Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym1KindInference) GHC.Tuple.())-    data Foo1Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo1Sym1 l) arg) (Foo1Sym2 l arg) =>-        Foo1Sym1KindInference-    type instance Apply (Foo1Sym1 l) l = Foo1 l l-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1Sym1 l-    type Foo0Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Foo0 t t-    instance SuppressUnusedWarnings Foo0Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo0Sym1KindInference) GHC.Tuple.())-    data Foo0Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (Foo0Sym1 l) arg) (Foo0Sym2 l arg) =>-        Foo0Sym1KindInference-    type instance Apply (Foo0Sym1 l) l = Foo0 l l-    instance SuppressUnusedWarnings Foo0Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo0Sym0KindInference) GHC.Tuple.())-    data Foo0Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 a0123456789876543210-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) =>-        Foo0Sym0KindInference-    type instance Apply Foo0Sym0 l = Foo0Sym1 l-    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 (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a)-    sFoo7 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b)-    sFoo6 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a)-    sFoo5 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b)-    sFoo4 ::-      forall (t :: a) (t :: b) (t :: c).-      Sing t-      -> Sing t-         -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a)-    sFoo3 :: forall (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a)-    sFoo2 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a)-    sFoo1 ::-      forall (t :: a) (t :: b).-      Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a)-    sFoo0 ::-      forall (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-                            (GHC.Tuple.(,) sArg_0123456789876543210) sArg_0123456789876543210-                        of {-                          GHC.Tuple.(,) (_ :: 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 (GHC.Tuple.(,) sX) sY of {-                          GHC.Tuple.(,) (_ :: Sing x) (_ :: Sing y) -> sX })))-              sA_0123456789876543210))-          sA_0123456789876543210-    data instance Sing (z :: Foo a b)-      where-        SFoo :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) }-    instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where-      sing = (SFoo sing) sing
− tests/compile-and-dump/Singletons/Lambdas.hs 
@@ -1,94 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-matches -Wno-name-shadowing -Wno-unused-imports #-}--{-# 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.ghc84.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 t =-        Lambda_0123456789876543210 t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l-    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.ghc84.template 
@@ -1,908 +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 t = Let0123456789876543210Y t-    instance SuppressUnusedWarnings Let0123456789876543210YSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210YSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>-        Let0123456789876543210YSym0KindInference-    type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l-    type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l-    type Let0123456789876543210X_0123456789876543210Sym1 t =-        Let0123456789876543210X_0123456789876543210 t-    instance SuppressUnusedWarnings Let0123456789876543210X_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210X_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210X_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210X_0123456789876543210Sym0 arg) (Let0123456789876543210X_0123456789876543210Sym1 arg) =>-        Let0123456789876543210X_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210X_0123456789876543210Sym0 l = Let0123456789876543210X_0123456789876543210 l-    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 t = Let0123456789876543210Bar t-    instance SuppressUnusedWarnings Let0123456789876543210BarSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210BarSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210BarSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210BarSym0 arg) (Let0123456789876543210BarSym1 arg) =>-        Let0123456789876543210BarSym0KindInference-    type instance Apply Let0123456789876543210BarSym0 l = Let0123456789876543210Bar l-    type family Let0123456789876543210Bar x :: a where-      Let0123456789876543210Bar x = x-    type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) =-        (<<<%%%%%%%%%%%%%%%%%%%%) t t t-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l-      = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)-    type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l-    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 t = Let0123456789876543210Z t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l-    type (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) =-        (<<<%%%%%%%%%%%%%%%%%%%%) t t t-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l-      = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)-    type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l-    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 (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) t (t :: Nat) (t :: Nat) =-        (<<<%%%%%%%%%%%%%%%%%%%%) t t t-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$$) l l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l) l = (<<<%%%%%%%%%%%%%%%%%%%%) l l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l (l :: TyFun Nat (TyFun Nat Nat-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$$###)-    type instance Apply ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$$) l l-    instance SuppressUnusedWarnings (<<<%%%%%%%%%%%%%%%%%%%%@#@$) where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)) GHC.Tuple.())-    data (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l-      = forall arg. SameKind (Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) arg) ((<<<%%%%%%%%%%%%%%%%%%%%@#@$$) arg) =>-        (:<<<%%%%%%%%%%%%%%%%%%%%@#@$###)-    type instance Apply (<<<%%%%%%%%%%%%%%%%%%%%@#@$) l = (<<<%%%%%%%%%%%%%%%%%%%%@#@$$) l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type Let0123456789876543210ZSym2 t (t :: Nat) =-        Let0123456789876543210Z t t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym1 l (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) =>-        Let0123456789876543210ZSym1KindInference-    type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l-    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 t t =-        Lambda_0123456789876543210 t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l-    type family Let0123456789876543210Z x :: Nat where-      Let0123456789876543210Z x = Apply (Apply Lambda_0123456789876543210Sym0 x) ZeroSym0-    type Let0123456789876543210XSym1 t = Let0123456789876543210X t-    instance SuppressUnusedWarnings Let0123456789876543210XSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210XSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210XSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210XSym0 arg) (Let0123456789876543210XSym1 arg) =>-        Let0123456789876543210XSym0KindInference-    type instance Apply Let0123456789876543210XSym0 l = Let0123456789876543210X l-    type family Let0123456789876543210X x :: Nat where-      Let0123456789876543210X x = ZeroSym0-    type Let0123456789876543210FSym2 t (t :: Nat) =-        Let0123456789876543210F t t-    instance SuppressUnusedWarnings Let0123456789876543210FSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) =>-        Let0123456789876543210FSym1KindInference-    type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l-    instance SuppressUnusedWarnings Let0123456789876543210FSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>-        Let0123456789876543210FSym0KindInference-    type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l-    type family Let0123456789876543210F x (a :: Nat) :: Nat where-      Let0123456789876543210F x y = Apply SuccSym0 y-    type Let0123456789876543210ZSym1 t = Let0123456789876543210Z t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210Z l-    type family Let0123456789876543210Z x :: Nat where-      Let0123456789876543210Z x = Apply (Let0123456789876543210FSym1 x) x-    type Let0123456789876543210ZSym2 t t = Let0123456789876543210Z t t-    instance SuppressUnusedWarnings Let0123456789876543210ZSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210ZSym1 l) arg) (Let0123456789876543210ZSym2 l arg) =>-        Let0123456789876543210ZSym1KindInference-    type instance Apply (Let0123456789876543210ZSym1 l) l = Let0123456789876543210Z l l-    instance SuppressUnusedWarnings Let0123456789876543210ZSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210ZSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210ZSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210ZSym0 arg) (Let0123456789876543210ZSym1 arg) =>-        Let0123456789876543210ZSym0KindInference-    type instance Apply Let0123456789876543210ZSym0 l = Let0123456789876543210ZSym1 l-    type family Let0123456789876543210Z x y :: Nat where-      Let0123456789876543210Z x y = Apply SuccSym0 y-    type Let0123456789876543210FSym2 t (t :: Nat) =-        Let0123456789876543210F t t-    instance SuppressUnusedWarnings Let0123456789876543210FSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) =>-        Let0123456789876543210FSym1KindInference-    type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l-    instance SuppressUnusedWarnings Let0123456789876543210FSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>-        Let0123456789876543210FSym0KindInference-    type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l-    type family Let0123456789876543210F x (a :: Nat) :: Nat where-      Let0123456789876543210F x y = Apply SuccSym0 (Let0123456789876543210ZSym2 x y)-    type Let0123456789876543210FSym2 t (t :: Nat) =-        Let0123456789876543210F t t-    instance SuppressUnusedWarnings Let0123456789876543210FSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym1 l (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (Let0123456789876543210FSym1 l) arg) (Let0123456789876543210FSym2 l arg) =>-        Let0123456789876543210FSym1KindInference-    type instance Apply (Let0123456789876543210FSym1 l) l = Let0123456789876543210F l l-    instance SuppressUnusedWarnings Let0123456789876543210FSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210FSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210FSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210FSym0 arg) (Let0123456789876543210FSym1 arg) =>-        Let0123456789876543210FSym0KindInference-    type instance Apply Let0123456789876543210FSym0 l = Let0123456789876543210FSym1 l-    type family Let0123456789876543210F x (a :: Nat) :: Nat where-      Let0123456789876543210F x y = Apply SuccSym0 y-    type Let0123456789876543210YSym1 t = Let0123456789876543210Y t-    instance SuppressUnusedWarnings Let0123456789876543210YSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210YSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>-        Let0123456789876543210YSym0KindInference-    type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l-    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 t = Let0123456789876543210Y t-    instance SuppressUnusedWarnings Let0123456789876543210YSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210YSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210YSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210YSym0 arg) (Let0123456789876543210YSym1 arg) =>-        Let0123456789876543210YSym0KindInference-    type instance Apply Let0123456789876543210YSym0 l = Let0123456789876543210Y l-    type family Let0123456789876543210Y x :: Nat where-      Let0123456789876543210Y x = Apply SuccSym0 ZeroSym0-    type Foo14Sym1 (t :: Nat) = Foo14 t-    instance SuppressUnusedWarnings Foo14Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo14Sym0KindInference) GHC.Tuple.())-    data Foo14Sym0 (l :: TyFun Nat (Nat, Nat))-      = forall arg. SameKind (Apply Foo14Sym0 arg) (Foo14Sym1 arg) =>-        Foo14Sym0KindInference-    type instance Apply Foo14Sym0 l = Foo14 l-    type Foo13_Sym1 (t :: a0123456789876543210) = Foo13_ t-    instance SuppressUnusedWarnings Foo13_Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo13_Sym0KindInference) GHC.Tuple.())-    data Foo13_Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Foo13_Sym0 arg) (Foo13_Sym1 arg) =>-        Foo13_Sym0KindInference-    type instance Apply Foo13_Sym0 l = Foo13_ l-    type Foo13Sym1 (t :: a0123456789876543210) = Foo13 t-    instance SuppressUnusedWarnings Foo13Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo13Sym0KindInference) GHC.Tuple.())-    data Foo13Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Foo13Sym0 arg) (Foo13Sym1 arg) =>-        Foo13Sym0KindInference-    type instance Apply Foo13Sym0 l = Foo13 l-    type Foo12Sym1 (t :: Nat) = Foo12 t-    instance SuppressUnusedWarnings Foo12Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo12Sym0KindInference) GHC.Tuple.())-    data Foo12Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo12Sym0 arg) (Foo12Sym1 arg) =>-        Foo12Sym0KindInference-    type instance Apply Foo12Sym0 l = Foo12 l-    type Foo11Sym1 (t :: Nat) = Foo11 t-    instance SuppressUnusedWarnings Foo11Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo11Sym0KindInference) GHC.Tuple.())-    data Foo11Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo11Sym0 arg) (Foo11Sym1 arg) =>-        Foo11Sym0KindInference-    type instance Apply Foo11Sym0 l = Foo11 l-    type Foo10Sym1 (t :: Nat) = Foo10 t-    instance SuppressUnusedWarnings Foo10Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo10Sym0KindInference) GHC.Tuple.())-    data Foo10Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo10Sym0 arg) (Foo10Sym1 arg) =>-        Foo10Sym0KindInference-    type instance Apply Foo10Sym0 l = Foo10 l-    type Foo9Sym1 (t :: Nat) = Foo9 t-    instance SuppressUnusedWarnings Foo9Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo9Sym0KindInference) GHC.Tuple.())-    data Foo9Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo9Sym0 arg) (Foo9Sym1 arg) =>-        Foo9Sym0KindInference-    type instance Apply Foo9Sym0 l = Foo9 l-    type Foo8Sym1 (t :: Nat) = Foo8 t-    instance SuppressUnusedWarnings Foo8Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo8Sym0KindInference) GHC.Tuple.())-    data Foo8Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) =>-        Foo8Sym0KindInference-    type instance Apply Foo8Sym0 l = Foo8 l-    type Foo7Sym1 (t :: Nat) = Foo7 t-    instance SuppressUnusedWarnings Foo7Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo7Sym0KindInference) GHC.Tuple.())-    data Foo7Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) =>-        Foo7Sym0KindInference-    type instance Apply Foo7Sym0 l = Foo7 l-    type Foo6Sym1 (t :: Nat) = Foo6 t-    instance SuppressUnusedWarnings Foo6Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo6Sym0KindInference) GHC.Tuple.())-    data Foo6Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) =>-        Foo6Sym0KindInference-    type instance Apply Foo6Sym0 l = Foo6 l-    type Foo5Sym1 (t :: Nat) = Foo5 t-    instance SuppressUnusedWarnings Foo5Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo5Sym0KindInference) GHC.Tuple.())-    data Foo5Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) =>-        Foo5Sym0KindInference-    type instance Apply Foo5Sym0 l = Foo5 l-    type Foo4Sym1 (t :: Nat) = Foo4 t-    instance SuppressUnusedWarnings Foo4Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo4Sym0KindInference) GHC.Tuple.())-    data Foo4Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) =>-        Foo4Sym0KindInference-    type instance Apply Foo4Sym0 l = Foo4 l-    type Foo3Sym1 (t :: Nat) = Foo3 t-    instance SuppressUnusedWarnings Foo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo3Sym0KindInference) GHC.Tuple.())-    data Foo3Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) =>-        Foo3Sym0KindInference-    type instance Apply Foo3Sym0 l = Foo3 l-    type Foo2Sym0 = Foo2-    type Foo1Sym1 (t :: Nat) = Foo1 t-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1 l-    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 (t :: a). Sing t -> Sing (Apply Foo13_Sym0 t :: a)-    sFoo13 :: forall (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
− tests/compile-and-dump/Singletons/LetStatements.hs 
@@ -1,193 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-binds   -Wno-unused-matches-                -Wno-name-shadowing -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,145 +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 (t :: a0123456789876543210) = Just t-    instance SuppressUnusedWarnings JustSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) JustSym0KindInference) GHC.Tuple.())-    data JustSym0 (l :: TyFun a0123456789876543210 (Maybe a0123456789876543210))-      = forall arg. SameKind (Apply JustSym0 arg) (JustSym1 arg) =>-        JustSym0KindInference-    type instance Apply JustSym0 l = Just l-    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 (t :: GHC.Types.Nat) (t :: Maybe a0123456789876543210) (t :: GHC.Types.Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Maybe a0123456789876543210) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                                          -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Maybe a0123456789876543210) (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                                          -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (z :: Maybe a)-      where-        SNothing :: Sing Nothing-        SJust :: forall (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 (TyFun (Maybe a) (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                                   -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 })-    instance Data.Singletons.ShowSing.ShowSing a =>-             Data.Singletons.ShowSing.ShowSing (Maybe a) where-      Data.Singletons.ShowSing.showsSingPrec _ SNothing-        = showString "SNothing"-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SJust arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SJust "))-               ((Data.Singletons.ShowSing.showsSingPrec 11)-                  arg_0123456789876543210))-    instance Data.Singletons.ShowSing.ShowSing a =>-             Show (Sing (z :: Maybe a)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance SingI Nothing where-      sing = SNothing-    instance SingI n => SingI (Just (n :: a)) where-      sing = SJust sing
− 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.ghc84.template 
@@ -1,260 +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 (t :: Nat) = Succ t-    instance SuppressUnusedWarnings SuccSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.())-    data SuccSym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = Succ l-    type PredSym1 (t :: Nat) = Pred t-    instance SuppressUnusedWarnings PredSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PredSym0KindInference) GHC.Tuple.())-    data PredSym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply PredSym0 arg) (PredSym1 arg) =>-        PredSym0KindInference-    type instance Apply PredSym0 l = Pred l-    type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t-    instance SuppressUnusedWarnings PlusSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PlusSym1KindInference) GHC.Tuple.())-    data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (PlusSym1 l) arg) (PlusSym2 l arg) =>-        PlusSym1KindInference-    type instance Apply (PlusSym1 l) l = Plus l l-    instance SuppressUnusedWarnings PlusSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PlusSym0KindInference) GHC.Tuple.())-    data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type))-      = forall arg. SameKind (Apply PlusSym0 arg) (PlusSym1 arg) =>-        PlusSym0KindInference-    type instance Apply PlusSym0 l = PlusSym1 l-    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 (t :: GHC.Types.Nat) (t :: Nat) (t :: GHC.Types.Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Nat) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                 -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: Nat) (t :: Nat) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                          -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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)-    data instance Sing (z :: Nat)-      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 (TyFun Nat (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                             -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 (TyFun Nat Ordering-                                                            -> GHC.Types.Type)-                                                 -> 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 })-    instance Data.Singletons.ShowSing.ShowSing Nat =>-             Data.Singletons.ShowSing.ShowSing Nat where-      Data.Singletons.ShowSing.showsSingPrec _ SZero = showString "SZero"-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SSucc arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SSucc "))-               ((Data.Singletons.ShowSing.showsSingPrec 11)-                  arg_0123456789876543210))-    instance Data.Singletons.ShowSing.ShowSing Nat =>-             Show (Sing (z :: Nat)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance SingI Zero where-      sing = SZero-    instance SingI n => SingI (Succ (n :: Nat)) where-      sing = SSucc sing
− 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/Operators.ghc84.template 
@@ -1,103 +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 (:+:@#@$$$) (t :: Foo) (t :: Foo) = (:+:) t t-    instance SuppressUnusedWarnings (:+:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+:@#@$$###)) GHC.Tuple.())-    data (:+:@#@$$) (l :: Foo) (l :: TyFun Foo Foo)-      = forall arg. SameKind (Apply ((:+:@#@$$) l) arg) ((:+:@#@$$$) l arg) =>-        (::+:@#@$$###)-    type instance Apply ((:+:@#@$$) l) l = (:+:) l l-    instance SuppressUnusedWarnings (:+:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::+:@#@$###)) GHC.Tuple.())-    data (:+:@#@$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:+:@#@$) arg) ((:+:@#@$$) arg) =>-        (::+:@#@$###)-    type instance Apply (:+:@#@$) l = (:+:@#@$$) l-    type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t-    instance SuppressUnusedWarnings (+@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.())-    data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) =>-        (:+@#@$$###)-    type instance Apply ((+@#@$$) l) l = (+) l l-    instance SuppressUnusedWarnings (+@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.())-    data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type))-      = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>-        (:+@#@$###)-    type instance Apply (+@#@$) l = (+@#@$$) l-    type ChildSym1 (t :: Foo) = Child t-    instance SuppressUnusedWarnings ChildSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ChildSym0KindInference) GHC.Tuple.())-    data ChildSym0 (l :: TyFun Foo Foo)-      = forall arg. SameKind (Apply ChildSym0 arg) (ChildSym1 arg) =>-        ChildSym0KindInference-    type instance Apply ChildSym0 l = Child l-    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-    data instance Sing (z :: Foo)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing Foo))-                (toSing b :: SomeSing Foo)-          of {-            GHC.Tuple.(,) (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
− tests/compile-and-dump/Singletons/Operators.hs 
@@ -1,22 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,999 +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 (t :: Nat) = Succ t-    instance SuppressUnusedWarnings SuccSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SuccSym0KindInference) GHC.Tuple.())-    data SuccSym0 (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply SuccSym0 arg) (SuccSym1 arg) =>-        SuccSym0KindInference-    type instance Apply SuccSym0 l = Succ l-    type ASym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        A t t t t-    instance SuppressUnusedWarnings ASym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ASym3KindInference) GHC.Tuple.())-    data ASym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (ASym3 l l l) arg) (ASym4 l l l arg) =>-        ASym3KindInference-    type instance Apply (ASym3 l l l) l = A l l l l-    instance SuppressUnusedWarnings ASym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ASym2KindInference) GHC.Tuple.())-    data ASym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ASym2 l l) arg) (ASym3 l l arg) =>-        ASym2KindInference-    type instance Apply (ASym2 l l) l = ASym3 l l l-    instance SuppressUnusedWarnings ASym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ASym1KindInference) GHC.Tuple.())-    data ASym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ASym1 l) arg) (ASym2 l arg) =>-        ASym1KindInference-    type instance Apply (ASym1 l) l = ASym2 l l-    instance SuppressUnusedWarnings ASym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ASym0KindInference) GHC.Tuple.())-    data ASym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply ASym0 arg) (ASym1 arg) =>-        ASym0KindInference-    type instance Apply ASym0 l = ASym1 l-    type BSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        B t t t t-    instance SuppressUnusedWarnings BSym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BSym3KindInference) GHC.Tuple.())-    data BSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (BSym3 l l l) arg) (BSym4 l l l arg) =>-        BSym3KindInference-    type instance Apply (BSym3 l l l) l = B l l l l-    instance SuppressUnusedWarnings BSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BSym2KindInference) GHC.Tuple.())-    data BSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BSym2 l l) arg) (BSym3 l l arg) =>-        BSym2KindInference-    type instance Apply (BSym2 l l) l = BSym3 l l l-    instance SuppressUnusedWarnings BSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BSym1KindInference) GHC.Tuple.())-    data BSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (BSym1 l) arg) (BSym2 l arg) =>-        BSym1KindInference-    type instance Apply (BSym1 l) l = BSym2 l l-    instance SuppressUnusedWarnings BSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BSym0KindInference) GHC.Tuple.())-    data BSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply BSym0 arg) (BSym1 arg) =>-        BSym0KindInference-    type instance Apply BSym0 l = BSym1 l-    type CSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        C t t t t-    instance SuppressUnusedWarnings CSym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) CSym3KindInference) GHC.Tuple.())-    data CSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (CSym3 l l l) arg) (CSym4 l l l arg) =>-        CSym3KindInference-    type instance Apply (CSym3 l l l) l = C l l l l-    instance SuppressUnusedWarnings CSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) CSym2KindInference) GHC.Tuple.())-    data CSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (CSym2 l l) arg) (CSym3 l l arg) =>-        CSym2KindInference-    type instance Apply (CSym2 l l) l = CSym3 l l l-    instance SuppressUnusedWarnings CSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) CSym1KindInference) GHC.Tuple.())-    data CSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (CSym1 l) arg) (CSym2 l arg) =>-        CSym1KindInference-    type instance Apply (CSym1 l) l = CSym2 l l-    instance SuppressUnusedWarnings CSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) CSym0KindInference) GHC.Tuple.())-    data CSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply CSym0 arg) (CSym1 arg) =>-        CSym0KindInference-    type instance Apply CSym0 l = CSym1 l-    type DSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        D t t t t-    instance SuppressUnusedWarnings DSym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DSym3KindInference) GHC.Tuple.())-    data DSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (DSym3 l l l) arg) (DSym4 l l l arg) =>-        DSym3KindInference-    type instance Apply (DSym3 l l l) l = D l l l l-    instance SuppressUnusedWarnings DSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DSym2KindInference) GHC.Tuple.())-    data DSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (DSym2 l l) arg) (DSym3 l l arg) =>-        DSym2KindInference-    type instance Apply (DSym2 l l) l = DSym3 l l l-    instance SuppressUnusedWarnings DSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DSym1KindInference) GHC.Tuple.())-    data DSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (DSym1 l) arg) (DSym2 l arg) =>-        DSym1KindInference-    type instance Apply (DSym1 l) l = DSym2 l l-    instance SuppressUnusedWarnings DSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) DSym0KindInference) GHC.Tuple.())-    data DSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply DSym0 arg) (DSym1 arg) =>-        DSym0KindInference-    type instance Apply DSym0 l = DSym1 l-    type ESym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        E t t t t-    instance SuppressUnusedWarnings ESym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ESym3KindInference) GHC.Tuple.())-    data ESym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (ESym3 l l l) arg) (ESym4 l l l arg) =>-        ESym3KindInference-    type instance Apply (ESym3 l l l) l = E l l l l-    instance SuppressUnusedWarnings ESym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ESym2KindInference) GHC.Tuple.())-    data ESym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ESym2 l l) arg) (ESym3 l l arg) =>-        ESym2KindInference-    type instance Apply (ESym2 l l) l = ESym3 l l l-    instance SuppressUnusedWarnings ESym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ESym1KindInference) GHC.Tuple.())-    data ESym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ESym1 l) arg) (ESym2 l arg) =>-        ESym1KindInference-    type instance Apply (ESym1 l) l = ESym2 l l-    instance SuppressUnusedWarnings ESym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ESym0KindInference) GHC.Tuple.())-    data ESym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply ESym0 arg) (ESym1 arg) =>-        ESym0KindInference-    type instance Apply ESym0 l = ESym1 l-    type FSym4 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: c0123456789876543210) (t :: d0123456789876543210) =-        F t t t t-    instance SuppressUnusedWarnings FSym3 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FSym3KindInference) GHC.Tuple.())-    data FSym3 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: c0123456789876543210) (l :: TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210))-      = forall arg. SameKind (Apply (FSym3 l l l) arg) (FSym4 l l l arg) =>-        FSym3KindInference-    type instance Apply (FSym3 l l l) l = F l l l l-    instance SuppressUnusedWarnings FSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FSym2KindInference) GHC.Tuple.())-    data FSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (FSym2 l l) arg) (FSym3 l l arg) =>-        FSym2KindInference-    type instance Apply (FSym2 l l) l = FSym3 l l l-    instance SuppressUnusedWarnings FSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FSym1KindInference) GHC.Tuple.())-    data FSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (FSym1 l) arg) (FSym2 l arg) =>-        FSym1KindInference-    type instance Apply (FSym1 l) l = FSym2 l l-    instance SuppressUnusedWarnings FSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.())-    data FSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun c0123456789876543210 (TyFun d0123456789876543210 (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210)-                                                                                                         -> GHC.Types.Type)-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>-        FSym0KindInference-    type instance Apply FSym0 l = FSym1 l-    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 (t :: Nat) (t :: Nat) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Nat Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Nat Ordering-                                                          -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (t :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) (TyFun (Foo a0123456789876543210 b0123456789876543210 c0123456789876543210 d0123456789876543210) Ordering-                                                                                                                                                -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (z :: Nat)-      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 (z :: Foo a b c d)-      where-        SA :: forall (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 (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 (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 (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 (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 (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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-              (((GHC.Tuple.(,,,) (toSing b :: SomeSing a))-                  (toSing b :: SomeSing b))-                 (toSing b :: SomeSing c))-                (toSing b :: SomeSing d)-          of {-            GHC.Tuple.(,,,) (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 (TyFun Nat Ordering-                                                            -> GHC.Types.Type)-                                                 -> 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) (TyFun (Foo a b c d) Ordering-                                                                      -> GHC.Types.Type)-                                                 -> 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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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-              (((GHC.Tuple.(,,,) (((%~) a) b)) (((%~) a) b)) (((%~) a) b))-                (((%~) a) b)-          of-            GHC.Tuple.(,,,) (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-                            (Proved Refl)-              -> Proved Refl-            GHC.Tuple.(,,,) (Disproved contra) _ _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ (Disproved contra) _ _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,,,) _ _ _ (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 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 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 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 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 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 n, SingI n, SingI n, SingI n) =>-             SingI (F (n :: a) (n :: b) (n :: c) (n :: d)) where-      sing = (((SF sing) sing) sing) sing
− 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.ghc84.template 
@@ -1,31 +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 (t :: Symbol) = SymId t-    instance SuppressUnusedWarnings SymIdSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SymIdSym0KindInference) GHC.Tuple.())-    data SymIdSym0 (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply SymIdSym0 arg) (SymIdSym1 arg) =>-        SymIdSym0KindInference-    type instance Apply SymIdSym0 l = SymId l-    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"))
− 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.ghc84.template 
@@ -1,544 +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 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Pair t t-    instance SuppressUnusedWarnings PairSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym1KindInference) GHC.Tuple.())-    data PairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply (PairSym1 l) arg) (PairSym2 l arg) =>-        PairSym1KindInference-    type instance Apply (PairSym1 l) l = Pair l l-    instance SuppressUnusedWarnings PairSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) PairSym0KindInference) GHC.Tuple.())-    data PairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)-                                                    -> GHC.Types.Type))-      = forall arg. SameKind (Apply PairSym0 arg) (PairSym1 arg) =>-        PairSym0KindInference-    type instance Apply PairSym0 l = PairSym1 l-    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 (t :: GHC.Types.Nat) (t :: Pair a0123456789876543210 b0123456789876543210) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Pair a0123456789876543210 b0123456789876543210) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol-                                                                                                                              -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Pair a0123456789876543210 b0123456789876543210) (TyFun Symbol Symbol-                                                                                                                              -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (z :: Pair a b)-      where-        SPair :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (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 (TyFun (Pair a b) (TyFun Symbol Symbol-                                                                                                    -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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-    instance (Data.Singletons.ShowSing.ShowSing a,-              Data.Singletons.ShowSing.ShowSing b) =>-             Data.Singletons.ShowSing.ShowSing (Pair a b) where-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SPair arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SPair "))-               (((.)-                   ((Data.Singletons.ShowSing.showsSingPrec 11)-                      arg_0123456789876543210))-                  (((.) GHC.Show.showSpace)-                     ((Data.Singletons.ShowSing.showsSingPrec 11)-                        arg_0123456789876543210))))-    instance (Data.Singletons.ShowSing.ShowSing a,-              Data.Singletons.ShowSing.ShowSing b) =>-             Show (Sing (z :: Pair a b)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance (SingI n, SingI n) => SingI (Pair (n :: a) (n :: b)) where-      sing = (SPair sing) sing-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 { _ -> GHC.Tuple.() }-    type family Case_0123456789876543210 x t where-      Case_0123456789876543210 x _ = Tuple0Sym0-    type Let0123456789876543210TSym2 t t = Let0123456789876543210T t t-    instance SuppressUnusedWarnings Let0123456789876543210TSym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210TSym1KindInference)-               GHC.Tuple.())-    data Let0123456789876543210TSym1 l l-      = forall arg. SameKind (Apply (Let0123456789876543210TSym1 l) arg) (Let0123456789876543210TSym2 l arg) =>-        Let0123456789876543210TSym1KindInference-    type instance Apply (Let0123456789876543210TSym1 l) l = Let0123456789876543210T l l-    instance SuppressUnusedWarnings Let0123456789876543210TSym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Let0123456789876543210TSym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210TSym0 l-      = forall arg. SameKind (Apply Let0123456789876543210TSym0 arg) (Let0123456789876543210TSym1 arg) =>-        Let0123456789876543210TSym0KindInference-    type instance Apply Let0123456789876543210TSym0 l = Let0123456789876543210TSym1 l-    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 t t t t t =-        Lambda_0123456789876543210 t t t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym4 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym4KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym4 l l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym4 l l l l) arg) (Lambda_0123456789876543210Sym5 l l l l arg) =>-        Lambda_0123456789876543210Sym4KindInference-    type instance Apply (Lambda_0123456789876543210Sym4 l l l l) l = Lambda_0123456789876543210 l l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym3 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym3KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym3 l l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym3 l l l) arg) (Lambda_0123456789876543210Sym4 l l l arg) =>-        Lambda_0123456789876543210Sym3KindInference-    type instance Apply (Lambda_0123456789876543210Sym3 l l l) l = Lambda_0123456789876543210Sym4 l l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210Sym3 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 t t t =-        Lambda_0123456789876543210 t t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym2 l l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym2 l l) arg) (Lambda_0123456789876543210Sym3 l l arg) =>-        Lambda_0123456789876543210Sym2KindInference-    type instance Apply (Lambda_0123456789876543210Sym2 l l) l = Lambda_0123456789876543210 l l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    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 (t :: a0123456789876543210) = Silly t-    instance SuppressUnusedWarnings SillySym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) SillySym0KindInference) GHC.Tuple.())-    data SillySym0 (l :: TyFun a0123456789876543210 ())-      = forall arg. SameKind (Apply SillySym0 arg) (SillySym1 arg) =>-        SillySym0KindInference-    type instance Apply SillySym0 l = Silly l-    type Foo2Sym1 (t :: (a0123456789876543210, b0123456789876543210)) =-        Foo2 t-    instance SuppressUnusedWarnings Foo2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo2Sym0KindInference) GHC.Tuple.())-    data Foo2Sym0 (l :: TyFun (a0123456789876543210,-                               b0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) =>-        Foo2Sym0KindInference-    type instance Apply Foo2Sym0 l = Foo2 l-    type Foo1Sym1 (t :: (a0123456789876543210, b0123456789876543210)) =-        Foo1 t-    instance SuppressUnusedWarnings Foo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Foo1Sym0KindInference) GHC.Tuple.())-    data Foo1Sym0 (l :: TyFun (a0123456789876543210,-                               b0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) =>-        Foo1Sym0KindInference-    type instance Apply Foo1Sym0 l = Foo1 l-    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 (t :: a). Sing t -> Sing (Apply SillySym0 t :: ())-    sFoo2 ::-      forall (t :: (a, b)). Sing t -> Sing (Apply Foo2Sym0 t :: a)-    sFoo1 ::-      forall (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
− 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.ghc84.template 
@@ -1,22 +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 (t :: Proxy (a0123456789876543210 :: k0123456789876543210)) =-        Fff t-    instance SuppressUnusedWarnings FffSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FffSym0KindInference) GHC.Tuple.())-    data FffSym0 (l :: TyFun (Proxy (a0123456789876543210 :: k0123456789876543210)) ())-      = forall arg. SameKind (Apply FffSym0 arg) (FffSym1 arg) =>-        FffSym0KindInference-    type instance Apply FffSym0 l = Fff l-    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 :: ())
− 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.ghc84.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 :: 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-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.ghc84.template 
@@ -1,61 +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 (t :: Record a0123456789876543210) = Field1 t-    instance SuppressUnusedWarnings Field1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Field1Sym0KindInference) GHC.Tuple.())-    data Field1Sym0 (l :: TyFun (Record a0123456789876543210) a0123456789876543210)-      = forall arg. SameKind (Apply Field1Sym0 arg) (Field1Sym1 arg) =>-        Field1Sym0KindInference-    type instance Apply Field1Sym0 l = Field1 l-    type Field2Sym1 (t :: Record a0123456789876543210) = Field2 t-    instance SuppressUnusedWarnings Field2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Field2Sym0KindInference) GHC.Tuple.())-    data Field2Sym0 (l :: TyFun (Record a0123456789876543210) Bool)-      = forall arg. SameKind (Apply Field2Sym0 arg) (Field2Sym1 arg) =>-        Field2Sym0KindInference-    type instance Apply Field2Sym0 l = Field2 l-    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 (t :: a0123456789876543210) (t :: Bool) =-        MkRecord t t-    instance SuppressUnusedWarnings MkRecordSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkRecordSym1KindInference) GHC.Tuple.())-    data MkRecordSym1 (l :: a0123456789876543210) (l :: TyFun Bool (Record a0123456789876543210))-      = forall arg. SameKind (Apply (MkRecordSym1 l) arg) (MkRecordSym2 l arg) =>-        MkRecordSym1KindInference-    type instance Apply (MkRecordSym1 l) l = MkRecord l l-    instance SuppressUnusedWarnings MkRecordSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkRecordSym0KindInference) GHC.Tuple.())-    data MkRecordSym0 (l :: TyFun a0123456789876543210 (TyFun Bool (Record a0123456789876543210)-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply MkRecordSym0 arg) (MkRecordSym1 arg) =>-        MkRecordSym0KindInference-    type instance Apply MkRecordSym0 l = MkRecordSym1 l-    data instance Sing (z :: Record a)-      where-        SMkRecord :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a))-                (toSing b :: SomeSing Bool)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing ((SMkRecord c) c) }-    instance (SingI n, SingI n) =>-             SingI (MkRecord (n :: a) (n :: Bool)) where-      sing = (SMkRecord sing) sing
− tests/compile-and-dump/Singletons/Records.hs 
@@ -1,30 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}-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.ghc84.template 
@@ -1,76 +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 (t :: a0123456789876543210) = Id t-    instance SuppressUnusedWarnings IdSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.())-    data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) =>-        IdSym0KindInference-    type instance Apply IdSym0 l = Id l-    type IdFooSym2 (t :: c0123456789876543210) (t :: a0123456789876543210) =-        IdFoo t t-    instance SuppressUnusedWarnings IdFooSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) IdFooSym1KindInference) GHC.Tuple.())-    data IdFooSym1 (l :: c0123456789876543210) (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply (IdFooSym1 l) arg) (IdFooSym2 l arg) =>-        IdFooSym1KindInference-    type instance Apply (IdFooSym1 l) l = IdFoo l l-    instance SuppressUnusedWarnings IdFooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) IdFooSym0KindInference) GHC.Tuple.())-    data IdFooSym0 (l :: TyFun c0123456789876543210 (TyFun a0123456789876543210 a0123456789876543210-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply IdFooSym0 arg) (IdFooSym1 arg) =>-        IdFooSym0KindInference-    type instance Apply IdFooSym0 l = IdFooSym1 l-    type ReturnFuncSym2 (t :: Nat) (t :: Nat) = ReturnFunc t t-    instance SuppressUnusedWarnings ReturnFuncSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ReturnFuncSym1KindInference) GHC.Tuple.())-    data ReturnFuncSym1 (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (ReturnFuncSym1 l) arg) (ReturnFuncSym2 l arg) =>-        ReturnFuncSym1KindInference-    type instance Apply (ReturnFuncSym1 l) l = ReturnFunc l l-    instance SuppressUnusedWarnings ReturnFuncSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ReturnFuncSym0KindInference) GHC.Tuple.())-    data ReturnFuncSym0 (l :: TyFun Nat (TyFun Nat Nat-                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply ReturnFuncSym0 arg) (ReturnFuncSym1 arg) =>-        ReturnFuncSym0KindInference-    type instance Apply ReturnFuncSym0 l = ReturnFuncSym1 l-    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 (t :: a). Sing t -> Sing (Apply IdSym0 t :: a)-    sIdFoo ::-      forall (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
− tests/compile-and-dump/Singletons/ReturnFunc.hs 
@@ -1,25 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--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.ghc84.template 
@@ -1,113 +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 t =-        Lambda_0123456789876543210 t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210 l-    type (+@#@$$$) (t :: Nat) (t :: Nat) = (+) t t-    instance SuppressUnusedWarnings (+@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:+@#@$$###)) GHC.Tuple.())-    data (+@#@$$) (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply ((+@#@$$) l) arg) ((+@#@$$$) l arg) =>-        (:+@#@$$###)-    type instance Apply ((+@#@$$) l) l = (+) l l-    instance SuppressUnusedWarnings (+@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:+@#@$###)) GHC.Tuple.())-    data (+@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type))-      = forall arg. SameKind (Apply (+@#@$) arg) ((+@#@$$) arg) =>-        (:+@#@$###)-    type instance Apply (+@#@$) l = (+@#@$$) l-    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))
− 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.ghc84.template 
@@ -1,591 +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 (t :: Foo3) = GetFoo3a t-    instance SuppressUnusedWarnings GetFoo3aSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) GetFoo3aSym0KindInference) GHC.Tuple.())-    data GetFoo3aSym0 (l :: TyFun Foo3 Bool)-      = forall arg. SameKind (Apply GetFoo3aSym0 arg) (GetFoo3aSym1 arg) =>-        GetFoo3aSym0KindInference-    type instance Apply GetFoo3aSym0 l = GetFoo3a l-    type (***@#@$$) (t :: Foo3) = (***) t-    instance SuppressUnusedWarnings (***@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:***@#@$###)) GHC.Tuple.())-    data (***@#@$) (l :: TyFun Foo3 Bool)-      = forall arg. SameKind (Apply (***@#@$) arg) ((***@#@$$) arg) =>-        (:***@#@$###)-    type instance Apply (***@#@$) l = (***) l-    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 (t :: a0123456789876543210) (t :: a0123456789876543210) =-        MkFoo2a t t-    instance SuppressUnusedWarnings MkFoo2aSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo2aSym1KindInference) GHC.Tuple.())-    data MkFoo2aSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210))-      = forall arg. SameKind (Apply (MkFoo2aSym1 l) arg) (MkFoo2aSym2 l arg) =>-        MkFoo2aSym1KindInference-    type instance Apply (MkFoo2aSym1 l) l = MkFoo2a l l-    instance SuppressUnusedWarnings MkFoo2aSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo2aSym0KindInference) GHC.Tuple.())-    data MkFoo2aSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210)-                                                       -> GHC.Types.Type))-      = forall arg. SameKind (Apply MkFoo2aSym0 arg) (MkFoo2aSym1 arg) =>-        MkFoo2aSym0KindInference-    type instance Apply MkFoo2aSym0 l = MkFoo2aSym1 l-    type MkFoo2bSym2 (t :: a0123456789876543210) (t :: a0123456789876543210) =-        MkFoo2b t t-    instance SuppressUnusedWarnings MkFoo2bSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo2bSym1KindInference) GHC.Tuple.())-    data MkFoo2bSym1 (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210))-      = forall arg. SameKind (Apply (MkFoo2bSym1 l) arg) (MkFoo2bSym2 l arg) =>-        MkFoo2bSym1KindInference-    type instance Apply (MkFoo2bSym1 l) l = MkFoo2b l l-    instance SuppressUnusedWarnings MkFoo2bSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo2bSym0KindInference) GHC.Tuple.())-    data MkFoo2bSym0 (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210)-                                                       -> GHC.Types.Type))-      = forall arg. SameKind (Apply MkFoo2bSym0 arg) (MkFoo2bSym1 arg) =>-        MkFoo2bSym0KindInference-    type instance Apply MkFoo2bSym0 l = MkFoo2bSym1 l-    type (:*:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) =-        (:*:) t t-    instance SuppressUnusedWarnings (:*:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.())-    data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210))-      = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) =>-        (::*:@#@$$###)-    type instance Apply ((:*:@#@$$) l) l = (:*:) l l-    instance SuppressUnusedWarnings (:*:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.())-    data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210)-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>-        (::*:@#@$###)-    type instance Apply (:*:@#@$) l = (:*:@#@$$) l-    type (:&:@#@$$$) (t :: a0123456789876543210) (t :: a0123456789876543210) =-        (:&:) t t-    instance SuppressUnusedWarnings (:&:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::&:@#@$$###)) GHC.Tuple.())-    data (:&:@#@$$) (l :: a0123456789876543210) (l :: TyFun a0123456789876543210 (Foo2 a0123456789876543210))-      = forall arg. SameKind (Apply ((:&:@#@$$) l) arg) ((:&:@#@$$$) l arg) =>-        (::&:@#@$$###)-    type instance Apply ((:&:@#@$$) l) l = (:&:) l l-    instance SuppressUnusedWarnings (:&:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::&:@#@$###)) GHC.Tuple.())-    data (:&:@#@$) (l :: TyFun a0123456789876543210 (TyFun a0123456789876543210 (Foo2 a0123456789876543210)-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:&:@#@$) arg) ((:&:@#@$$) arg) =>-        (::&:@#@$###)-    type instance Apply (:&:@#@$) l = (:&:@#@$$) l-    type MkFoo3Sym2 (t :: Bool) (t :: Bool) = MkFoo3 t t-    instance SuppressUnusedWarnings MkFoo3Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo3Sym1KindInference) GHC.Tuple.())-    data MkFoo3Sym1 (l :: Bool) (l :: TyFun Bool Foo3)-      = forall arg. SameKind (Apply (MkFoo3Sym1 l) arg) (MkFoo3Sym2 l arg) =>-        MkFoo3Sym1KindInference-    type instance Apply (MkFoo3Sym1 l) l = MkFoo3 l l-    instance SuppressUnusedWarnings MkFoo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.())-    data MkFoo3Sym0 (l :: TyFun Bool (TyFun Bool Foo3-                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>-        MkFoo3Sym0KindInference-    type instance Apply MkFoo3Sym0 l = MkFoo3Sym1 l-    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 (t :: GHC.Types.Nat) (t :: Foo1) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo1) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo1 (TyFun Symbol Symbol-                                                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo1 (TyFun Symbol Symbol-                                                                                  -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: Foo2 a0123456789876543210) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo2 a0123456789876543210) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (Foo2 a0123456789876543210) (TyFun Symbol Symbol-                                                                                                         -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: Foo3) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Foo3) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Foo3 (TyFun Symbol Symbol-                                                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Foo3 (TyFun Symbol Symbol-                                                                                  -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    instance PShow Foo3 where-      type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a-    infixl 5 :%&:-    infixl 5 :%*:-    infixl 5 `SMkFoo2b`-    data instance Sing (z :: Foo1) 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 (z :: Foo2 a)-      where-        SMkFoo2a :: forall (n :: a) (n :: a).-                    (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2a n n)-        SMkFoo2b :: forall (n :: a) (n :: a).-                    (Sing (n :: a)) -> (Sing (n :: a)) -> Sing (MkFoo2b n n)-        (:%*:) :: forall (n :: a) (n :: a).-                  (Sing (n :: a)) -> (Sing (n :: a)) -> Sing ((:*:) n n)-        (:%&:) :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing ((SMkFoo2a c) c) }-      toSing (MkFoo2b (b :: Demote a) (b :: Demote a))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing ((SMkFoo2b c) c) }-      toSing ((:*:) (b :: Demote a) (b :: Demote a))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing (((:%*:) c) c) }-      toSing ((:&:) (b :: Demote a) (b :: Demote a))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing a)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing (((:%&:) c) c) }-    data instance Sing (z :: Foo3)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing Bool))-                (toSing b :: SomeSing Bool)-          of {-            GHC.Tuple.(,) (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 (TyFun Foo1 (TyFun Symbol Symbol-                                                                                              -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 (TyFun (Foo2 a) (TyFun Symbol Symbol-                                                                                                  -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 (TyFun Foo3 (TyFun Symbol Symbol-                                                                                              -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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-    instance Data.Singletons.ShowSing.ShowSing Foo1 where-      Data.Singletons.ShowSing.showsSingPrec _ SMkFoo1-        = showString "SMkFoo1"-    instance Show (Sing (z :: Foo1)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance Data.Singletons.ShowSing.ShowSing a =>-             Data.Singletons.ShowSing.ShowSing (Foo2 a) where-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SMkFoo2a arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SMkFoo2a "))-               (((.)-                   ((Data.Singletons.ShowSing.showsSingPrec 11)-                      arg_0123456789876543210))-                  (((.) GHC.Show.showSpace)-                     ((Data.Singletons.ShowSing.showsSingPrec 11)-                        arg_0123456789876543210))))-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SMkFoo2b argL_0123456789876543210 argR_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 9))-            (((.)-                ((Data.Singletons.ShowSing.showsSingPrec 10)-                   argL_0123456789876543210))-               (((.) (showString " `SMkFoo2b` "))-                  ((Data.Singletons.ShowSing.showsSingPrec 10)-                     argR_0123456789876543210)))-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        ((:%*:) arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "(:%*:) "))-               (((.)-                   ((Data.Singletons.ShowSing.showsSingPrec 11)-                      arg_0123456789876543210))-                  (((.) GHC.Show.showSpace)-                     ((Data.Singletons.ShowSing.showsSingPrec 11)-                        arg_0123456789876543210))))-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        ((:%&:) argL_0123456789876543210 argR_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 9))-            (((.)-                ((Data.Singletons.ShowSing.showsSingPrec 10)-                   argL_0123456789876543210))-               (((.) (showString " :%&: "))-                  ((Data.Singletons.ShowSing.showsSingPrec 10)-                     argR_0123456789876543210)))-    instance Data.Singletons.ShowSing.ShowSing a =>-             Show (Sing (z :: Foo2 a)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance Data.Singletons.ShowSing.ShowSing Bool =>-             Data.Singletons.ShowSing.ShowSing Foo3 where-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        (SMkFoo3 arg_0123456789876543210 arg_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 10))-            (((.) (showString "SMkFoo3 "))-               (((.) (showChar '{'))-                  (((.) (showString "sGetFoo3a = "))-                     (((.)-                         ((Data.Singletons.ShowSing.showsSingPrec 0)-                            arg_0123456789876543210))-                        (((.) GHC.Show.showCommaSpace)-                           (((.) (showString "(%***) = "))-                              (((.)-                                  ((Data.Singletons.ShowSing.showsSingPrec 0)-                                     arg_0123456789876543210))-                                 (showChar '}'))))))))-    instance Data.Singletons.ShowSing.ShowSing Bool =>-             Show (Sing (z :: Foo3)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance SingI MkFoo1 where-      sing = SMkFoo1-    instance (SingI n, SingI n) =>-             SingI (MkFoo2a (n :: a) (n :: a)) where-      sing = (SMkFoo2a sing) sing-    instance (SingI n, SingI n) =>-             SingI (MkFoo2b (n :: a) (n :: a)) where-      sing = (SMkFoo2b sing) sing-    instance (SingI n, SingI n) =>-             SingI ((:*:) (n :: a) (n :: a)) where-      sing = ((:%*:) sing) sing-    instance (SingI n, SingI n) =>-             SingI ((:&:) (n :: a) (n :: a)) where-      sing = ((:%&:) sing) sing-    instance (SingI n, SingI n) =>-             SingI (MkFoo3 (n :: Bool) (n :: Bool)) where-      sing = (SMkFoo3 sing) sing
− 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.ghc84.template 
@@ -1,454 +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 (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) =-        (:*:) t t-    instance SuppressUnusedWarnings (:*:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.())-    data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) =>-        (::*:@#@$$###)-    type instance Apply ((:*:@#@$$) l) l = (:*:) l l-    instance SuppressUnusedWarnings (:*:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.())-    data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (T a0123456789876543210 b0123456789876543210)-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>-        (::*:@#@$###)-    type instance Apply (:*:@#@$) l = (:*:@#@$$) l-    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 (t :: T a0123456789876543210 ()) (t :: T a0123456789876543210 ()) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: T a0123456789876543210 ()) (l :: TyFun (T a0123456789876543210 ()) Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun (T a0123456789876543210 ()) (TyFun (T a0123456789876543210 ()) Ordering-                                                                                  -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: T a0123456789876543210 ()) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T a0123456789876543210 ()) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol-                                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun (T a0123456789876543210 ()) (TyFun Symbol Symbol-                                                                                                         -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: S) (t :: S) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: S) (l :: TyFun S Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun S (TyFun S Ordering-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: S) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: S) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun S (TyFun Symbol Symbol-                                                                               -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun S (TyFun Symbol Symbol-                                                                               -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) =-        ToEnum_0123456789876543210 t-    instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat S)-      = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>-        ToEnum_0123456789876543210Sym0KindInference-    type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l-    type family FromEnum_0123456789876543210 (a :: S) :: GHC.Types.Nat where-      FromEnum_0123456789876543210 S1 = FromInteger 0-      FromEnum_0123456789876543210 S2 = FromInteger 1-    type FromEnum_0123456789876543210Sym1 (t :: S) =-        FromEnum_0123456789876543210 t-    instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FromEnum_0123456789876543210Sym0 (l :: TyFun S GHC.Types.Nat)-      = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>-        FromEnum_0123456789876543210Sym0KindInference-    type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l-    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 (z :: T a b)-      where-        (:%*:) :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing (((:%*:) c) c) }-    data instance Sing (z :: S)-      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 ()) (TyFun (T a ()) Ordering-                                                                 -> GHC.Types.Type)-                                                 -> 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 (TyFun (T a ()) (TyFun Symbol Symbol-                                                                                                  -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 (TyFun S Ordering-                                                          -> GHC.Types.Type)-                                                 -> 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 (TyFun S (TyFun Symbol Symbol-                                                                                           -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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 (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of-            GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl-            GHC.Tuple.(,) (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,) _ (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-    instance Data.Singletons.ShowSing.ShowSing a =>-             Data.Singletons.ShowSing.ShowSing (T a ()) where-      Data.Singletons.ShowSing.showsSingPrec-        p_0123456789876543210-        ((:%*:) argL_0123456789876543210 argR_0123456789876543210)-        = (showParen (((>) p_0123456789876543210) 9))-            (((.)-                ((Data.Singletons.ShowSing.showsSingPrec 10)-                   argL_0123456789876543210))-               (((.) (showString " :%*: "))-                  ((Data.Singletons.ShowSing.showsSingPrec 10)-                     argR_0123456789876543210)))-    instance Data.Singletons.ShowSing.ShowSing a =>-             Show (Sing (z :: T a ())) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance Data.Singletons.ShowSing.ShowSing S where-      Data.Singletons.ShowSing.showsSingPrec _ SS1 = showString "SS1"-      Data.Singletons.ShowSing.showsSingPrec _ SS2 = showString "SS2"-    instance Show (Sing (z :: S)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance (SingI n, SingI n) =>-             SingI ((:*:) (n :: a) (n :: b)) where-      sing = ((:%*:) sing) sing-    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.ghc84.template 
@@ -1,405 +0,0 @@-Singletons/Star.hs:0:0:: Splicing declarations-    singletonStar [''Nat, ''Int, ''String, ''Maybe, ''Vec]-  ======>-    data Rep-      = Singletons.Star.Nat |-        Singletons.Star.Int |-        Singletons.Star.String |-        Singletons.Star.Maybe Rep |-        Singletons.Star.Vec Rep Nat-      deriving (Eq, Ord, Read, Show)-    type NatSym0 = Nat-    type IntSym0 = Int-    type StringSym0 = String-    type MaybeSym1 (t :: Type) = Maybe t-    instance SuppressUnusedWarnings MaybeSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MaybeSym0KindInference) GHC.Tuple.())-    data MaybeSym0 (l :: TyFun Type Type)-      = forall arg. SameKind (Apply MaybeSym0 arg) (MaybeSym1 arg) =>-        MaybeSym0KindInference-    type instance Apply MaybeSym0 l = Maybe l-    type VecSym2 (t :: Type) (t :: Nat) = Vec t t-    instance SuppressUnusedWarnings VecSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) VecSym1KindInference) GHC.Tuple.())-    data VecSym1 (l :: Type) (l :: TyFun Nat Type)-      = forall arg. SameKind (Apply (VecSym1 l) arg) (VecSym2 l arg) =>-        VecSym1KindInference-    type instance Apply (VecSym1 l) l = Vec l l-    instance SuppressUnusedWarnings VecSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) VecSym0KindInference) GHC.Tuple.())-    data VecSym0 (l :: TyFun Type (TyFun Nat Type -> Type))-      = forall arg. SameKind (Apply VecSym0 arg) (VecSym1 arg) =>-        VecSym0KindInference-    type instance Apply VecSym0 l = VecSym1 l-    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 (t :: Type) (t :: Type) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Type) (l :: TyFun Type Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Type (TyFun Type Ordering-                                                           -> Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) (t :: Type) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: Type) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun Type (TyFun Symbol Symbol-                                                                                  -> Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun Type (TyFun Symbol Symbol-                                                                                  -> Type)-                                                                      -> Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    instance PShow Type where-      type ShowsPrec a a a = Apply (Apply (Apply ShowsPrec_0123456789876543210Sym0 a) a) a-    data instance Sing (z :: 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-              (GHC.Tuple.(,) (toSing b :: SomeSing Type))-                (toSing b :: SomeSing Nat)-          of {-            GHC.Tuple.(,) (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 (GHC.Tuple.(,) (((%~) a) b)) (((%~) a) b) of-            GHC.Tuple.(,) (Proved Refl) (Proved Refl) -> Proved Refl-            GHC.Tuple.(,) (Disproved contra) _-              -> Disproved (\ refl -> case refl of { Refl -> contra Refl })-            GHC.Tuple.(,) _ (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 (TyFun Type Ordering-                                                             -> Type)-                                                 -> 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 (TyFun Type (TyFun Symbol Symbol-                                                                                              -> Type)-                                                                                  -> Type)-                                                             -> 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 n, SingI n) =>-             SingI (Vec (n :: Type) (n :: Nat)) where-      sing = (SVec sing) sing
− tests/compile-and-dump/Singletons/Star.hs 
@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -Wno-unused-imports #-}--module Singletons.Star where--import Data.Singletons.Prelude-import Data.Singletons.Decide-import Data.Singletons.CustomStar-import Singletons.Nat-import Data.Kind--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.ghc84.template 
@@ -1,29 +0,0 @@-Singletons/T124.hs:(0,0)-(0,0): Splicing declarations-    singletons-      [d| foo :: Bool -> ()-          foo True = ()-          foo False = () |]-  ======>-    foo :: Bool -> ()-    foo True = GHC.Tuple.()-    foo False = GHC.Tuple.()-    type FooSym1 (t :: Bool) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun Bool ())-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    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-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.ghc84.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 GHC.Types.[] = [True]-      succ (False GHC.Types.: as) = (True GHC.Types.: as)-      succ (True GHC.Types.: as) = (False GHC.Types.: (succ as))-      pred GHC.Types.[] = error "pred 0"-      pred (False GHC.Types.: as) = (True GHC.Types.: (pred as))-      pred (True GHC.Types.: as) = (False GHC.Types.: as)-      toEnum i-        | (i < 0) = error "negative toEnum"-        | (i == 0) = []-        | otherwise = succ (toEnum (pred i))-      fromEnum GHC.Types.[] = 0-      fromEnum (False GHC.Types.: as) = (2 * (fromEnum as))-      fromEnum (True GHC.Types.: 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 (t :: [Bool]) =-        Succ_0123456789876543210 t-    instance SuppressUnusedWarnings Succ_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Succ_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Succ_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply Succ_0123456789876543210Sym0 arg) (Succ_0123456789876543210Sym1 arg) =>-        Succ_0123456789876543210Sym0KindInference-    type instance Apply Succ_0123456789876543210Sym0 l = Succ_0123456789876543210 l-    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 (t :: [Bool]) =-        Pred_0123456789876543210 t-    instance SuppressUnusedWarnings Pred_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Pred_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Pred_0123456789876543210Sym0 (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply Pred_0123456789876543210Sym0 arg) (Pred_0123456789876543210Sym1 arg) =>-        Pred_0123456789876543210Sym0KindInference-    type instance Apply Pred_0123456789876543210Sym0 l = Pred_0123456789876543210 l-    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 (t :: GHC.Types.Nat) =-        ToEnum_0123456789876543210 t-    instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat [Bool])-      = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>-        ToEnum_0123456789876543210Sym0KindInference-    type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l-    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 (t :: [Bool]) =-        FromEnum_0123456789876543210 t-    instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FromEnum_0123456789876543210Sym0 (l :: TyFun [Bool] GHC.Types.Nat)-      = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>-        FromEnum_0123456789876543210Sym0KindInference-    type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l-    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.ghc84.template 
@@ -1,48 +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 (t :: a0123456789876543210) = Meth t-    instance SuppressUnusedWarnings MethSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MethSym0KindInference) GHC.Tuple.())-    data MethSym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply MethSym0 arg) (MethSym1 arg) =>-        MethSym0KindInference-    type instance Apply MethSym0 l = Meth l-    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)-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 (t :: Bool) =-        Meth_0123456789876543210 t-    instance SuppressUnusedWarnings Meth_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Meth_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Meth_0123456789876543210Sym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply Meth_0123456789876543210Sym0 arg) (Meth_0123456789876543210Sym1 arg) =>-        Meth_0123456789876543210Sym0KindInference-    type instance Apply Meth_0123456789876543210Sym0 l = Meth_0123456789876543210 l-    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.ghc84.template 
@@ -1,30 +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 (t :: f0123456789876543210 a0123456789876543210) (t :: a0123456789876543210) =-        Col t t-    instance SuppressUnusedWarnings ColSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ColSym1KindInference) GHC.Tuple.())-    data ColSym1 (l :: f0123456789876543210 a0123456789876543210) (l :: TyFun a0123456789876543210 Bool)-      = forall arg. SameKind (Apply (ColSym1 l) arg) (ColSym2 l arg) =>-        ColSym1KindInference-    type instance Apply (ColSym1 l) l = Col l l-    instance SuppressUnusedWarnings ColSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ColSym0KindInference) GHC.Tuple.())-    data ColSym0 (l :: TyFun (f0123456789876543210 a0123456789876543210) (TyFun a0123456789876543210 Bool-                                                                          -> Type))-      = forall arg. SameKind (Apply ColSym0 arg) (ColSym1 arg) =>-        ColSym0KindInference-    type instance Apply ColSym0 l = ColSym1 l-    class PColumn (f :: Type -> Type) where-      type Col (arg :: f a) (arg :: a) :: Bool-    class SColumn (f :: Type -> Type) where-      sCol ::-        forall (t :: f a) (t :: a).-        Sing t -> Sing t -> Sing (Apply (Apply ColSym0 t) t :: Bool)
− tests/compile-and-dump/Singletons/T145.hs 
@@ -1,9 +0,0 @@-module Singletons.T145 where--import Data.Singletons.TH-import Data.Kind--$(singletons [d|-  class Column (f :: Type -> Type) where-    col :: f a -> a -> Bool-  |])
− tests/compile-and-dump/Singletons/T153.ghc84.template 
− tests/compile-and-dump/Singletons/T153.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE LambdaCase, GADTs, ScopedTypeVariables, TypeInType,-             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.ghc84.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.ghc84.template 
@@ -1,184 +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 (z :: T0)-      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 (t :: T0) (t :: T1) = C1 t t-    instance SuppressUnusedWarnings C1Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) C1Sym1KindInference) GHC.Tuple.())-    data C1Sym1 (l :: T0) (l :: TyFun T1 T1)-      = forall arg. SameKind (Apply (C1Sym1 l) arg) (C1Sym2 l arg) =>-        C1Sym1KindInference-    type instance Apply (C1Sym1 l) l = C1 l l-    instance SuppressUnusedWarnings C1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) C1Sym0KindInference) GHC.Tuple.())-    data C1Sym0 (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type))-      = forall arg. SameKind (Apply C1Sym0 arg) (C1Sym1 arg) =>-        C1Sym0KindInference-    type instance Apply C1Sym0 l = C1Sym1 l-    type (:&&@#@$$$) (t :: T0) (t :: T1) = (:&&) t t-    instance SuppressUnusedWarnings (:&&@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::&&@#@$$###)) GHC.Tuple.())-    data (:&&@#@$$) (l :: T0) (l :: TyFun T1 T1)-      = forall arg. SameKind (Apply ((:&&@#@$$) l) arg) ((:&&@#@$$$) l arg) =>-        (::&&@#@$$###)-    type instance Apply ((:&&@#@$$) l) l = (:&&) l l-    instance SuppressUnusedWarnings (:&&@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::&&@#@$###)) GHC.Tuple.())-    data (:&&@#@$) (l :: TyFun T0 (TyFun T1 T1 -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:&&@#@$) arg) ((:&&@#@$$) arg) =>-        (::&&@#@$###)-    type instance Apply (:&&@#@$) l = (:&&@#@$$) l-    data instance Sing (z :: T1)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC1 c) c) }-      toSing ((:&&) (b :: Demote T0) (b :: Demote T1))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T1)-          of {-            GHC.Tuple.(,) (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 n, SingI n) =>-             SingI ((:&&) (n :: T0) (n :: T1)) where-      sing = ((:%&&) sing) sing-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 (t :: T0) (t :: T2) = C2 t t-    instance SuppressUnusedWarnings C2Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) C2Sym1KindInference) GHC.Tuple.())-    data C2Sym1 (l :: T0) (l :: TyFun T2 T2)-      = forall arg. SameKind (Apply (C2Sym1 l) arg) (C2Sym2 l arg) =>-        C2Sym1KindInference-    type instance Apply (C2Sym1 l) l = C2 l l-    instance SuppressUnusedWarnings C2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) C2Sym0KindInference) GHC.Tuple.())-    data C2Sym0 (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type))-      = forall arg. SameKind (Apply C2Sym0 arg) (C2Sym1 arg) =>-        C2Sym0KindInference-    type instance Apply C2Sym0 l = C2Sym1 l-    type (:||@#@$$$) (t :: T0) (t :: T2) = (:||) t t-    instance SuppressUnusedWarnings (:||@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::||@#@$$###)) GHC.Tuple.())-    data (:||@#@$$) (l :: T0) (l :: TyFun T2 T2)-      = forall arg. SameKind (Apply ((:||@#@$$) l) arg) ((:||@#@$$$) l arg) =>-        (::||@#@$$###)-    type instance Apply ((:||@#@$$) l) l = (:||) l l-    instance SuppressUnusedWarnings (:||@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::||@#@$###)) GHC.Tuple.())-    data (:||@#@$) (l :: TyFun T0 (TyFun T2 T2 -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:||@#@$) arg) ((:||@#@$$) arg) =>-        (::||@#@$###)-    type instance Apply (:||@#@$) l = (:||@#@$$) l-    infixr 5 :%||-    infixr 5 `SC2`-    data instance Sing (z :: T2)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((SC2 c) c) }-      toSing ((:||) (b :: Demote T0) (b :: Demote T2))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing T0)) (toSing b :: SomeSing T2)-          of {-            GHC.Tuple.(,) (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 n, SingI n) =>-             SingI ((:||) (n :: T0) (n :: T2)) where-      sing = ((:%||) sing) sing
− 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/T163.ghc84.template 
@@ -1,37 +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 (t :: a0123456789876543210) = L t-    instance SuppressUnusedWarnings LSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) LSym0KindInference) GHC.Tuple.())-    data LSym0 (l :: TyFun a0123456789876543210 ((+) a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply LSym0 arg) (LSym1 arg) =>-        LSym0KindInference-    type instance Apply LSym0 l = L l-    type RSym1 (t :: b0123456789876543210) = R t-    instance SuppressUnusedWarnings RSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) RSym0KindInference) GHC.Tuple.())-    data RSym0 (l :: TyFun b0123456789876543210 ((+) a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply RSym0 arg) (RSym1 arg) =>-        RSym0KindInference-    type instance Apply RSym0 l = R l-    data instance Sing (z :: (+) a b)-      where-        SL :: forall (n :: a). (Sing (n :: a)) -> Sing (L n)-        SR :: forall (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 n => SingI (R (n :: b)) where-      sing = SR sing
− 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.ghc84.template 
@@ -1,11 +0,0 @@--Singletons/T166.hs:0:0: error:-    Function being promoted to FooSym0 has too many arguments.-   |-14 | $(singletonsOnly [d|-   |   ^^^^^^^^^^^^^^^^^^...--Singletons/T166.hs:0:0: error: Q monad failure-   |-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.ghc84.template 
@@ -1,149 +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 (t :: Nat) (t :: a0123456789876543210) (t :: [Bool]) =-        FoosPrec t t t-    instance SuppressUnusedWarnings FoosPrecSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FoosPrecSym2KindInference) GHC.Tuple.())-    data FoosPrecSym2 (l :: Nat) (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply (FoosPrecSym2 l l) arg) (FoosPrecSym3 l l arg) =>-        FoosPrecSym2KindInference-    type instance Apply (FoosPrecSym2 l l) l = FoosPrec l l l-    instance SuppressUnusedWarnings FoosPrecSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FoosPrecSym1KindInference) GHC.Tuple.())-    data FoosPrecSym1 (l :: Nat) (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool]-                                                                   -> GHC.Types.Type))-      = forall arg. SameKind (Apply (FoosPrecSym1 l) arg) (FoosPrecSym2 l arg) =>-        FoosPrecSym1KindInference-    type instance Apply (FoosPrecSym1 l) l = FoosPrecSym2 l l-    instance SuppressUnusedWarnings FoosPrecSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FoosPrecSym0KindInference) GHC.Tuple.())-    data FoosPrecSym0 (l :: TyFun Nat (TyFun a0123456789876543210 (TyFun [Bool] [Bool]-                                                                   -> GHC.Types.Type)-                                       -> GHC.Types.Type))-      = forall arg. SameKind (Apply FoosPrecSym0 arg) (FoosPrecSym1 arg) =>-        FoosPrecSym0KindInference-    type instance Apply FoosPrecSym0 l = FoosPrecSym1 l-    type FooListSym2 (t :: a0123456789876543210) (t :: [Bool]) =-        FooList t t-    instance SuppressUnusedWarnings FooListSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooListSym1KindInference) GHC.Tuple.())-    data FooListSym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply (FooListSym1 l) arg) (FooListSym2 l arg) =>-        FooListSym1KindInference-    type instance Apply (FooListSym1 l) l = FooList l l-    instance SuppressUnusedWarnings FooListSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooListSym0KindInference) GHC.Tuple.())-    data FooListSym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool]-                                                       -> GHC.Types.Type))-      = forall arg. SameKind (Apply FooListSym0 arg) (FooListSym1 arg) =>-        FooListSym0KindInference-    type instance Apply FooListSym0 l = FooListSym1 l-    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 (t :: a0123456789876543210) (t :: [Bool]) =-        FooList_0123456789876543210 t t-    instance SuppressUnusedWarnings FooList_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FooList_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data FooList_0123456789876543210Sym1 (l :: a0123456789876543210) (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply (FooList_0123456789876543210Sym1 l) arg) (FooList_0123456789876543210Sym2 l arg) =>-        FooList_0123456789876543210Sym1KindInference-    type instance Apply (FooList_0123456789876543210Sym1 l) l = FooList_0123456789876543210 l l-    instance SuppressUnusedWarnings FooList_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FooList_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FooList_0123456789876543210Sym0 (l :: TyFun a0123456789876543210 (TyFun [Bool] [Bool]-                                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply FooList_0123456789876543210Sym0 arg) (FooList_0123456789876543210Sym1 arg) =>-        FooList_0123456789876543210Sym0KindInference-    type instance Apply FooList_0123456789876543210Sym0 l = FooList_0123456789876543210Sym1 l-    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 (t :: Nat) (t :: [a0123456789876543210]) (t :: [Bool]) =-        FoosPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data FoosPrec_0123456789876543210Sym2 (l :: Nat) (l :: [a0123456789876543210]) (l :: TyFun [Bool] [Bool])-      = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym2 l l) arg) (FoosPrec_0123456789876543210Sym3 l l arg) =>-        FoosPrec_0123456789876543210Sym2KindInference-    type instance Apply (FoosPrec_0123456789876543210Sym2 l l) l = FoosPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data FoosPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun [a0123456789876543210] (TyFun [Bool] [Bool]-                                                                                         -> GHC.Types.Type))-      = forall arg. SameKind (Apply (FoosPrec_0123456789876543210Sym1 l) arg) (FoosPrec_0123456789876543210Sym2 l arg) =>-        FoosPrec_0123456789876543210Sym1KindInference-    type instance Apply (FoosPrec_0123456789876543210Sym1 l) l = FoosPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings FoosPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FoosPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FoosPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun [a0123456789876543210] (TyFun [Bool] [Bool]-                                                                                         -> GHC.Types.Type)-                                                           -> GHC.Types.Type))-      = forall arg. SameKind (Apply FoosPrec_0123456789876543210Sym0 arg) (FoosPrec_0123456789876543210Sym1 arg) =>-        FoosPrec_0123456789876543210Sym0KindInference-    type instance Apply FoosPrec_0123456789876543210Sym0 l = FoosPrec_0123456789876543210Sym1 l-    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
− tests/compile-and-dump/Singletons/T167.hs 
@@ -1,27 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# 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.ghc84.template 
@@ -1,31 +0,0 @@-Singletons/T172.hs:(0,0)-(0,0): Splicing declarations-    singletonsOnly-      [d| ($>) :: Nat -> Nat -> Nat-          ($>) = (+) |]-  ======>-    type ($>@#@$$$) (t :: Nat) (t :: Nat) = ($>) t t-    instance SuppressUnusedWarnings ($>@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$>@#@$$###)) GHC.Tuple.())-    data ($>@#@$$) (l :: Nat) (l :: TyFun Nat Nat)-      = forall arg. SameKind (Apply (($>@#@$$) l) arg) (($>@#@$$$) l arg) =>-        (:$>@#@$$###)-    type instance Apply (($>@#@$$) l) l = ($>) l l-    instance SuppressUnusedWarnings ($>@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$>@#@$###)) GHC.Tuple.())-    data ($>@#@$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type))-      = forall arg. SameKind (Apply ($>@#@$) arg) (($>@#@$$) arg) =>-        (:$>@#@$###)-    type instance Apply ($>@#@$) l = ($>@#@$$) l-    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
− 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.ghc84.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 :: 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,29 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# 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.ghc84.template 
@@ -1,137 +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 t t =-        Lambda_0123456789876543210 t t-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym1 l l-      = forall arg. SameKind (Apply (Lambda_0123456789876543210Sym1 l) arg) (Lambda_0123456789876543210Sym2 l arg) =>-        Lambda_0123456789876543210Sym1KindInference-    type instance Apply (Lambda_0123456789876543210Sym1 l) l = Lambda_0123456789876543210 l l-    instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Lambda_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Lambda_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) =>-        Lambda_0123456789876543210Sym0KindInference-    type instance Apply Lambda_0123456789876543210Sym0 l = Lambda_0123456789876543210Sym1 l-    type Quux2Sym1 (t :: a0123456789876543210) = Quux2 t-    instance SuppressUnusedWarnings Quux2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Quux2Sym0KindInference) GHC.Tuple.())-    data Quux2Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Quux2Sym0 arg) (Quux2Sym1 arg) =>-        Quux2Sym0KindInference-    type instance Apply Quux2Sym0 l = Quux2 l-    type Quux1Sym1 (t :: a0123456789876543210) = Quux1 t-    instance SuppressUnusedWarnings Quux1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Quux1Sym0KindInference) GHC.Tuple.())-    data Quux1Sym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply Quux1Sym0 arg) (Quux1Sym1 arg) =>-        Quux1Sym0KindInference-    type instance Apply Quux1Sym0 l = Quux1 l-    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 (t :: a0123456789876543210) (t :: TyFun a0123456789876543210 b0123456789876543210-                                                    -> Type) =-        Bar1 t t-    instance SuppressUnusedWarnings Bar1Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Bar1Sym1KindInference) GHC.Tuple.())-    data Bar1Sym1 (l :: a0123456789876543210) (l :: TyFun (TyFun a0123456789876543210 b0123456789876543210-                                                           -> Type) b0123456789876543210)-      = forall arg. SameKind (Apply (Bar1Sym1 l) arg) (Bar1Sym2 l arg) =>-        Bar1Sym1KindInference-    type instance Apply (Bar1Sym1 l) l = Bar1 l l-    instance SuppressUnusedWarnings Bar1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Bar1Sym0KindInference) GHC.Tuple.())-    data Bar1Sym0 (l :: TyFun a0123456789876543210 (TyFun (TyFun a0123456789876543210 b0123456789876543210-                                                           -> Type) b0123456789876543210-                                                    -> Type))-      = forall arg. SameKind (Apply Bar1Sym0 arg) (Bar1Sym1 arg) =>-        Bar1Sym0KindInference-    type instance Apply Bar1Sym0 l = Bar1Sym1 l-    type Baz1Sym0 = Baz1-    class PFoo1 (a :: Type) where-      type Bar1 (arg :: a) (arg :: TyFun a b -> Type) :: b-      type Baz1 :: a-    type Bar2Sym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        Bar2 t t-    instance SuppressUnusedWarnings Bar2Sym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Bar2Sym1KindInference) GHC.Tuple.())-    data Bar2Sym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 b0123456789876543210)-      = forall arg. SameKind (Apply (Bar2Sym1 l) arg) (Bar2Sym2 l arg) =>-        Bar2Sym1KindInference-    type instance Apply (Bar2Sym1 l) l = Bar2 l l-    instance SuppressUnusedWarnings Bar2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) Bar2Sym0KindInference) GHC.Tuple.())-    data Bar2Sym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 b0123456789876543210-                                                    -> Type))-      = forall arg. SameKind (Apply Bar2Sym0 arg) (Bar2Sym1 arg) =>-        Bar2Sym0KindInference-    type instance Apply Bar2Sym0 l = Bar2Sym1 l-    type Baz2Sym0 = Baz2-    class PFoo2 (a :: Type) where-      type Bar2 (arg :: a) (arg :: b) :: b-      type Baz2 :: a-    sQuux2 ::-      forall (t :: a). SFoo2 a => Sing t -> Sing (Apply Quux2Sym0 t :: a)-    sQuux1 ::-      forall (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) }))-    class SFoo1 a where-      sBar1 ::-        forall (t :: a) (t :: TyFun a b -> Type).-        Sing t -> Sing t -> Sing (Apply (Apply Bar1Sym0 t) t :: b)-      sBaz1 :: Sing (Baz1Sym0 :: a)-    class SFoo2 a where-      sBar2 ::-        forall (t :: a) (t :: b).-        Sing t -> Sing t -> Sing (Apply (Apply Bar2Sym0 t) t :: b)-      sBaz2 :: Sing (Baz2Sym0 :: a)
− tests/compile-and-dump/Singletons/T176.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# 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.ghc84.template 
@@ -1,217 +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 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 (t :: Occ) (t :: Occ) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Occ) (l :: TyFun Occ Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Occ (TyFun Occ Ordering-                                                          -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: Nat) (t :: Occ) (t :: Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: Nat) (l :: Occ) (l :: TyFun Symbol Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: Nat) (l :: TyFun Occ (TyFun Symbol Symbol-                                                                       -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun Nat (TyFun Occ (TyFun Symbol Symbol-                                                                       -> GHC.Types.Type)-                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (z :: Occ)-      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 (TyFun Occ Ordering-                                                            -> GHC.Types.Type)-                                                 -> 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 (TyFun Occ (TyFun Symbol Symbol-                                                                                   -> GHC.Types.Type)-                                                                        -> GHC.Types.Type)-                                                             -> 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-    instance Data.Singletons.ShowSing.ShowSing Occ where-      Data.Singletons.ShowSing.showsSingPrec _ SStr = showString "SStr"-      Data.Singletons.ShowSing.showsSingPrec _ SOpt = showString "SOpt"-      Data.Singletons.ShowSing.showsSingPrec _ SMany = showString "SMany"-    instance Show (Sing (z :: Occ)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    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/T187.ghc84.template 
@@ -1,58 +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 (t :: Empty) (t :: Empty) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Empty) (l :: TyFun Empty Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun Empty (TyFun Empty Ordering-                                                            -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (z :: Empty)-    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 (TyFun Empty Ordering-                                                              -> GHC.Types.Type)-                                                 -> 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.ghc84.template 
@@ -1,194 +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 (t :: T) (t :: T) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: T) (l :: TyFun T Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun T (TyFun T Ordering-                                                        -> GHC.Types.Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: GHC.Types.Nat) =-        ToEnum_0123456789876543210 t-    instance SuppressUnusedWarnings ToEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ToEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ToEnum_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat T)-      = forall arg. SameKind (Apply ToEnum_0123456789876543210Sym0 arg) (ToEnum_0123456789876543210Sym1 arg) =>-        ToEnum_0123456789876543210Sym0KindInference-    type instance Apply ToEnum_0123456789876543210Sym0 l = ToEnum_0123456789876543210 l-    type family FromEnum_0123456789876543210 (a :: T) :: GHC.Types.Nat where-      FromEnum_0123456789876543210 T = Data.Singletons.Prelude.Num.FromInteger 0-    type FromEnum_0123456789876543210Sym1 (t :: T) =-        FromEnum_0123456789876543210 t-    instance SuppressUnusedWarnings FromEnum_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) FromEnum_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data FromEnum_0123456789876543210Sym0 (l :: TyFun T GHC.Types.Nat)-      = forall arg. SameKind (Apply FromEnum_0123456789876543210Sym0 arg) (FromEnum_0123456789876543210Sym1 arg) =>-        FromEnum_0123456789876543210Sym0KindInference-    type instance Apply FromEnum_0123456789876543210Sym0 l = FromEnum_0123456789876543210 l-    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 (t :: GHC.Types.Nat) (t :: T) (t :: GHC.Types.Symbol) =-        ShowsPrec_0123456789876543210 t t t-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym2 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym2KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym2 (l :: GHC.Types.Nat) (l :: T) (l :: TyFun GHC.Types.Symbol GHC.Types.Symbol)-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym2 l l) arg) (ShowsPrec_0123456789876543210Sym3 l l arg) =>-        ShowsPrec_0123456789876543210Sym2KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym2 l l) l = ShowsPrec_0123456789876543210 l l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym1 (l :: GHC.Types.Nat) (l :: TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                               -> GHC.Types.Type))-      = forall arg. SameKind (Apply (ShowsPrec_0123456789876543210Sym1 l) arg) (ShowsPrec_0123456789876543210Sym2 l arg) =>-        ShowsPrec_0123456789876543210Sym1KindInference-    type instance Apply (ShowsPrec_0123456789876543210Sym1 l) l = ShowsPrec_0123456789876543210Sym2 l l-    instance SuppressUnusedWarnings ShowsPrec_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) ShowsPrec_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data ShowsPrec_0123456789876543210Sym0 (l :: TyFun GHC.Types.Nat (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                               -> GHC.Types.Type)-                                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply ShowsPrec_0123456789876543210Sym0 arg) (ShowsPrec_0123456789876543210Sym1 arg) =>-        ShowsPrec_0123456789876543210Sym0KindInference-    type instance Apply ShowsPrec_0123456789876543210Sym0 l = ShowsPrec_0123456789876543210Sym1 l-    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 (z :: T) 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 (TyFun T Ordering-                                                          -> GHC.Types.Type)-                                                 -> 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 (TyFun T (TyFun GHC.Types.Symbol GHC.Types.Symbol-                                                                                           -> GHC.Types.Type)-                                                                                  -> GHC.Types.Type)-                                                             -> 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-    instance Data.Singletons.ShowSing.ShowSing T where-      Data.Singletons.ShowSing.showsSingPrec _ ST = showString "ST"-    instance Show (Sing (z :: T)) where-      showsPrec = Data.Singletons.ShowSing.showsSingPrec-    instance SingI T where-      sing = ST
− tests/compile-and-dump/Singletons/T190.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}-{-# 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.ghc84.template 
@@ -1,33 +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 ($$:@#@$$$) (t :: Bool) (t :: Bool) = ($$:) t t-    instance SuppressUnusedWarnings ($$:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.())-    data ($$:@#@$$) (l :: Bool) (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) =>-        (:$$:@#@$$###)-    type instance Apply (($$:@#@$$) l) l = ($$:) l l-    instance SuppressUnusedWarnings ($$:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.())-    data ($$:@#@$) (l :: TyFun Bool (TyFun Bool Bool-                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>-        (:$$:@#@$###)-    type instance Apply ($$:@#@$) l = ($$:@#@$$) l-    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
− 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.ghc84.template 
@@ -1,81 +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 (:*:@#@$$$) (t :: a0123456789876543210) (t :: b0123456789876543210) =-        (:*:) t t-    instance SuppressUnusedWarnings (:*:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$$###)) GHC.Tuple.())-    data (:*:@#@$$) (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply ((:*:@#@$$) l) arg) ((:*:@#@$$$) l arg) =>-        (::*:@#@$$###)-    type instance Apply ((:*:@#@$$) l) l = (:*:) l l-    instance SuppressUnusedWarnings (:*:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::*:@#@$###)) GHC.Tuple.())-    data (:*:@#@$) (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 ((:*:) a0123456789876543210 b0123456789876543210)-                                                     -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:*:@#@$) arg) ((:*:@#@$$) arg) =>-        (::*:@#@$###)-    type instance Apply (:*:@#@$) l = (:*:@#@$$) l-    type MkPairSym2 (t :: a0123456789876543210) (t :: b0123456789876543210) =-        MkPair t t-    instance SuppressUnusedWarnings MkPairSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkPairSym1KindInference) GHC.Tuple.())-    data MkPairSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply (MkPairSym1 l) arg) (MkPairSym2 l arg) =>-        MkPairSym1KindInference-    type instance Apply (MkPairSym1 l) l = MkPair l l-    instance SuppressUnusedWarnings MkPairSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkPairSym0KindInference) GHC.Tuple.())-    data MkPairSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (Pair a0123456789876543210 b0123456789876543210)-                                                      -> GHC.Types.Type))-      = forall arg. SameKind (Apply MkPairSym0 arg) (MkPairSym1 arg) =>-        MkPairSym0KindInference-    type instance Apply MkPairSym0 l = MkPairSym1 l-    infixr 9 `SMkPair`-    infixr 9 `SPair`-    data instance Sing (z :: (:*:) a b)-      where-        (:%*:) :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing (((:%*:) c) c) }-    data instance Sing (z :: Pair a b)-      where-        SMkPair :: forall (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-              (GHC.Tuple.(,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing ((SMkPair c) c) }-    instance (SingI n, SingI n) =>-             SingI ((:*:) (n :: a) (n :: b)) where-      sing = ((:%*:) sing) sing-    instance (SingI n, SingI n) =>-             SingI (MkPair (n :: a) (n :: b)) where-      sing = (SMkPair sing) sing
− 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.ghc84.template 
@@ -1,154 +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 (:$$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) =-        (:$$:) t t-    instance SuppressUnusedWarnings (:$$:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::$$:@#@$$###)) GHC.Tuple.())-    data (:$$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage)-      = forall arg. SameKind (Apply ((:$$:@#@$$) l) arg) ((:$$:@#@$$$) l arg) =>-        (::$$:@#@$$###)-    type instance Apply ((:$$:@#@$$) l) l = (:$$:) l l-    instance SuppressUnusedWarnings (:$$:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::$$:@#@$###)) GHC.Tuple.())-    data (:$$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage-                                              -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:$$:@#@$) arg) ((:$$:@#@$$) arg) =>-        (::$$:@#@$###)-    type instance Apply (:$$:@#@$) l = (:$$:@#@$$) l-    type (:<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) =-        (:<>:) t t-    instance SuppressUnusedWarnings (:<>:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::<>:@#@$$###)) GHC.Tuple.())-    data (:<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage)-      = forall arg. SameKind (Apply ((:<>:@#@$$) l) arg) ((:<>:@#@$$$) l arg) =>-        (::<>:@#@$$###)-    type instance Apply ((:<>:@#@$$) l) l = (:<>:) l l-    instance SuppressUnusedWarnings (:<>:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (::<>:@#@$###)) GHC.Tuple.())-    data (:<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage-                                              -> GHC.Types.Type))-      = forall arg. SameKind (Apply (:<>:@#@$) arg) ((:<>:@#@$$) arg) =>-        (::<>:@#@$###)-    type instance Apply (:<>:@#@$) l = (:<>:@#@$$) l-    type EMSym1 (t :: [Bool]) = EM t-    instance SuppressUnusedWarnings EMSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) EMSym0KindInference) GHC.Tuple.())-    data EMSym0 (l :: TyFun [Bool] ErrorMessage)-      = forall arg. SameKind (Apply EMSym0 arg) (EMSym1 arg) =>-        EMSym0KindInference-    type instance Apply EMSym0 l = EM l-    type (<>:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) =-        (<>:) t t-    instance SuppressUnusedWarnings (<>:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<>:@#@$$###)) GHC.Tuple.())-    data (<>:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage)-      = forall arg. SameKind (Apply ((<>:@#@$$) l) arg) ((<>:@#@$$$) l arg) =>-        (:<>:@#@$$###)-    type instance Apply ((<>:@#@$$) l) l = (<>:) l l-    instance SuppressUnusedWarnings (<>:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:<>:@#@$###)) GHC.Tuple.())-    data (<>:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage-                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (<>:@#@$) arg) ((<>:@#@$$) arg) =>-        (:<>:@#@$###)-    type instance Apply (<>:@#@$) l = (<>:@#@$$) l-    type ($$:@#@$$$) (t :: ErrorMessage) (t :: ErrorMessage) =-        ($$:) t t-    instance SuppressUnusedWarnings ($$:@#@$$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$$:@#@$$###)) GHC.Tuple.())-    data ($$:@#@$$) (l :: ErrorMessage) (l :: TyFun ErrorMessage ErrorMessage)-      = forall arg. SameKind (Apply (($$:@#@$$) l) arg) (($$:@#@$$$) l arg) =>-        (:$$:@#@$$###)-    type instance Apply (($$:@#@$$) l) l = ($$:) l l-    instance SuppressUnusedWarnings ($$:@#@$) where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) (:$$:@#@$###)) GHC.Tuple.())-    data ($$:@#@$) (l :: TyFun ErrorMessage (TyFun ErrorMessage ErrorMessage-                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply ($$:@#@$) arg) (($$:@#@$$) arg) =>-        (:$$:@#@$###)-    type instance Apply ($$:@#@$) l = ($$:@#@$$) l-    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-    data instance Sing (z :: ErrorMessage)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage))-                (toSing b :: SomeSing ErrorMessage)-          of {-            GHC.Tuple.(,) (SomeSing c) (SomeSing c)-              -> SomeSing (((:%$$:) c) c) }-      toSing-        ((:<>:) (b :: Demote ErrorMessage) (b :: Demote ErrorMessage))-        = case-              (GHC.Tuple.(,) (toSing b :: SomeSing ErrorMessage))-                (toSing b :: SomeSing ErrorMessage)-          of {-            GHC.Tuple.(,) (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 n, SingI n) =>-             SingI ((:<>:) (n :: ErrorMessage) (n :: ErrorMessage)) where-      sing = ((:%<>:) sing) sing-    instance SingI n => SingI (EM (n :: [Bool])) where-      sing = SEM sing
− 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.ghc84.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.ghc84.template 
@@ -1,68 +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 (t :: a0123456789876543210) (t :: b0123456789876543210) (t :: Bool) =-        M t t t-    instance SuppressUnusedWarnings MSym2 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MSym2KindInference) GHC.Tuple.())-    data MSym2 (l :: a0123456789876543210) (l :: b0123456789876543210) (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply (MSym2 l l) arg) (MSym3 l l arg) =>-        MSym2KindInference-    type instance Apply (MSym2 l l) l = M l l l-    instance SuppressUnusedWarnings MSym1 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MSym1KindInference) GHC.Tuple.())-    data MSym1 (l :: a0123456789876543210) (l :: TyFun b0123456789876543210 (TyFun Bool Bool-                                                                             -> GHC.Types.Type))-      = forall arg. SameKind (Apply (MSym1 l) arg) (MSym2 l arg) =>-        MSym1KindInference-    type instance Apply (MSym1 l) l = MSym2 l l-    instance SuppressUnusedWarnings MSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MSym0KindInference) GHC.Tuple.())-    data MSym0 (l :: TyFun a0123456789876543210 (TyFun b0123456789876543210 (TyFun Bool Bool-                                                                             -> GHC.Types.Type)-                                                 -> GHC.Types.Type))-      = forall arg. SameKind (Apply MSym0 arg) (MSym1 arg) =>-        MSym0KindInference-    type instance Apply MSym0 l = MSym1 l-    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 (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-    data instance Sing (z :: Hm) 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/T226.ghc84.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.ghc84.template 
@@ -1,20 +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 (t :: Bool) = US___foo t-    instance SuppressUnusedWarnings US___fooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) US___fooSym0KindInference) GHC.Tuple.())-    data US___fooSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply US___fooSym0 arg) (US___fooSym1 arg) =>-        US___fooSym0KindInference-    type instance Apply US___fooSym0 l = US___foo l-    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
− 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.ghc84.template 
@@ -1,69 +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 (t :: a0123456789876543210) = MkFoo1 t-    instance SuppressUnusedWarnings MkFoo1Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo1Sym0KindInference) GHC.Tuple.())-    data MkFoo1Sym0 (l :: TyFun a0123456789876543210 (Foo1 a0123456789876543210))-      = forall arg. SameKind (Apply MkFoo1Sym0 arg) (MkFoo1Sym1 arg) =>-        MkFoo1Sym0KindInference-    type instance Apply MkFoo1Sym0 l = MkFoo1 l-    type MkFoo2Sym1 (t :: x0123456789876543210) = MkFoo2 t-    instance SuppressUnusedWarnings MkFoo2Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo2Sym0KindInference) GHC.Tuple.())-    data MkFoo2Sym0 (l :: TyFun x0123456789876543210 (Foo2 a0123456789876543210))-      = forall arg. SameKind (Apply MkFoo2Sym0 arg) (MkFoo2Sym1 arg) =>-        MkFoo2Sym0KindInference-    type instance Apply MkFoo2Sym0 l = MkFoo2 l-    type MkFoo3Sym1 (t :: x0123456789876543210) = MkFoo3 t-    instance SuppressUnusedWarnings MkFoo3Sym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) MkFoo3Sym0KindInference) GHC.Tuple.())-    data MkFoo3Sym0 (l :: TyFun x0123456789876543210 (Foo3 a0123456789876543210))-      = forall arg. SameKind (Apply MkFoo3Sym0 arg) (MkFoo3Sym1 arg) =>-        MkFoo3Sym0KindInference-    type instance Apply MkFoo3Sym0 l = MkFoo3 l-    data instance Sing (z :: Foo1 a)-      where-        SMkFoo1 :: forall (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 (z :: Foo2 a)-      where-        SMkFoo2 :: forall (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 (z :: Foo3 a)-      where-        SMkFoo3 :: forall (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 n => SingI (MkFoo2 (n :: x)) where-      sing = SMkFoo2 sing-    instance SingI n => SingI (MkFoo3 (n :: x)) where-      sing = SMkFoo3 sing
− 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.ghc84.template 
@@ -1,179 +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 (t :: a0123456789876543210) = Constant t-    instance SuppressUnusedWarnings ConstantSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) ConstantSym0KindInference) GHC.Tuple.())-    data ConstantSym0 (l :: TyFun a0123456789876543210 (Constant a0123456789876543210 b0123456789876543210))-      = forall arg. SameKind (Apply ConstantSym0 arg) (ConstantSym1 arg) =>-        ConstantSym0KindInference-    type instance Apply ConstantSym0 l = Constant l-    type IdentitySym1 (t :: a0123456789876543210) = Identity t-    instance SuppressUnusedWarnings IdentitySym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) IdentitySym0KindInference) GHC.Tuple.())-    data IdentitySym0 (l :: TyFun a0123456789876543210 (Identity a0123456789876543210))-      = forall arg. SameKind (Apply IdentitySym0 arg) (IdentitySym1 arg) =>-        IdentitySym0KindInference-    type instance Apply IdentitySym0 l = Identity l-    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 (t :: Constant a0123456789876543210 b0123456789876543210) (t :: Constant a0123456789876543210 b0123456789876543210) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Constant a0123456789876543210 b0123456789876543210) (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun (Constant a0123456789876543210 b0123456789876543210) (TyFun (Constant a0123456789876543210 b0123456789876543210) Ordering-                                                                                                           -> Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (t :: Identity a0123456789876543210) (t :: Identity a0123456789876543210) =-        Compare_0123456789876543210 t t-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym1 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym1KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym1 (l :: Identity a0123456789876543210) (l :: TyFun (Identity a0123456789876543210) Ordering)-      = forall arg. SameKind (Apply (Compare_0123456789876543210Sym1 l) arg) (Compare_0123456789876543210Sym2 l arg) =>-        Compare_0123456789876543210Sym1KindInference-    type instance Apply (Compare_0123456789876543210Sym1 l) l = Compare_0123456789876543210 l l-    instance SuppressUnusedWarnings Compare_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,) Compare_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Compare_0123456789876543210Sym0 (l :: TyFun (Identity a0123456789876543210) (TyFun (Identity a0123456789876543210) Ordering-                                                                                      -> Type))-      = forall arg. SameKind (Apply Compare_0123456789876543210Sym0 arg) (Compare_0123456789876543210Sym1 arg) =>-        Compare_0123456789876543210Sym0KindInference-    type instance Apply Compare_0123456789876543210Sym0 l = Compare_0123456789876543210Sym1 l-    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 (z :: Constant a b)-      where-        SConstant :: forall (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 (z :: Identity a)-      where-        SIdentity :: forall (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) (TyFun (Constant a b) Ordering-                                                                       -> Type)-                                                 -> 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) (TyFun (Identity a) Ordering-                                                                     -> Type)-                                                 -> 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 n => SingI (Identity (n :: a)) where-      sing = SIdentity sing
− tests/compile-and-dump/Singletons/T271.hs 
@@ -1,13 +0,0 @@-module T271 where--import Data.Kind-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/T29.ghc84.template 
@@ -1,99 +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 (t :: Bool) = Ban t-    instance SuppressUnusedWarnings BanSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BanSym0KindInference) GHC.Tuple.())-    data BanSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply BanSym0 arg) (BanSym1 arg) =>-        BanSym0KindInference-    type instance Apply BanSym0 l = Ban l-    type BazSym1 (t :: Bool) = Baz t-    instance SuppressUnusedWarnings BazSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BazSym0KindInference) GHC.Tuple.())-    data BazSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply BazSym0 arg) (BazSym1 arg) =>-        BazSym0KindInference-    type instance Apply BazSym0 l = Baz l-    type BarSym1 (t :: Bool) = Bar t-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = Bar l-    type FooSym1 (t :: Bool) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    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
− 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/T33.ghc84.template 
@@ -1,32 +0,0 @@-Singletons/T33.hs:(0,0)-(0,0): Splicing declarations-    singletons-      [d| foo :: (Bool, Bool) -> ()-          foo ~(_, _) = () |]-  ======>-    foo :: (Bool, Bool) -> ()-    foo ~(_, _) = GHC.Tuple.()-    type FooSym1 (t :: (Bool, Bool)) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun (Bool, Bool) ())-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    type family Foo (a :: (Bool, Bool)) :: () where-      Foo '(_, _) = Tuple0Sym0-    sFoo ::-      forall (t :: (Bool, Bool)). Sing t -> Sing (Apply FooSym0 t :: ())-    sFoo (STuple2 _ _) = STuple0--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/T54.ghc84.template 
@@ -1,48 +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 t =-        Let0123456789876543210Scrutinee_0123456789876543210 t-    instance SuppressUnusedWarnings Let0123456789876543210Scrutinee_0123456789876543210Sym0 where-      suppressUnusedWarnings-        = snd-            ((GHC.Tuple.(,)-                Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference)-               GHC.Tuple.())-    data Let0123456789876543210Scrutinee_0123456789876543210Sym0 l-      = forall arg. SameKind (Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 arg) (Let0123456789876543210Scrutinee_0123456789876543210Sym1 arg) =>-        Let0123456789876543210Scrutinee_0123456789876543210Sym0KindInference-    type instance Apply Let0123456789876543210Scrutinee_0123456789876543210Sym0 l = Let0123456789876543210Scrutinee_0123456789876543210 l-    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 (t :: Bool) = G t-    instance SuppressUnusedWarnings GSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.())-    data GSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) =>-        GSym0KindInference-    type instance Apply GSym0 l = G l-    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
− 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.ghc84.template 
@@ -1,28 +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 (t :: Maybe Bool) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun (Maybe Bool) Bool)-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    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
− 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.ghc84.template 
@@ -1,308 +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 (t :: Bool) (t :: Bool) = Bar t t-    instance SuppressUnusedWarnings BarSym1 where-      suppressUnusedWarnings-        = Data.Tuple.snd-            ((GHC.Tuple.(,) BarSym1KindInference) GHC.Tuple.())-    data BarSym1 (l :: Bool) (l :: TyFun Bool Foo)-      = forall arg. SameKind (Apply (BarSym1 l) arg) (BarSym2 l arg) =>-        BarSym1KindInference-    type instance Apply (BarSym1 l) l = Bar l l-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd-            ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun Bool (TyFun Bool Foo -> GHC.Types.Type))-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = BarSym1 l-    data instance Sing (z :: Bool)-      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 (z :: Foo)-      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-              (GHC.Tuple.(,) (toSing b :: SomeSing Bool))-                (toSing b :: SomeSing Bool)-          of {-            GHC.Tuple.(,) (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-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 (t :: Bool) = Not t-    instance SuppressUnusedWarnings NotSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd-            ((GHC.Tuple.(,) NotSym0KindInference) GHC.Tuple.())-    data NotSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply NotSym0 arg) (NotSym1 arg) =>-        NotSym0KindInference-    type instance Apply NotSym0 l = Not l-    type IdSym1 (t :: a0123456789876543210) = Id t-    instance SuppressUnusedWarnings IdSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd ((GHC.Tuple.(,) IdSym0KindInference) GHC.Tuple.())-    data IdSym0 (l :: TyFun a0123456789876543210 a0123456789876543210)-      = forall arg. SameKind (Apply IdSym0 arg) (IdSym1 arg) =>-        IdSym0KindInference-    type instance Apply IdSym0 l = Id l-    type FSym1 (t :: Bool) = F t-    instance SuppressUnusedWarnings FSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd ((GHC.Tuple.(,) FSym0KindInference) GHC.Tuple.())-    data FSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply FSym0 arg) (FSym1 arg) =>-        FSym0KindInference-    type instance Apply FSym0 l = F l-    type GSym1 (t :: Bool) = G t-    instance SuppressUnusedWarnings GSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd ((GHC.Tuple.(,) GSym0KindInference) GHC.Tuple.())-    data GSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply GSym0 arg) (GSym1 arg) =>-        GSym0KindInference-    type instance Apply GSym0 l = G l-    type HSym1 (t :: Bool) = H t-    instance SuppressUnusedWarnings HSym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd ((GHC.Tuple.(,) HSym0KindInference) GHC.Tuple.())-    data HSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply HSym0 arg) (HSym1 arg) =>-        HSym0KindInference-    type instance Apply HSym0 l = H l-    type ISym1 (t :: Bool) = I t-    instance SuppressUnusedWarnings ISym0 where-      suppressUnusedWarnings-        = Data.Tuple.snd ((GHC.Tuple.(,) ISym0KindInference) GHC.Tuple.())-    data ISym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply ISym0 arg) (ISym1 arg) =>-        ISym0KindInference-    type instance Apply ISym0 l = I l-    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 (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)
− 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/Undef.ghc84.template 
@@ -1,39 +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 (t :: Bool) = Bar t-    instance SuppressUnusedWarnings BarSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) BarSym0KindInference) GHC.Tuple.())-    data BarSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply BarSym0 arg) (BarSym1 arg) =>-        BarSym0KindInference-    type instance Apply BarSym0 l = Bar l-    type FooSym1 (t :: Bool) = Foo t-    instance SuppressUnusedWarnings FooSym0 where-      suppressUnusedWarnings-        = snd ((GHC.Tuple.(,) FooSym0KindInference) GHC.Tuple.())-    data FooSym0 (l :: TyFun Bool Bool)-      = forall arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) =>-        FooSym0KindInference-    type instance Apply FooSym0 l = Foo l-    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
− 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